1:- module(probat, [property_test/0, property_test/1]).    2
    3:- ["generators.pl"].    4:- ["shrinkers.pl"].    5
    6:- multifile valid_generator/1.    7:- multifile random_element/2.    8:- multifile random_element/4.    9:- multifile generate_shrinking_alternatives/3.   10:- dynamic property/1.   11
   12:- meta_predicate property(?).   13
   14:- setting(trials, integer, 100, "Number of test").   15:- setting(depth, integer, 8, "Max shrink depth.").   16:- setting(maxLenList, integer, 32, "Max list length.").   17:- setting(verbosity, integer, 1, "Verbosity.").   18:- setting(minVal, integer, -2147483648, "Min val to generate."). % -2**31
   19:- setting(maxVal, integer, 2147483648, "Max val to generate."). % 2**31
   20
   21% test_shrank(Predicate,LToTest,FailingInstance)
   22% LToTest is a list of N lists each one with M elements, where N is
   23% the arity of the predicate Predicate. FailingInstance is an instance
   24% failing. TODO: is it possible to improve this and avoid replicating
   25% the signature?
   26setup_arguments(Predicate,[[A0|TA0]],ToCall,Remaining):-
   27    ToCall =.. [Predicate,A0],
   28    Remaining = [TA0].
   29setup_arguments(Predicate,[[A0|TA0],[A1|TA1]],ToCall,Remaining):-
   30    ToCall =.. [Predicate,A0,A1],
   31    Remaining = [TA0,TA1].
   32setup_arguments(Predicate,[[A0|TA0],[A1|TA1],[A2|TA2]],ToCall,Remaining):-
   33    ToCall =.. [Predicate,A0,A1,A2],
   34    Remaining = [TA0,TA1,TA2].
   35setup_arguments(Predicate,[[A0|TA0],[A1|TA1],[A2|TA2],[A3|TA3]],ToCall,Remaining):-
   36    ToCall =.. [Predicate,A0,A1,A2,A3],
   37    Remaining = [TA0,TA1,TA2,TA3].
   38setup_arguments(Predicate,[[A0|TA0],[A1|TA1],[A2|TA2],[A3|TA3],[A4|TA4]],ToCall,Remaining):-
   39    ToCall =.. [Predicate,A0,A1,A2,A3,A4],
   40    Remaining = [TA0,TA1,TA2,TA3,TA4].
   41
   42test_shrank(Predicate,LArgs,F0):-
   43    setup_arguments(Predicate,LArgs,ToCall,Remaining),
   44    setting(verbosity,V),
   45    ( V > 1 -> 
   46        format("Testing ~w~n",[ToCall]) ;
   47        true
   48    ),
   49    ( \+ToCall -> 
   50        F0 = ToCall ;
   51        test_shrank(Predicate,Remaining,F0)
   52    ).
   53
   54test_loop(I,_,_,L,L):- I =< 0, !.
   55test_loop(I,Predicate,Arguments,LF,FailuresList):-
   56    I > 0,
   57    I1 is I - 1,
   58    % generate random inputs
   59    maplist(random_element,Arguments,LRandomElements),
   60    ToCall =.. [Predicate|LRandomElements],
   61    ( ToCall -> 
   62        test_loop(I1,Predicate,Arguments,LF,FailuresList) ;
   63        maplist(generate_shrinking_alternatives,Arguments,LRandomElements,PossibleShrinks),
   64        setting(verbosity,V),
   65        ( V > 1 ->
   66            format("Calling with ~w~n",[PossibleShrinks]) ; 
   67            true
   68        ),
   69        ( test_shrank(Predicate,PossibleShrinks,F) ->
   70            FailingInstance = F ;
   71            FailingInstance = LRandomElements % the shrink operation is not successful
   72        ),
   73        test_loop(I1,Predicate,Arguments,[FailingInstance|LF],FailuresList)
   74    ).
   75
   76run_test(Test,Result):-
   77    setting(trials,Trials),
   78    Test =.. [Predicate|Arguments], %
   79    ( maplist(valid_generator,Arguments) -> 
   80        true ;
   81        format("Some generators for ~w are not valid~n",[Test]),
   82        false
   83    ),
   84    format("Executing test: ~w~n", Test),
   85    test_loop(Trials,Predicate,Arguments,[],FailuresList),
   86    length(FailuresList,NFailures),
   87    FailureRatio is NFailures / Trials,
   88    sort(FailuresList,FS),
   89    format("Run ~w attempts, ~w failures (~w %)~n",[Trials,NFailures,FailureRatio]),
   90    ( NFailures > 0 ->
   91        format("Failures list ~w~n--- FAILED ---~n",[FS]),
   92        Result = -1 ;
   93        writeln("Passed"),
   94        Result = 1
   95    ).
   96
   97pretty_print_arguments([Arg,Def]):-
   98    format("- ~w (default: ~w)~n",[Arg,Def]).
   99set_argument(seed(N)):-
  100    set_random(seed(N)).
  101set_argument(Arg):-
  102    Arg =.. [Argument,Value],
  103    member(Argument,[trial,depth,maxLenList,verbosity]), 
  104    ( integer(Value), Value > 0 ->
  105        set_setting(Argument,Value) ;
  106        format("~w must be an integer > 0, found ~w~n",[Argument,Value]),
  107        fail
  108    ).
  109set_argument(Arg):-
  110    Arg =.. [Argument,Value],
  111    member(Argument,[minVal,maxVal]), 
  112    ( number(Value) ->
  113        set_setting(Argument,Value) ;
  114        format("~w must be a number, found ~w~n",[Argument,Value]),
  115        fail
  116    ).
  117set_argument(A):-
  118    format("Argument ~w not found~n",[A]),
  119    findall([Arg,Default],setting(Arg,Default),LAS),
  120    writeln("Available arguments:"),
  121    maplist(pretty_print_arguments,LAS),
  122    fail.
  123
  124
  125property_test:-
  126    property_test_.
  127property_test(Arguments):-
  128    ( is_list(Arguments) -> 
  129        maplist(set_argument,Arguments), !,
  130        setting(minVal,MinV),
  131        setting(maxVal,MaxV),
  132        ( MinV >= MaxV -> 
  133            writeln("minVal must be less than maxVal"),
  134            fail ;
  135            true
  136        ),
  137        property_test_ ;
  138        writeln("Arguments must be passed inside a list"),
  139        false
  140    ).
  141
  142% check_existence(Predicate,DoesExist): check whether the current predicate
  143% exist. DoesExist = 1 if the predicate exists, 0 otherwise.
  144check_existence(Predicate,DoesExist):-
  145    functor(Predicate, Name, Arity),
  146    ( current_predicate(user:Name/Arity) ->
  147        DoesExist = 1 ;
  148        DoesExist = 0
  149    ),
  150    ( Arity > 5 -> 
  151        format("Currently predicates with at most 5 arguments are supported, found ~w in ~w~n",[Arity,Predicate]),
  152        false ;
  153        true
  154    ).
  155
  156write_predicates_not_found(Predicate,0):-
  157    format("Predicate ~w not defined~n", [Predicate]).
  158write_predicates_not_found(_,1).
  159
  160property_test_:-
  161    catch(
  162        user:property(_),
  163        error(existence_error(_,_),_),
  164        (writeln("Please specify at least one property to test"), false)
  165    ), !,
  166    findall(Test,user:property(Test),LTests),
  167    % checks that the predicate exist
  168    maplist(check_existence,LTests,ExistOrNot),
  169    ( member(0,ExistOrNot) ->
  170        maplist(write_predicates_not_found,LTests,ExistOrNot),
  171        false ;
  172        true
  173    ),
  174    length(LTests,NTests),
  175    format("Found ~w tests~n",[NTests]),
  176    % writeln(LTests),
  177    ( NTests > 0 ->
  178        call_time(maplist(run_test,LTests,Results), Runtime),
  179        findall(-1,member(-1,Results),LFailed),
  180        length(LFailed,NFailed),
  181        length(Results,NTested),
  182        Ratio is NFailed / NTested,
  183        Runtime = time{cpu:_CT, inferences:_I, wall:W},
  184        writeln("--- Summary ---"),
  185        format("Executed ~w test in ~w seconds~n",[NTested,W]),
  186        format("Failed ~w over ~w (~w %)~n.",[NFailed,NTested,Ratio]) ;
  187        true
  188    )