1:- module(quickcheck, [ arbitrary/2
    2                      , arbitrary_type/1
    3                      , shrink/3
    4                      , quickcheck/1
    5                      ]).    6:- use_module(library(error), [existence_error/2]).    7:- use_module(library(settings), [setting/4, setting/2]).    8
    9% Module settings
   10% ---------------
   11:- setting( test_count, positive_integer, 100, 'Number of random test cases to generate for each test.').
 arbitrary(+Type, -Value) is det
Generate a random Value of Type. If you define your own types, add clauses to this multifile predicate to support them in quickcheck. When defining your own types, it can be helpful to call arbitrary/2 recursively or to use library(random).

The following types from library(error) have built in support.

   44:- multifile arbitrary/2.   45
   46:- [arbitrary].
 shrink(+Type, +Value, -Smaller) is nondet
True if Smaller is a "smaller" version of Value according to the semantics of Type. This predicate is called after quickcheck finds a Value for which a property fails. By recursively shrinking values, we can obtain a minimal, failing example.

When defining shrink/3 for your own types, be sure to fail if Value cannot be shrunk any smaller. It's acceptable to produce additional shrunken values on backtracking. It's often best to bisect your type's values (rather than iterating all possible, smaller values) if bisecting makes for your type.

   61:- multifile shrink/3.   62
   63:- [shrink].
 composite(+Type, +Arbitrary:BaseType, -Value) is det
Generate a random Value of Type from a given Arbitrary.
   68:- multifile composite/3.   69
   70:- [composite].
 quickcheck(+Property:atom) is semidet
True if Property holds for many random values. Property should be a Name/Arity term. Details about test results are displayed on the user_error stream.
   77:- meta_predicate quickcheck(:).   78quickcheck(Module:Property/Arity) :-
   79    % make sure the property predicate exists
   80    ( Module:current_predicate(Property/Arity) ->
   81        true
   82    ; % property predicate missing ->
   83        existence_error(predicate, Module:Property/Arity)
   84    ),
   85
   86    % what type is each argument?
   87    functor(Head, Property, Arity),
   88    once(Module:clause(Head, _)),
   89    Head =.. [Property|Args],
   90
   91    % run randomized tests
   92    setting(test_count, TestCount),
   93    run_tests(TestCount, Module, Property, Args, Result),
   94    ( Result = ok ->
   95        warn("~d tests OK", [TestCount])
   96    ; Result = fail(Example) ->
   97        ExampleGoal =.. [Property|Example],
   98        warn("Failed test ~q", [ExampleGoal]),
   99        throw(error(counter_example, Example))
  100    ).
  101
  102head([H|_], H).
  103
  104run_tests(TestCount, Module, Property, Args, fail(Example)) :-
  105    between(1,TestCount,_),
  106    generate_arguments(Args, Values, ValuesWithBaseTypes),
  107    Goal =.. [Property|Values],
  108    \+ Module:Goal,
  109    !,
  110
  111    % try shrinking this counter example
  112    shrink_example(0, Module, Property, ValuesWithBaseTypes, Example).
  113run_tests(_, _, _, _, ok).
  114
  115
  116% generates argument for simple arbitraries types
  117generate_argument(_:Type, [Value:Type]) :-
  118    arbitrary(Type, Value).
  119
  120% generates argument for composites of one arbitrary type
  121generate_argument(_:Type, [Value:Type, BaseValue:BaseType]) :-
  122    % verify there is a composite of the given type
  123    clause(composite(Type, _:BaseType, _), _),
  124    generate_argument(_:BaseType, [BaseValue:BaseType]),
  125    composite(Type, BaseValue:BaseType, Value).
  126
  127% generates argument for composites of many arbitraries types
  128generate_argument(_:Type, [Value:Type|BaseValues]) :-
  129    % verify there is a composite of the given type
  130    clause(composite(Type, [HBaseTypes|TBaseTypes], _), _),
  131    generate_arguments([HBaseTypes|TBaseTypes], BaseValues, _),
  132    composite(Type, BaseValues, Value).
  133
  134generate_arguments(Args, Values, ValuesWithBaseTypes) :-
  135    maplist(generate_argument, Args, ValuesWithBaseTypes),
  136    maplist(head, ValuesWithBaseTypes, Values).
  137
  138
  139% shrink a typed argument
  140shrink_argument(Value:Type, [Shrunken:Type]) :-
  141    shrink(Type, Value, Shrunken).
  142shrink_argument([Value:Type], [Shrunken:Type]) :-
  143    shrink(Type, Value, Shrunken).
  144
  145% shrink a composite argument
  146% we are not interested in the current value
  147% we need to generate shrunken values of the base
  148% arbitraries and then make a composite
  149shrink_argument([_:Type|BaseValuesWithTypes], [Shrunken:Type|ShrunkenBaseValuesWithTypes]) :-
  150    % verify there is a composite of the given type
  151    clause(composite(Type, BaseValuesWithTypes, _), _),
  152    shrink_arguments(BaseValuesWithTypes, ShrunkenBaseValuesWithTypes, _),
  153    composite(Type, ShrunkenBaseValuesWithTypes, Shrunken).
  154
  155% there is no shrinker for the given Type
  156% return the same Value as shrunken
  157shrink_argument([Value:Type|T], [Value:Type|T]).
  158
  159shrink_arguments(ValuesWithBaseTypes, Shrunk, ShrunkWithBaseTypes) :-
  160    maplist(shrink_argument, ValuesWithBaseTypes, ShrunkWithBaseTypes),
  161    maplist(head, ShrunkWithBaseTypes, Shrunk).
  162
  163
  164shrink_example(Depth0, Module, Property, ValuesWithBaseTypes, Example) :-
  165    Depth0 < 32,
  166    shrink_arguments(ValuesWithBaseTypes, Shrunk, ShrunkWithBaseTypes),
  167    ValuesWithBaseTypes \== ShrunkWithBaseTypes,
  168    ShrinkGoal =.. [Property|Shrunk],
  169    \+ Module:ShrinkGoal,
  170    !,
  171    Depth is Depth0 + 1,
  172    shrink_example(Depth, Module, Property, ShrunkWithBaseTypes, Example).
  173
  174shrink_example(Depth,_,_,ValuesWithBaseTypes, Example) :-
  175    warn("Shrinking to depth ~d", [Depth]),
  176    % omit base types in example
  177    maplist(head, ValuesWithBaseTypes, Example).
  178
  179
  180:- dynamic tap_raw:is_test_running/0, tap_raw:diag/2.  181
  182warn(Format,Args) :-
  183    current_module(tap_raw),
  184    tap_raw:is_test_running,
  185    !,
  186    tap_raw:diag(Format,Args).
  187warn(Format,Args) :-
  188    format(user_error,Format,Args),
  189    writeln('')