[m-dev.] conditional compilation

[Peter Wang]

2009/3/25 Ralph Becket <rafe at csse.unimelb.edu.au>:
> Peter Wang, Wednesday, 25 March 2009:
>> Hi,
>>
>> Here is another idea: conditional sections, where a section is kept or
>> omitted depending on compile time flags and/or grades.  If we borrow the
>> feature from trace goals, we might have something like this:
>>
>>     :- implementation(not(flag("production"))).
>>
>> I can think of a couple of uses.
>>
>> 1. I had an idea to ease writing test cases at MC.  One thing it would allow
>> is embedding test code in the same file as the module it is testing, which
>> may have certain advantages (or not, that's not the point here).  We could
>> strip out test code for production builds.
>
> That sounds appealing.

There's not much to it.


%-----------------------------------------------------------------------------%
%
% Testing framework.
%
% OVERVIEW
%
% Use a :- initialise predicate in each module to add test cases, using
% `add_tests'.
%
% In the main/2 predicate of an application, or a dedicated driver program,
% call `maybe_run_tests'.  If the environment variable `RUNTESTS' is set (see
% below) then test cases from imported modules will be run.  Otherwise you can
% continue normal execution of the program.
%
% ENVIRONMENT
%
% The RUNTESTS variable can be set to any of the following to execute all
% known tests: '', 'all', 'yes', 'true', 'y', '1'
%
% Otherwise it should be a whitespace-separated list of "specs", each of
% which has one of the following forms:
%
%       <group>
%       <group>:<test>
%
% which will execute either all the tests in the group, or just a single test
% case.
%
%-----------------------------------------------------------------------------%

:- module test_framework.
:- interface.

:- import_module assoc_list.
:- import_module bool.
:- import_module io.

%-----------------------------------------------------------------------------%

:- type test_pred == (pred(io, io)).
:- inst test_pred == (pred(di, uo) is det).

    % add_tests(Group, Tests, !IO)
    %
    % Register a group of tests.  This is designed to be run from a module's
    % :- initialise predicate.
    %
    % The group name groups together related tests; `$module' would be a good
    % choice.  Large modules may be broken into multiple groups.
    % Tests is an association list of Name - TestPred.
    %
    % A test case that throws an uncaught exception when executed counts as a
    % failing case; otherwise it is counted as a success.  Test cases may write
    % output to standard output.
    %
:- pred add_tests(string::in, assoc_list(string, test_pred)::in,
    io::di, io::uo) is det.

    % maybe_run_tests(RanTests, !IO)
    %
    % This predicate is designed to be run from the `main/2' predicate of a
    % real application, or a test driver program.
    % If RanTests is `yes' then you should not continue normal execution of the
    % application but exit after cleaning up.
    %
:- pred maybe_run_tests(bool::out, io::di, io::uo) is det.

    % Like maybe_run_tests, but pass the spec string directly instead of
    % reading it from the environment.  This may be more useful for test
    % drivers.
    %
:- pred run_tests(string::in, io::di, io::uo) is det.

%-----------------------------------------------------------------------------%
%
% Utilities for writing tests
%

    % You can throw any type of exception, but this one is a decent default
    % and is treated a bit specially.
    %
:- type test_failure
    --->    test_failure(string, int).

    % Succeed if the first two arguments are equal, otherwise throw an
    % exception.
    %
:- pred expect_equal(T::in, T::in, string::in, int::in) is det.

    % Succeed if the first two arguments are not, otherwise throw an
    % exception.
    %
:- pred expect_not_equal(T::in, T::in, string::in, int::in) is det.

%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%

:- implementation.

:- import_module exception.
:- import_module int.
:- import_module list.
:- import_module map.
:- import_module maybe.
:- import_module pair.
:- import_module pretty_printer.
:- import_module string.
:- import_module univ.

%-----------------------------------------------------------------------------%

:- type known_tests == map(string, assoc_list(string, test_pred)).

:- type tally
    --->    tally(
                tally_num_tests     :: int,
                tally_run           :: int,
                tally_failed        :: int,
                tally_skipped_spec  :: int
            ).

%-----------------------------------------------------------------------------%

% We can't rely on mutables as module initialisers for other modules can be run
% before our mutable initialiser.  So we have to invent our own mutables using
% foreign code :(

:- pragma foreign_decl("C", local, "
    static MR_Word known_tests;
").

:- pragma foreign_code("C", "
    static MR_Word known_tests = 0; /* relies on representation of map.empty */
").

:- pred get_known_tests(known_tests::out, io::di, io::uo) is det.
:- pragma foreign_proc("C",
    get_known_tests(Map::out, IO0::di, IO::uo),
    [will_not_call_mercury, promise_pure, thread_safe],
"
    Map = known_tests;
    IO = IO0;
").

:- pred set_known_tests(known_tests::in, io::di, io::uo) is det.
:- pragma foreign_proc("C",
    set_known_tests(Map::in, IO0::di, IO::uo),
    [will_not_call_mercury, promise_pure, thread_safe],
"
    known_tests = Map;
    IO = IO0;
").

%-----------------------------------------------------------------------------%

add_tests(Group, Tests, !IO) :-
    get_known_tests(KnownTests0, !IO),
    ( map.search(KnownTests0, Group, List0) ->
        List = List0 ++ Tests,
        map.det_update(KnownTests0, Group, List, KnownTests)
    ;
        map.det_insert(KnownTests0, Group, Tests, KnownTests)
    ),
    set_known_tests(KnownTests, !IO).

%-----------------------------------------------------------------------------%

maybe_run_tests(RanTests, !IO) :-
    io.get_environment_var("RUNTESTS", MaybeRuntests, !IO),
    (
        MaybeRuntests = yes(Specs),
        run_tests(Specs, !IO),
        RanTests = yes
    ;
        MaybeRuntests = no,
        % Save memory for the rest of the execution.
        set_known_tests(map.init, !IO),
        RanTests = no
    ).

run_tests(Specs, !IO) :-
    get_known_tests(KnownTests, !IO),
    Words0 = string.words(Specs),
    (
        ( Words0 = []
        ; Words0 = ["all"]
        ; Words0 = ["yes"]
        ; Words0 = ["true"]
        ; Words0 = ["y"]
        ; Words0 = ["1"]
        )
    ->
        io.write_string("% RUNNING ALL TESTS\n", !IO),
        Words = map.keys(KnownTests)
    ;
        Words = Words0
    ),
    list.foldl(count_tests(KnownTests), Words, 0, NumTests),
    Tally0 = tally(NumTests, 0, 0, 0),
    list.foldl2(run_tests_by_spec(KnownTests), Words, Tally0, Tally, !IO),
    report_tally(Tally, !IO).

:- pred count_tests(known_tests::in, string::in, int::in, int::out) is det.

count_tests(KnownTests, Spec, !Acc) :-
    SpecWords = string.split_at_char(':', Spec),
    (
        SpecWords = [GroupName],
        ( map.search(KnownTests, GroupName, TestGroup) ->
            !:Acc = !.Acc + list.length(TestGroup)
        ;
            true
        )
    ;
        SpecWords = [GroupName, TestName],
        (
            map.search(KnownTests, GroupName, TestGroup),
            assoc_list.search(TestGroup, TestName, _TestPred)
        ->
            !:Acc = !.Acc + 1
        ;
            true
        )
    ;
        ( SpecWords = []
        ; SpecWords = [_, _, _ | _]
        )
    ).

:- pred run_tests_by_spec(known_tests::in, string::in, tally::in, tally::out,
    io::di, io::uo) is det.

run_tests_by_spec(KnownTests, Spec, !Tally, !IO) :-
    SpecWords = string.split_at_char(':', Spec),
    (
        SpecWords = [GroupName],
        ( map.search(KnownTests, GroupName, TestGroup) ->
            io.write_string("% RUNNING GROUP ", !IO),
            io.write_string(GroupName, !IO),
            io.nl(!IO),
            run_test_group(GroupName, TestGroup, !Tally, !IO)
        ;
            io.write_string("% SKIPPED ", !IO),
            io.write_string(GroupName, !IO),
            io.write_string(" (group not found)\n", !IO),
            bad_spec(!Tally, !IO)
        )
    ;
        SpecWords = [GroupName, TestName],
        (
            map.search(KnownTests, GroupName, TestGroup),
            assoc_list.search(TestGroup, TestName, TestPred)
        ->
            run_single_test(GroupName, TestName - TestPred, !Tally, !IO)
        ;
            io.write_string("% SKIPPED ", !IO),
            io.write_string(Spec, !IO),
            io.write_string(" (test or group not found)\n", !IO),
            bad_spec(!Tally, !IO)
        )
    ;
        ( SpecWords = []
        ; SpecWords = [_, _, _ | _]
        ),
        io.write_string("% SKIPPED ", !IO),
        io.write_string(Spec, !IO),
        io.write_string(" (syntax error)\n", !IO),
        bad_spec(!Tally, !IO)
    ).

:- pred run_test_group(string::in, assoc_list(string, test_pred)::in,
    tally::in, tally::out, io::di, io::uo) is det.

run_test_group(Group, Tests, !Tally, !IO) :-
    list.foldl2(run_single_test(Group), Tests, !Tally, !IO).

:- pred bad_spec(tally::in, tally::out, io::di, io::uo) is det.

bad_spec(!Tally, !IO) :-
    !Tally ^ tally_skipped_spec := !.Tally ^ tally_skipped_spec + 1,
    io.set_exit_status(1, !IO).

%-----------------------------------------------------------------------------%

:- pred run_single_test(string::in, pair(string, test_pred)::in,
    tally::in, tally::out, io::di, io::uo) is det.

run_single_test(Group, Name - PredGround, !Tally, !IO) :-
    report_running(Group, Name, !.Tally, !IO),
    promise_equivalent_solutions [!:Tally, !:IO] (
        try_io(run_single_test_2(PredGround), Result, !IO),
        !Tally ^ tally_run := !.Tally ^ tally_run + 1,
        (
            Result = succeeded({}),
            report_succeeded(Group, Name, !IO)
        ;
            Result = exception(Excp),
            !Tally ^ tally_failed := !.Tally ^ tally_failed + 1,
            io.set_exit_status(1, !IO),
            report_failed(Group, Name, Excp, !IO)
        )
    ),
    % Blank line to make it easier to skip over irrelevant cases in a report.
    io.nl(!IO).

:- pred run_single_test_2(test_pred::in, {}::out, io::di, io::uo) is det.

run_single_test_2(PredGround, {}, !IO) :-
    cast_test_pred(PredGround, Pred),
    Pred(!IO).

:- pred cast_test_pred(test_pred::in, test_pred::out(test_pred)) is det.

:- pragma foreign_proc("C",
    cast_test_pred(PredGround::in, Pred::out(test_pred)),
    [will_not_call_mercury, promise_pure, thread_safe],
"
    Pred = PredGround;
").

:- pred report_running(string::in, string::in, tally::in,
    io::di, io::uo) is det.

report_running(Group, Name, Tally, !IO) :-
    ruler(!IO),
    io.write_string("% RUNNING TEST ", !IO),
    write_test_name(Group, Name, !IO),
    io.write_string(" (", !IO),
    io.write_int(Tally ^ tally_run + 1, !IO),
    io.write_char('/', !IO),
    io.write_int(Tally ^ tally_num_tests, !IO),
    io.write_string(")\n", !IO).

:- pred report_succeeded(string::in, string::in, io::di, io::uo) is det.

report_succeeded(Group, Name, !IO) :-
    io.write_string("% PASSED TEST ", !IO),
    write_test_name(Group, Name, !IO),
    io.nl(!IO).

:- pred report_failed(string::in, string::in, univ::in, io::di, io::uo) is det.

report_failed(Group, TestName, Excp, !IO) :-
    io.write_string("% UNCAUGHT EXCEPTION\n", !IO),
    ( univ_to_type(Excp, test_failure(Name, Line)) ->
        io.write_string("test failure at ", !IO),
        io.write_string(Name, !IO),
        io.write_string(", line ", !IO),
        io.write_int(Line, !IO),
        io.nl(!IO)
    ;
        pretty_printer.write_doc(format(univ_value(Excp)), !IO),
        io.nl(!IO)
    ),
    io.write_string("% FAILED TEST ", !IO),
    write_test_name(Group, TestName, !IO),
    io.nl(!IO).

:- pred write_test_name(string::in, string::in, io::di, io::uo) is det.

write_test_name(Group, Name, !IO) :-
    io.write_string(Group, !IO),
    io.write_char(':', !IO),
    io.write_string(Name, !IO).

:- pred report_tally(tally::in, io::di, io::uo) is det.

report_tally(Tally, !IO) :-
    Tally = tally(_NumTests, RunTests, FailedTests, SkippedSpecs),
    ruler(!IO),
    io.write_string("% SUMMARY\n", !IO),
    io.write_string("% Passed: ", !IO),
    io.write_int(RunTests - FailedTests, !IO),
    io.nl(!IO),
    io.write_string("% Failed: ", !IO),
    io.write_int(FailedTests, !IO),
    io.nl(!IO),
    ( SkippedSpecs > 0 ->
        io.write_string("% Skipped specs: ", !IO),
        io.write_int(SkippedSpecs, !IO),
        io.nl(!IO)
    ;
        true
    ).

:- pred ruler(io::di, io::uo) is det.

ruler(!IO) :-
    io.write_string("%--------------------------------------------------%\n",
        !IO).

%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%

expect_equal(T1, T2, Name, Line) :-
    trace [io(!IO)] (
        io.write_string("expect ", !IO),
        io.write(T1, !IO),
        io.write_string(" = ", !IO),
        io.write(T2, !IO),
        io.nl(!IO)
    ),
    ( T1 = T2 ->
        true
    ;
        throw(test_failure(Name, Line))
    ).

expect_not_equal(T1, T2, Name, Line) :-
    trace [io(!IO)] (
        io.write_string("expect ", !IO),
        io.write(T1, !IO),
        io.write_string(" \\= ", !IO),
        io.write(T2, !IO),
        io.nl(!IO)
    ),
    ( T1 \= T2 ->
        true
    ;
        throw(test_failure(Name, Line))
    ).

%-----------------------------------------------------------------------------%
% vim: ft=mercury ts=8 sts=4 sw=4 et
--------------------------------------------------------------------------
mercury-developers mailing list
Post messages to:       mercury-developers at csse.unimelb.edu.au
Administrative Queries: owner-mercury-developers at csse.unimelb.edu.au
Subscriptions:          mercury-developers-request at csse.unimelb.edu.au
--------------------------------------------------------------------------