tests/0000755000076500001200000000000010631534373013116 5ustar dauclairadmin00000000000000tests/foo.m0000644000076500001200000000106210564751352014061 0ustar dauclairadmin00000000000000:- module foo. % synopsis: A sample module to provide a target to qcheck2-test against. % created: Circa May 2006 % author: Douglas M. Auclair (DMA) % modified: February 14, 2007, DMA % changed: Added header comments. :- interface. :- func a(int) = string. :- func b(int) = string. :- func c(int) = string. :- func d(int) = string. :- implementation. :- import_module string, list. a(X) = string(X). b(X) = format("an int %d", [i(X)]). c(_) = "Hugh Grant". d(C) = format("C Doug add %d to something; getting %d something", [i(C), i(C)]). tests/foo_unit_tests.m0000644000076500001200000000341410564747271016352 0ustar dauclairadmin00000000000000:- module foo_unit_tests. % synopsis: Shows the structure of a unit test suite for a module using % standard qcheck features and reportage. % created: circa May 2006 % author: Douglas M. Auclair (DMA) % modified: Februrary 14, 2007, DMA % changed: Added comments; deleted dead code. :- interface. :- import_module io. :- pred main(io::di, io::uo) is det. :- implementation. :- import_module enum, float, int, list, pair, string, time, type_desc. :- import_module qcheck2, qcheck2.types, qcheck2.testable, qcheck2.reports, qcheck2.generators, qcheck2.rnd, foo. :- op(635, xfx, ===>). :- op(620, xfx, ===). :- op(625, xfx, >>>). main --> generate_seed_from_current_time(Seed), { rnd.init(Seed) = RNG, BigGenerator = generator(range(-300, 300), unbound, utf8, RNG), unit_test_suite(qstate(BigGenerator, []), qstate(_, Map)) }, show_test_result_sets(Map), nl. :- pred unit_test_suite(qstate(RNG, (func(int) = string)), qstate(RNG, (func(int) = string))) <= random_number_generator(RNG). :- mode unit_test_suite(in, out) is det. unit_test_suite --> qcheck(f(some_a_thingie), a), altered_state(int_range(range(0, 300)), Realter), qcheck(f(some_b_thingie), b), altered_state(int_range(range(0, 10)), _), qcheck(f(some_c_thingie), c), altered_state(Realter, _), qcheck(f(some_d_thingie), d). :- func some_a_thingie(int) = property. some_a_thingie(Int) = { Int } >>> string(Int) === a(Int). :- func some_b_thingie(int) = property. some_b_thingie(Int) = { Int } >>> format("an int %d", [i(Int)]) === b(Int). :- func some_c_thingie(int) = property. some_c_thingie(Int) = { Int, Ans } >>> "Hugh Grant" === Ans :- c(Int) = Ans. :- func some_d_thingie(int) = property. some_d_thingie(Int) = { Int, Ans } >>> "foo" === Ans :- d(Int) = Ans. tests/Makefile0000644000076500001200000000055510574234730014563 0ustar dauclairadmin00000000000000LTQ = ltq TESTS_BUILD_DIR = build TESTS=peano_unit_tests foo_unit_tests TESTS_ARTIFACTS= \ $(TESTS_BUILD_DIR) \ Mercury/ \ *~ \ *.err \ *.d* \ $(TESTS) \ *.mh all: $(TESTS) true peano_unit_tests: peano_unit_tests.m $(LTQ) $@ foo_unit_tests: foo_unit_tests.m $(LTQ) $@ clean: rm -rf $(TESTS_ARTIFACTS) tar: clean cd ..; tar czf qcheck2.tgz tests/ tests/Mercury.options0000644000076500001200000000020510410673434016153 0ustar dauclairadmin00000000000000EXTRA_LIB_DIRS = /ats/data/doug/atsl/bayes/mercury/bayes/lib/mercury EXTRA_LIBRARIES = utils # MLOBJS=battery_power_testing_utils.o tests/peano.m0000644000076500001200000000440310433521263014371 0ustar dauclairadmin00000000000000:- module peano. % synopsis: The Peano series is a logical approach to % counting/iterating over things; it converts % non-deterministic loops over a number range to % deterministic loops over the series. % created: June 28, 2004 % author: Douglas M. Auclair (DMA) % modified: March 22, 2006, DMA % changed: Converted to Mercury. Added conversions of numbers as % strings to their peano equivalents, as well. :- interface. :- import_module string, enum. :- type peano ---> zero; s(peano). :- instance enum(peano). % Converts the natural number in the string to a peano numeral :- pred to_peano(string::in, peano::out) is semidet. % Bidirectionally converts between non-negative integers and % their equivalent peano numerals. :- pred peano(int, peano). :- mode peano(in, out) is semidet. :- mode peano(in, in) is semidet. :- mode peano(out, in) is det. % Increments or decrements a peano numeral. :- pred increment(peano, peano). :- mode increment(in, in) is semidet. :- mode increment(in, out) is det. :- mode increment(out, in) is semidet. :- implementation. :- import_module int, peano.nat. :- instance enum(peano) where [ to_int(Peano) = fold_to_nat(Peano), from_int(Num) = Peano :- peano(Num, Peano) ]. to_peano(String, Peano) :- to_int(String, Int), guarded_peano(Int, zero, Peano). :- pragma promise_equivalent_clauses(peano/2). peano(Number::in, Peano::in) :- fold_to_nat(Peano) = Number. peano(Number::in, Peano::out) :- guarded_peano(Number, zero, Peano). peano(Number::out, Peano::in) :- Number = fold_to_nat(Peano). increment(Peano, s(Peano)). % Useful predicate for counting numbers as implied (DCG) arguments. % ------------------------------------------------------- % INTERNAL IMPLEMENTATION PREDICATES % ------------------------------------------------------- :- func fold_to_nat(peano) = int. fold_to_nat(zero) = 0. fold_to_nat(s(Peano)) = 1 + fold_to_nat(Peano). :- module nat. :- interface. :- pred guarded_peano(int::in, peano::in, peano::out) is semidet. :- implementation. guarded_peano(N) --> { N >= 0 }, peano(N). :- pred peano(int::in, peano::in, peano::out) is det. peano(N) --> { N > 0 } -> increment, peano(N - 1); []. :- end_module nat. :- end_module peano. tests/peano_modules_and_predicates.m0000644000076500001200000000147110575600325021154 0ustar dauclairadmin00000000000000:- module peano_modules_and_predicates. % Automatically generated by qcpt on Tue Mar 13 15:51:49 2007 :- interface. :- import_module list. :- import_module qcheck2. :- import_module qcheck2.tests_digest_types. :- func all_public_predicates = list(full_predicate_signature(tested_module, public_predicate)). :- func all_program_modules = list(tested_module). :- type tested_module ---> peano ; foo. :- type public_predicate ---> a ; b ; c ; d ; increment ; peano ; to_peano. :- implementation. all_program_modules = [ peano, foo ]. all_public_predicates = [ public(peano, increment/2), public(peano, peano/2), public(peano, to_peano/2), public(foo, d/2), public(foo, c/2), public(foo, b/2), public(foo, a/2) ]. :- end_module peano_modules_and_predicates. tests/peano_unit_tests.m0000644000076500001200000001446410575571061016672 0ustar dauclairadmin00000000000000:- module peano_unit_tests. % synopsis: Stress-tests the peano module using qcheck. % created: March 23, 2006 % author: Douglas M. Auclair (DMA) :- interface. :- import_module io. :- pred main(io::di, io::uo) is det. :- implementation. :- import_module enum. :- import_module float. :- import_module int. :- import_module list. :- import_module pair. :- import_module string. :- import_module type_desc. :- import_module utils. :- import_module utils.random. :- import_module qcheck2. :- import_module qcheck2.types. :- import_module qcheck2.testable. :- import_module qcheck2.reports. :- import_module qcheck2.generators. :- import_module qcheck2.tests_digest_types. :- import_module qcheck2.tests_digest_reports. % what to test ... :- import_module peano. % ... and how to test it (generated from qcpt) :- import_module peano_modules_and_predicates. :- op(635, xfx, ===>). :- op(620, xfx, ===). :- op(625, xfx, >>>). % We need to weigh the selection from among these types to % have more than a modicum of useful test values: % We'll start first with a general freq on the over-arching type :- func freq_jrandom_string = pair(type_desc, list(frequency)). freq_jrandom_string = type_of(s("foo")) - [freq(10, []), freq(70, []), freq(10, []), freq(10, [])]. % and finally the frequency for peano numerals to match the % integrals. :- func freq_peano = pair(type_desc, list(frequency)). freq_peano = type_of(peano.zero) - [freq(50, []), freq(50, [])]. main --> { BigGenerator = generator(range(-300, 300), unbound, utf8, RNG), unit_test_suite(qstate(BigGenerator, []), qstate(_, Map)) }, tausworthe3RNG(RNG), caveat, show_test_result_sets(Map), show_module_tests_summary(Map, all_program_modules, all_public_predicates), caveat. :- pred unit_test_suite(qstate(RNG, test_description(tested_module, public_predicate)), qstate(RNG, test_description(tested_module, public_predicate))) <= rng(RNG). :- mode unit_test_suite(in, out) is det. unit_test_suite --> qcheck(f(some_peano_strings), public(peano, to_peano/2) - "Tests string creation", 100, [], [freq_jrandom_string]), altered_state(int_range(range(0, 300)), Realter), qcheck(f(peano_me_baby), public(peano, peano/2) - "Converts an int to a P-numeral"), altered_state(int_range(range(0, 10)), _), qcheck(f(compare_me_baby), public(peano, peano/2) - "Compares an int to a P-numeral"), altered_state(Realter, _), qcheck(f(int_me_baby), public(peano, peano/2) - "Gives an int from a P-numeral"), qcheck(f(compare_successor), public(peano, increment/2) - "Checks increment/2's compare"), qcheck(f(forward_successor), public(peano, increment/2) - "Makes sure we get a successor"), qcheck(f(backward_successor), public(peano, increment/2) - "We can decrement P-numerals, too!"). :- pred caveat(io::di, io::uo) is det. caveat --> print("\n\nWARNING!!! Not testing P-numerals over 10,000.\n\n"). %%%%% TESTS FOR to_peano/2 :- func some_peano_strings(string.poly_type) = property. some_peano_strings(StringType) = (peanoable(String) ===> { String } >>> Integral === Int) :- String = tie(StringType), (to_int(String, I) -> Int = I ; Int = -2), (to_peano(String, Peano) -> peano(Integral, Peano); Integral = -1). :- func tie(string.poly_type) = string. tie(f(N)) = format("%f", [f(N)]). tie(i(N)) = format("%d", [i(N)]). tie(s(String)) = String. tie(c(Char)) = format("%c", [c(Char)]). :- pred peanoable(string::in) is semidet. peanoable(String) :- to_int(String, _Int), to_peano(String, _). %%%%% TESTS FOR peano/2 % Branch 1: Int -> Peano :- func peano_me_baby(int) = property. peano_me_baby(Int) = (pianoissimo(Int) ===> ({ Int } >>> Int === enum.to_int(Peano))) :- (peano(Int, P) -> Peano = P; Peano = zero). :- pred pianoissimo(int::in) is semidet. pianoissimo(Int) :- peano(Int, _). % Branch 2: Int == Peano (comparison) :- func compare_me_baby(int, peano) = property. compare_me_baby(Int0, Peano) = ((eq(Int0, Int1)) ===> { Int0 } >>> Int0 === Int1) :- peano(Int1, Peano). :- pred eq(T::in, T::in) is semidet. eq(X, X). % Branch 3: Int <- Peano :- func int_me_baby(peano) = property. int_me_baby(Peano) = ({ Int } >>> Int === enum.to_int(Peano)) :- peano(Int, Peano). %%%%% TESTS FOR increment/2 % Branch 1: s(P0) = P1 comparison :- func compare_successor(peano, peano) = property. compare_successor(P0, P1) = (fst_mode_incr(P0, P1) ===> { enum.to_int(P0), enum.to_int(P1) } >>> s(P0) === P1). :- pred fst_mode_incr(peano::in, peano::in) is semidet. fst_mode_incr(P0, P1) :- increment(P0, P1). % Branch 2: P0 -> s(P0) increment :- func forward_successor(peano) = property. forward_successor(P0) = (s(P0) === P1) :- increment(P0, P1). % Branch 3: P0 <- s(P0) decrement :- func backward_successor(peano) = property. backward_successor(P1) = (not_zero(P1) ===> s(P0) === P1) :- increment(Peano, P1) -> Peano = P0; P0 = s(P1). :- pred not_zero(peano::in) is semidet. not_zero(s(_)). % modified: March 13, 2007, DMA % changed: Conformed test suite to use the type-forwarding now used % for test result reportage. % modified: February 14, 2007, DMA -- Happy St. Valentine's Day! % changed: As the module rnd has been moved into the qcheck2 submodule sphere, % changed the import and eliminated the instance declaration. % modified: May 9, 2006, DMA % changed: Moved the testing types to qcheck.tests_digest.types and % added a reporting facility at qcheck.tests_digest.reports. % modified: May 4, 2006, DMA % changed: Generalized qstate to include any type for the test % description; modified using code here to reflect same. % modified: May 3, 2006, DMA % changed: As qcheck's state is now qstate(RNG), not io.state, we % modify the call to qcheck here to reflect that new % reality. % modified: May 1, 2006, DMA % changed: Used a different RNG than the one supplied by Quickcheck; % this to test that the generator typeclass works across the % board. % modified: April 16, 2006, DMA % changed: Removed the byzantine string type thingie and replaced it, % simply, with string.poly_type. *sigh* :- end_module peano_unit_tests. tests/qcheck2.generators.m0000644000076500001200000006541210575642464017004 0ustar dauclairadmin00000000000000:- module qcheck2.generators. % synopsis: The sub-module responsible for generating (random) % values used in testing. % author: xcsm % modified by: Douglas M. Auclair (DMA) % created: April 18, 2006 % Copyright (C) 2001, 2003, 2005-2006 under the LGPL :- interface. :- import_module qcheck2.types. :- import_module assoc_list. :- import_module char. :- import_module float. :- import_module list. :- import_module string. :- import_module type_desc. :- import_module univ. :- import_module utils. :- import_module utils.random. % The required format for specific frequency : % int : relative frequency of this type being generated % list(list(frequency)) : a constructor may have arity 0 to % infinity. The outer list is a list % for constructor arguments. % Inner list states the relative % frequency of all alternatives for % 1 argument % eg: green(coin, color) % where coin ---> head ; tail. % color ---> black ; white. % Then frequency should be : % freq(99, [ [freq(30, []), freq(70, [])], % [freq(40, []), freq(60, [])] ] % % For type coin, there is 30% chance of being head % and 70% chance of being tail. % For type color, there is 40% chance of being black % and 60% chance of bing white. :- type frequency ---> freq(int, list(list(frequency))). :- type specific_frequency == assoc_list(int, list(list(frequency))). :- type general_frequencies == assoc_list(type_desc, list(frequency)). % user_gen_type is the type format for each of user-defined % generator. % The first element, type_desc, is the type_of the variable % which this generator is suppose to handle. The second element % should be a user defined generator. The user defined generator % should take a type_desc, which shows what type is % required. It's followed by a Specific Frequency, a % list of General frequency, a list of custom generators, and % finally the input and output % of random number supply. :- type user_gen_type(RNG) ---> user_generator(type_desc, pred(type_desc, univ, list(frequency), general_frequencies, list(user_gen_type(RNG)), generator(RNG), generator(RNG))). :- inst user_gen_inst(Inst) == bound(user_generator(ground, pred(in, out, in, in, list_skel_in(user_gen_inst(Inst)), in, out) is det)). % Generates a random value of type T based on the input % frequency distributions or user-defined random generator. :- pred gen(T, list(frequency), general_frequencies, list(user_gen_type(RNG)), generator(RNG), generator(RNG)) <= rng(RNG). :- mode gen(out, in, in, list_skel_in(user_gen_inst(RNG)), in, out) is det. % The following are the default generators for int, char, float, % and string. Please refer to tutorials for details. :- pred rand_int(int, generator(RNG), generator(RNG)) <= rng(RNG). :- mode rand_int(out, in, out) is det. :- pred rand_char(char, generator(RNG), generator(RNG)) <= rng(RNG). :- mode rand_char(out, in, out) is det. :- pred rand_float(float, generator(RNG), generator(RNG)) <= rng(RNG). :- mode rand_float(out, in, out) is det. :- pred rand_string(string, generator(RNG), generator(RNG)) <= rng(RNG). :- mode rand_string(out, in, out) is det. %---------------------------------------------------------------------------% % rand_union/6 generates a discriminated union via following steps: % 1. It determines what frequency to use at this level % 2. Then chooses which constructor of discriminated union % to generate, and generate the argument list for the % particular constructor % 3. And finally call construct/3 to build the term. :- pred rand_union(type_desc, univ, list(frequency), general_frequencies, list(user_gen_type(RNG)), generator(RNG), generator(RNG)) <= rng(RNG). :- mode rand_union(in, out, in, in, list_skel_in(user_gen_inst(RNG)), in, out) is det. % rand_function generates a random forward mode function with types % described in type_desc. However rand_function/3 can only generate % functions with arity 0 to 10, it will throw an error if unable to % generate the required type. :- pred rand_function(type_desc::in, univ::out, generator(RNG)::in, generator(RNG)::out) is det <= rng(RNG). % oneof/3 randomly selects an element from the list. % An error will be thrown if the list is empty. :- pred oneof(list(T), T, generator(RNG), generator(RNG)) <= rng(RNG). :- mode oneof(in, out, in, out) is det. %---------------------------------------------------------------------------% :- implementation. :- import_module construct. :- import_module deconstruct. :- import_module int. :- import_module maybe. :- import_module pair. :- import_module require. :- import_module time. %---------------------------------------------------------------------------% gen(Term, Frequencys, GF, Generators, !Gen) :- gen_arg(type_of(Term), Frequencys, GF, Generators, Univ, !Gen), det_univ_to_type(Univ, Term). % gen_arg/7 searches for a user-defined generator first, if it % is found, then runs the generator. Otherwise, gen_arg/7 will % try to determine which type it is suppose to generate, and % calls the appropriate default generator. rand_function/3 % will be called only if the required type is not int, char, % float, string, or discriminated union. :- pred gen_arg(type_desc, list(frequency), general_frequencies, list(user_gen_type(RNG)), univ, generator(RNG), generator(RNG)) <= rng(RNG). :- mode gen_arg(in, in, in, list_skel_in(user_gen_inst(RNG)), out, in, out) is det. gen_arg(Datatype, SF, GF, UserGenerators, Univ) --> { find_user_gen(Datatype, UserGenerators, UserGenerator) } -> UserGenerator(Datatype, Univ, SF, GF, UserGenerators) ; try_generating_basic_value(Datatype, MaybeValue), ({ MaybeValue = yes(Value) } -> { Univ = Value } ; { num_functors(Datatype) = -1 } -> rand_function(Datatype, Univ) ; rand_union(Datatype, Univ, SF, GF, UserGenerators)). % Here we essay various basic types (string, char, int, float) % for the argument. If it's one of those basic types, then we % call the appropriate random generator to obtain a test value. :- pred try_generating_basic_value(type_desc, maybe(univ), generator(RNG), generator(RNG)) <= rng(RNG). :- mode try_generating_basic_value(in, out, in, out) is det. try_generating_basic_value(Datatype, Univ, !Gen) :- Datatype = type_of(0) -> rand_int(Int, !Gen), Univ = yes(univ(Int)) ; Datatype = type_of('0') -> rand_char(Char, !Gen), Univ = yes(univ(Char)) ; Datatype = type_of(0.0) -> rand_float(Float, !Gen), Univ = yes(univ(Float)) ; Datatype = type_of("String") -> rand_string(String, !Gen), Univ = yes(univ(String)) ; Univ = no. % gen_arg_list/7 is similar to gen_arg/7, except it generates % a list of univ, instead of just 1 univ as in gen_arg/7. % gen_arg_list/7 recursively calls gen_arg/7 until the list is % empty. :- pred gen_arg_list(list(type_desc), list(list(frequency)), general_frequencies, list(user_gen_type(RNG)), list(univ), generator(RNG), generator(RNG)) <= rng(RNG). :- mode gen_arg_list(in, in, in, list_skel_in(user_gen_inst(RNG)), out, in, out) is det. gen_arg_list([], _, _, _, []) --> []. gen_arg_list([Type|Types], Freqs, GF, UserGenerators, [Univ|Univs]) --> { Freqs = [], F = [], Fs = [] ; Freqs = [F | Fs] }, gen_arg(Type, F, GF, UserGenerators, Univ), gen_arg_list(Types, Fs, GF, UserGenerators, Univs). %---------------------------------------------------------------------------% /* % generate an int of N Bits :- pred next(int, int, RNG, RNG) <= rng(RNG). :- mode next(in, out, in, out) is det. next(N, Bits, !RNG) :- random_float(F, !RNG), Range = pow(2.0, N) - 1.0, Bits = round_to_int(F * Range). */ % generate int rand_int(Int, !Gen) :- !.Gen = generator(IntRange, _Float, _Char, _RNG), gen_int(IntRange, Int, !Gen). /* % rand_allint/2 generates an int with equal distribution over all % possible int (size int.bits_per_int - 1). :- pred rand_allint(int::out, RNG::in, RNG::out) is det <= rng(RNG). rand_allint(Int) --> next(1, Sign), next(int.bits_per_int - 1, TempInt), { Sign > 0 -> Int = TempInt; Int = -TempInt }. */ % generate char rand_char(Char, !Gen) :- !.Gen = generator(_Int, _Float, CharType, _RNG0), char_range(CharType) = MinChar - MaxChar, gen_int(range(MinChar, MaxChar), Int, !Gen), (char.to_int(Char0, Int) -> Char = Char0 ; error("Could not convert " ++ int_to_string(Int) ++ " to a character")). :- func char_range(character_type) = pair(int, int). char_range(utf8) = 1 - 255. char_range(utf16) = 0 - 1114111. % http://www.unicode.org/faq/utf_bom.html char_range(utf32) = 0 - 1114111. % http://www.unicode.org/faq/utf_bom.html :- pred gen_int(int_range::in, int::out, generator(RNG)::in, generator(RNG)::out) is det <= rng(RNG). gen_int(Range, Ans, !Gen) :- !.Gen = generator(_, _, _, RNG0), do_gen_int(Range, Ans, RNG0, RNG), update_generator(RNG, !Gen). :- pred do_gen_int(int_range::in, int::out, RNG::in, RNG::out) is det <= rng(RNG). do_gen_int(range(Min, Max), round_to_int(J * float(Max - Min)) + Min) --> random_float(J). do_gen_int(unbound, K) --> random_int(K). % generating floats. % rand_allfloat/3 assumes floats will follow IEEE; this is a % pretty safe assumption for quite some time ... :- pred rand_allfloat(float::out, RNG::in, RNG::out) is det <= rng(RNG). rand_allfloat(Float) --> random_int(Mant0), random_float(Sign), { Sign > 0.5 -> Mant = Mant0; Mant = -Mant0 }, random_int_in(Exp, 0, 128), random_float(ExpSign), { Flt0 = float(Mant) * pow(2.0, Exp), (ExpSign > 0.5, Flt0 \= 0.0 -> Float = 1.0/Flt0; Float = Flt0) }. rand_float(Float, !Gen) :- !.Gen = generator(_Int, FloatRange, _Char, RNG0), ( FloatRange = unbound, rand_allfloat(Float, RNG0, RNG1) ; FloatRange = range(Min, Max), random_float(F, RNG0, RNG1), Float = F * (Max - Min) + Min), update_generator(RNG1, !Gen). % generate string rand_string(String) --> gen(Charlist, [], [type_of(['A'])-[freq(10, []), freq(90, [])]], []), { string.from_char_list(Charlist, String) }. % generate disciminated union rand_union(Datatype, Univ, Frequencies, GF, UserGenerators, !Gen) :- NumFunctors = num_functors(Datatype) -> TempFrq = get_freq(Datatype, NumFunctors, 0, Frequencies, GF), gen_int(range(0, foldl(plus, keys(TempFrq), -1)), Selector, !Gen), freq(Branch, SubBranch) = select_branch(Selector, 0, 0, TempFrq), (if get_functor(Datatype, Branch, _, _, PseudoArgs), ArgTypesTemp = map(ground_pseudo_type_desc_to_type_desc_det, PseudoArgs) then ArgTypes = ArgTypesTemp, gen_arg_list(ArgTypes, SubBranch, GF, UserGenerators, ArgList, !Gen), (if Temp = construct(Datatype, Branch, ArgList) then Univ = Temp else error("rand_union/6 : construct/3 failed")) else error("rand_union/6 : get_functor/5 failed")) ; error("rand_union/6 : get_functor/5 failed"). % generate random function rand_function(Type, Univ, !Gen) :- gimme_10_ints(X1, X2, X3, X4, X5, X6, X7, X8, X9, X10, !Gen), type_ctor_and_args(Type, _, Args), ( Args = [RetType] -> has_type(RetVal, RetType), Func = dummy(!.Gen,X1,X2,X3,X4,X5,X6,X7,X8,X9,X10), nailFuncType(RetVal, Func), Univ = univ(Func) ; Args = [ArgType1, RetType] -> has_type(Arg1, ArgType1), has_type(RetVal, RetType), Func = dummy(!.Gen,X1,X2,X3,X4,X5,X6,X7,X8,X9), nailFuncType(Arg1, RetVal, Func), Univ = univ(Func) ; Args = [ArgType1, ArgType2, RetType] -> has_type(Arg1, ArgType1), has_type(Arg2, ArgType2), has_type(RetVal, RetType), Func = dummy(!.Gen,X1,X2,X3,X4,X5,X6,X7,X8), nailFuncType(Arg1, Arg2, RetVal, Func), Univ = univ(Func) ; Args = [ArgType1, ArgType2, ArgType3, RetType] -> has_type(Arg1, ArgType1), has_type(Arg2, ArgType2), has_type(Arg3, ArgType3), has_type(RetVal, RetType), Func = dummy(!.Gen,X1,X2,X3,X4,X5,X6,X7), nailFuncType(Arg1, Arg2, Arg3, RetVal, Func), Univ = univ(Func) ; Args = [ArgType1, ArgType2, ArgType3, ArgType4, RetType] -> has_type(Arg1, ArgType1), has_type(Arg2, ArgType2), has_type(Arg3, ArgType3), has_type(Arg4, ArgType4), has_type(RetVal, RetType), Func = dummy(!.Gen,X1,X2,X3,X4,X5,X6), nailFuncType(Arg1, Arg2, Arg3, Arg4, RetVal, Func), Univ = univ(Func) ; Args = [ArgType1, ArgType2, ArgType3, ArgType4, ArgType5, RetType] -> has_type(Arg1, ArgType1), has_type(Arg2, ArgType2), has_type(Arg3, ArgType3), has_type(Arg4, ArgType4), has_type(Arg5, ArgType5), has_type(RetVal, RetType), Func = dummy(!.Gen,X1,X2,X3,X4,X5), nailFuncType(Arg1, Arg2, Arg3, Arg4, Arg5, RetVal, Func), Univ = univ(Func) ; Args = [ArgType1, ArgType2, ArgType3, ArgType4, ArgType5, ArgType6, RetType] -> has_type(Arg1, ArgType1), has_type(Arg2, ArgType2), has_type(Arg3, ArgType3), has_type(Arg4, ArgType4), has_type(Arg5, ArgType5), has_type(Arg6, ArgType6), has_type(RetVal, RetType), Func = dummy(!.Gen,X1,X2,X3,X4), nailFuncType(Arg1, Arg2, Arg3, Arg4, Arg5, Arg6, RetVal, Func), Univ = univ(Func) ; Args = [ArgType1, ArgType2, ArgType3, ArgType4, ArgType5, ArgType6, ArgType7, RetType] -> has_type(Arg1, ArgType1), has_type(Arg2, ArgType2), has_type(Arg3, ArgType3), has_type(Arg4, ArgType4), has_type(Arg5, ArgType5), has_type(Arg6, ArgType6), has_type(Arg7, ArgType7), has_type(RetVal, RetType), Func = dummy(!.Gen,X1,X2,X3), nailFuncType(Arg1, Arg2, Arg3, Arg4, Arg5, Arg6, Arg7, RetVal, Func), Univ = univ(Func) ; Args = [ArgType1, ArgType2, ArgType3, ArgType4, ArgType5, ArgType6, ArgType7, ArgType8, RetType] -> has_type(Arg1, ArgType1), has_type(Arg2, ArgType2), has_type(Arg3, ArgType3), has_type(Arg4, ArgType4), has_type(Arg5, ArgType5), has_type(Arg6, ArgType6), has_type(Arg7, ArgType7), has_type(Arg8, ArgType8), has_type(RetVal, RetType), Func = dummy(!.Gen,X1,X2), nailFuncType(Arg1, Arg2, Arg3, Arg4, Arg5, Arg6, Arg7, Arg8, RetVal, Func), Univ = univ(Func) ; Args = [ArgType1, ArgType2, ArgType3, ArgType4, ArgType5, ArgType6, ArgType7, ArgType8, ArgType9, RetType] -> has_type(Arg1, ArgType1), has_type(Arg2, ArgType2), has_type(Arg3, ArgType3), has_type(Arg4, ArgType4), has_type(Arg5, ArgType5), has_type(Arg6, ArgType6), has_type(Arg7, ArgType7), has_type(Arg8, ArgType8), has_type(Arg9, ArgType9), has_type(RetVal, RetType), Func = dummy(!.Gen,X1), nailFuncType(Arg1, Arg2, Arg3, Arg4, Arg5, Arg6, Arg7, Arg8, Arg9, RetVal, Func), Univ = univ(Func) ; Args = [ArgType1, ArgType2, ArgType3, ArgType4, ArgType5, ArgType6, ArgType7, ArgType8, ArgType9, ArgType10, RetType] -> has_type(Arg1, ArgType1), has_type(Arg2, ArgType2), has_type(Arg3, ArgType3), has_type(Arg4, ArgType4), has_type(Arg5, ArgType5), has_type(Arg6, ArgType6), has_type(Arg7, ArgType7), has_type(Arg8, ArgType8), has_type(Arg9, ArgType9), has_type(Arg10, ArgType10), has_type(RetVal, RetType), Func = dummy(!.Gen), nailFuncType(Arg1, Arg2, Arg3, Arg4, Arg5, Arg6, Arg7, Arg8, Arg9, Arg10, RetVal, Func), Univ = univ(Func) ; error("no default generator for this type")). :- pred gimme_10_ints(int::out, int::out, int::out, int::out, int::out, int::out, int::out, int::out, int::out, int::out, generator(RNG)::in, generator(RNG)::out) is det <= rng(RNG). gimme_10_ints(A, B, C, D, E, F, G, H, I, J) --> gen_int(unbound, A), gen_int(unbound, B), gen_int(unbound, C), gen_int(unbound, D), gen_int(unbound, E), gen_int(unbound, F), gen_int(unbound, G), gen_int(unbound, H), gen_int(unbound, I), gen_int(unbound, J). %---------------------------------------------------------------------------% % dummy/10 is the base function for curry. :- func dummy(generator(RNG), T1, T2, T3, T4, T5, T6, T7, T8, T9, T10) = T11 <= rng(RNG). dummy(Gen, X1, X2, X3, X4, X5, X6, X7, X8, X9, X10) = Y :- dummy_aux(X1, X2, X3, X4, X5, X6, X7, X8, X9, X10, Y, Gen, _). :- pred dummy_aux(T1, T2, T3, T4, T5, T6, T7, T8, T9, T10, T11, generator(RNG), generator(RNG)) <= rng(RNG). :- mode dummy_aux(in, in, in, in, in, in, in, in, in, in, out, in, out) is det. dummy_aux(X1, X2, X3, X4, X5, X6, X7, X8, X9, X10, Y) --> anys_to_int([univ(X1), univ(X2), univ(X3), univ(X4), univ(X5), univ(X6), univ(X7), univ(X8), univ(X9), univ(X10)], 0), gen(Y, [], [], []). %---------------------------------------------------------------------------% % On average there is 5% chance this function will return 0 % regardless of 1st argument, otherwise this function produce % an int that is dependent on its argument's type and value % (where the argument can be of any type). :- pred any_to_int(T, int, int, generator(RNG), generator(RNG)) <= rng(RNG). :- mode any_to_int(in, in, out, in, out) is det. any_to_int(X, Int, Int + NewInt, !Gen) :- if gen_int(range(1, 20), 1, !Gen) then NewInt = 0 else NewInt = univ_to_int(univ(X)). % It'd be nice if we had a monadic fold, but since we don't ... :- pred anys_to_int(list(univ)::in, int::in, generator(RNG)::in, generator(RNG)::out) is det <= rng(RNG). anys_to_int([], Ans, !Gen) :- !.Gen = generator(_, _, _, RNG0), some [!RNG] (!:RNG = RNG0, random_int(A, !RNG), random_int(B, !RNG), random_int(C, !.RNG, _)), seed(tausworthe3_seed(A + Ans, B + Ans, C + Ans), NewRNG), update_generator(tausworthe3_to_RNG(NewRNG), !Gen). anys_to_int([Univ|Univs], Ans) --> any_to_int(Univ, Ans, NewAns), anys_to_int(Univs, NewAns). :- func tausworthe3_to_RNG(tausworthe3) = RNG <= rng(RNG). :- pragma c_code(tausworthe3_to_RNG(Tau::in) = (RNG::out), [thread_safe, will_not_call_mercury], "RNG = Tau;"). % univ_to_int/1 assumes that the univ contains a term, in % which case it "int"s the charlist of the functor and then % "int"s the arguments. So a nullary term is the "int"ed % charlist of the functor. :- func univ_to_int(univ) = int. univ_to_int(X) = Y :- deconstruct(univ_value(X), canonicalize, Functor, _Arity, ArgList), string.to_char_list(Functor, CharList), Y = 10 * foldl((func(A, B) = C :- char.to_int(A)+B = C), CharList, 0) + foldl((func(D, E) = F :- F = univ_to_int(D) + E), ArgList, 0). oneof(Xs, Y, !Gen) :- Len = list.length(Xs), (Len = 0 -> error("The input list should not be empty") ; gen_int(range(1, Len), Nth, !Gen), index1_det(Xs, Nth, Y)). %---------------------------------------------------------------------------% % get_freq/5 works out what distribution to use at current % level by looking at the SF and GF. :- func get_freq(type_desc, int, int, list(frequency), general_frequencies) = specific_frequency. get_freq(Datatype, NumFunctors, Counter, Frequencies, GF) = List :- (if NumFunctors = Counter then List = [] else (if get_functor_ordinal(Datatype, Counter, Temp_Nth) then Real_Nth = Temp_Nth else error("get_freq/5 : get_functor_ordinal/3 failed")), test_freq(Datatype, NumFunctors, Real_Nth, LevelRequired0, Frequencies, GF, SubBranch), List0 = get_freq(Datatype, NumFunctors, Counter + 1, Frequencies, GF), LevelRequired = max(0, LevelRequired0), List = [LevelRequired - SubBranch|List0]). % test_freq/7 extract the required_level and the frequency of % sub-constructors by the following steps : % 1 If Frequencys is non-empty, then there is specific frequency, % so call freq_info/5 to get the infomation % 2 If Frequencys is empty, then search for general frequency % 3a If a match is found in general frequency, then restart % test_freq with the general frequency for that type as % the specific frequency % 3b If no match is found, then apply default frequency :- pred test_freq(type_desc, int, int, int, list(frequency), general_frequencies, list(list(frequency))). :- mode test_freq(in, in, in, out, in, in, out) is det. test_freq(_Datatype, NumFunctors, Nth, LevelRequired, Freqs@[_|_], _GF, NewF) :- if list.length(Freqs) = NumFunctors then freq_info(0, Nth, Freqs, LevelRequired, NewF) else error("test_freq/5 error: frequencies not match args"). test_freq(Datatype, NumFunctors, Nth, LevelRequired, [], GF, NewF) :- search(GF, Datatype, TempFreq) -> test_freq(Datatype, NumFunctors, Nth, LevelRequired, TempFreq, [], NewF) ; LevelRequired = 1, NewF = []. % freq_info/5 extracts specific frequency and its sub-constructor's % frequency contained in the Nth element. % The base case may be redundant, to cover [[]] case. % freq_info/5 recursively increases the counter until it equals Nth, % then get the info stored in Frequency. :- pred freq_info(int, int, list(frequency), int, list(list(frequency))). :- mode freq_info(in, in, in, out, out) is det. freq_info(_, _, [], 100, []). freq_info(Counter, Nth, [Frequency|Frequencies], LevelRequired, NewF) :- if Counter = Nth then Frequency = freq(LevelRequired, NewF) else freq_info(Counter + 1, Nth, Frequencies, LevelRequired, NewF). % select_branch/4 selects a branch when the Selector is within % that branch's range. :- func select_branch(int, int, int, specific_frequency) = frequency. select_branch(_, _, _, []) = _ :- error("select_branch/4 : no branch to select"). select_branch(Selector, Counter, Branch0, [Relative - SubBranch|TempFreqs]) = freq(Branch, SubFreq) :- if Counter + Relative > Selector then Branch = Branch0, SubFreq = SubBranch else freq(Branch, SubFreq) = select_branch(Selector, Counter + Relative, Branch0 + 1, TempFreqs). % find_user_gen/3 pass through the generator list, looking for % matching type_desc. If it's found, then return the % generating function, else this predicate will fail. % DMA: One would think that reimplementing this list as an % assoc_list would save all this coding, but since the sought % value is a HO type, the simple `out' mode will cause all % sorts of problems during compilation. I wonder if there's % such a thing as polymodal programming and if it would solve % the problem... :- pred find_user_gen(type_desc, list(user_gen_type(RNG)), pred(type_desc, univ, list(frequency), general_frequencies, list(user_gen_type(RNG)), generator(RNG), generator(RNG))) <= rng(RNG). :- mode find_user_gen(in, list_skel_in(user_gen_inst(RNG)), out(pred(in, out, in, in, list_skel_in(user_gen_inst(RNG)), in, out) is det)) is semidet. find_user_gen(Datatype, [user_generator(Type, TempGenerator)|Generators], Generator) :- if Datatype = Type then Generator = TempGenerator else find_user_gen(Datatype, Generators, Generator). %---------------------------------------------------------------------------% % There are 11 version of nailFuncType correspond to each % arity of random funcion :- pred nailFuncType(T, (func) = T). :- mode nailFuncType(unused, unused) is det. :- pred nailFuncType(T1, T, func(T1) = T). :- mode nailFuncType(unused, unused, unused) is det. :- pred nailFuncType(T1, T2, T, func(T1, T2) = T). :- mode nailFuncType(unused, unused, unused, unused) is det. :- pred nailFuncType(T1, T2, T3, T, func(T1, T2, T3) = T). :- mode nailFuncType(unused, unused, unused, unused, unused) is det. :- pred nailFuncType(T1, T2, T3, T4, T, func(T1, T2, T3, T4) = T). :- mode nailFuncType(unused, unused, unused, unused, unused, unused) is det. :- pred nailFuncType(T1, T2, T3, T4, T5, T, func(T1, T2, T3, T4, T5) = T). :- mode nailFuncType(unused, unused, unused, unused, unused, unused, unused) is det. :- pred nailFuncType(T1, T2, T3, T4, T5, T6, T, func(T1, T2, T3, T4, T5, T6) = T). :- mode nailFuncType(unused, unused, unused, unused, unused, unused, unused, unused) is det. :- pred nailFuncType(T1, T2, T3, T4, T5, T6, T7, T, func(T1, T2, T3, T4, T5, T6, T7) = T). :- mode nailFuncType(unused, unused, unused, unused, unused, unused, unused, unused, unused) is det. :- pred nailFuncType(T1, T2, T3, T4, T5, T6, T7, T8, T, func(T1, T2, T3, T4, T5, T6, T7, T8) = T). :- mode nailFuncType(unused, unused, unused, unused, unused, unused, unused, unused, unused, unused) is det. :- pred nailFuncType(T1, T2, T3, T4, T5, T6, T7, T8, T9, T, func(T1, T2, T3, T4, T5, T6, T7, T8, T9) = T). :- mode nailFuncType(unused, unused, unused, unused, unused, unused, unused, unused, unused, unused, unused) is det. :- pred nailFuncType(T1, T2, T3, T4, T5, T6, T7, T8, T9, T10, T, func(T1, T2, T3, T4, T5, T6, T7, T8, T9, T10) = T). :- mode nailFuncType(unused, unused, unused, unused, unused, unused, unused, unused, unused, unused, unused, unused) is det. nailFuncType(_, _). nailFuncType(_, _, _). nailFuncType(_, _, _, _). nailFuncType(_, _, _, _, _). nailFuncType(_, _, _, _, _, _). nailFuncType(_, _, _, _, _, _, _). nailFuncType(_, _, _, _, _, _, _, _). nailFuncType(_, _, _, _, _, _, _, _, _). nailFuncType(_, _, _, _, _, _, _, _, _, _). nailFuncType(_, _, _, _, _, _, _, _, _, _, _). nailFuncType(_, _, _, _, _, _, _, _, _, _, _, _). % modified: March 8, 2007, DMA % changed: Converted the internal RNG typeclass to the trandom1 % tausworthe3 implementation. % modified: February 14, 2007, DMA, Happy St. Valentine's Day! % changed: As num_functors/1 is now semidet, added an if-then-else % guard to rand_union/6 to keep it det. % modified: May 5, 2006, DMA % changed: Reimplemented this sub-module as the random number % generator is now a type containing the typeclassed % generator. The change allows the user to control the % ranges on the simple types (int, float and char) by % modifying the generator itself (as opposed to wresting % control from qcheck during testing). % modified: May 3, 2006, DMA % changed: readjusted import_module declarations as the parent % module went through a bit of shuffling (that, % particularly, dropped the pair module from the parent, % so we add the import declaration for pair here). % modified: April 19, 2006, DMA % changed: Moved frequency and user_gen_type types to this % module. Used typeclass instance to obtain random % values (this statement, of course, signifies pervasive % change). :- end_module qcheck2.generators. tests/qcheck2.html0000644000076500001200000004753310441350056015331 0ustar dauclairadmin00000000000000 qcheck 2.0

qcheck, version 2.0

Introduction

QuickCheck is a system developed by John Hughes and Koen Claessen. Its premise is that comprehesive testing can be obtained by combining a testing specification language and test data automation ("random testing"). It has been ported to several languages from its native Haskell: the Mercury programming language provides a QuickCheck facility in their "extras" distribution, called qcheck.

As it stands, the original qcheck (herein after referred to as Q1) is an excellent piece of work, fully capable of testing entire systems. It can decipher how to generate example data from user-defined types. It also provides examples for various general and specific situations where the user may wish to exercise control over the ranges or frequencies of the data generated. What, then, would need to be changed?

Not much, it turns out. The fundamental aspects of the system -- comprehesive unit testing fed by randomly-generated values and directed by a test specification remain intact, but there are several features to comprehensive testing that can be added to improve this system. Q1 is good at verifying that one particular predicate behaves as it should, but it gives no indication that all the (interface) predicates of a system have been tested. Further, the user has some control over the detail reported for each test, but, for a user wishing a summary report, even the smallest report allowed is too much detail: adding a facility that give the user complete control over reportage becomes necessary for larger systems. Finally, Q1 has an excellent facility to generate random values for user-defined types, but for primitive types (such as char, int, and float), the approach is a bit arcane (only mentioned in one of the last examples) and lossy -- giving the user control over the random number generator itself, and integrating that part of the system with the goal of ease of use will carry forward the automation of user-defined typed values as well as simplify controlling ranges of generated primitive values.

These improvements were the aim of this new version: keep the essence of previous version while adding these new layers to help the tester verify much larger systems. The first two aims outlined above, that of comprehension and detail, are addressed by the new reporting facility that exists both outside qcheck2 proper and is also integrated into its state. The third aim, more and simpler control over randomly-generated values, incorporate changes that now allow the user to define their own random number generator (or to use the very excellent one supplied) and also to change the generator's behavior in the midst of testing. We will address each aim, and their implementations, in the following sections.

Aims

Aim 1: Comprehension

One question that testing frameworks, such as QuickCheck, must eventually address, particularly for larger systems, is the one of completeness. Or, "has the entire functionality of the system been tested?" Under the first implementation this is a difficult question to answer, and the root of this problem is a rather trivial one to fix: the second input argument to qcheck/[4,7,8] is a string that has the purpose of describing the test to be performed. Typing this argument as a string is rather limitting: although the (human) user can seen the purpose from the description, the problem is that encoding the test description as a string does not facilitate reasoning about test results mechanically, which makes it difficult for the system to report on what was and, importantly, was not, covered in the testing.

A new accumulated state variable

The fix to this problem is therefore simple: generalize the test description argument to any (univeral) type. This way other systems may, for example, generate a model of the system being tested and then, after the tests are completed, a method of tabulating and reporting the results. The internals of Q1 change in two ways: first, the description type signature is relaxed, and second, as reportage is spread across several calls to qcheck/[4,7,8], we will defer the commitment of outputting results until the user so determines. In this case, we convert the state variable from io.state (which commits the output) to a specific accumulator (that simply collects it):

:- pred qcheck(T, Desc, int, list(list(frequency)),
               general_frequencies, list(user_gen_type(RNG)),
               qstate(RNG, Desc), qstate(RNG, Desc))
        <= (testable(T), random_number_generator(RNG)).

:- mode qcheck(in, in, in, in, in, list_skel_in(user_gen_inst(RNG)),
               in, out) is det.
where:
T the type (pred/func) to test
Desc a generic type describing the test
int number of tests
list(list(frequency)) list of specific frequencies (as per Q1)
general_frequencies list of general frequencies for testing (described later)
list(user_gen_type(RNG)) user-defined types for value generation, as per Q1, specialized on the random number generator
qstate(RNG, Desc) The state variable collecting test results and keeping the random number generator au courant

The typeclass testable(T) is as per Q1; and the random number generator typeclass (random_number_generator(RNG)) will be discussed under the value generator aim.

For the new types for qcheck2:

:- type general_frequencies == assoc_list(type_desc, list(frequency)).
:- type qstate(RNG, Description)
        ---> qstate(generator(RNG), map(Description, test_results)).
:- type test_results
        ---> test_results(int, int, int, bag(univ))
        ;    falsifiable(univ).

The above qstate type shows that the test description is mapped to the test_results type, as qcheck/[4,7,8] is called for each test, it accumulates the test results indexed by the (generic) description.

The Program Modelling Tool

As Description can be of any type, we can now allow the user to pass in a simple description string, as in Q1, or, alternatively, we can enhance the description with something that we can use as a declarative index. In Prolog, we could use the index of the module-qualified name of the predicate. Mercury is not as dynamic a system to allow any number of module/predicate/function values for Description,1 so we will employ a preprocessing system to identify and alias all interface predicate/function types to a uniform (enumerated) type. One such system is qcpt available from logicaltypes.com packaged into the ltq system. From an input set of files, qcpt generates the following types:

:- program_module
        ---> <names of modules in system>.
:- func all_program_modules = list(program_module).
:- func all_public_predicates = list(full_predicate_signature).

:- type public_predicate_signature
        ---> public_predicate / int.

:- type full_predicate_signature
        ---> public(program_module, public_predicate_signature).

:- type test_desc == pair(full_predicate_signature, string).

:- type public_predicate
        ---> <names of interface predicates>.
Example

Say we wish to test a single module, for example the peano module. By running ...

$ qcpt peano.m

... the file qcheck2.tests_digests_types.m is generated with the above type declarations and the following specific realizations:

% ...

:- type program_module
        ---> peano.

% ...

:- type public_predicate
        ---> increment
	;    peano
	;    to_peano.

:- implementation.

all_program_modules = [
	peano
].

all_public_predicates = [
	public(peano, increment/2),
	public(peano, peano/2),
	public(peano, to_peano/2)
].

A new reporting facility

Given that we now have collected all the public (or interface) predicates and functions of a system, it is now also possible to determine the completeness of the testing, in that all of those predicates were tested. It simply now falls to a system to collect the results of testing and report the results. The user may attack this task any number of ways, but we also provide one implementation in module qcheck2.tests_digest_reports. The predicate

show_module_tests_summary(Results, !IO)

does all this work by comparing the accumulated test Results (typed as an assoc_list(test_desc, test_results), where test_desc is provided by module qcheck2.tests_digest_types (generated from the tested module using qcpt), and the assoc_list is the accumulated result of calling a set of qcheck/[4,7,8] goals).

The show_module_tests_summary/3 predicate reports the total number of tests (and those that passed) within each module and reports the number of predicates that succeeded all unit testing. This predicate also reports, by name and arity, the predicates not tested by the framework.

Example

The following report ...

$ ./peano_unit_tests_missing_to_peano

Qcheck2 tested the following modules:
*** 6/6 tests passed on 2/3 predicates in peano
    (did not test to_peano/2)

... shows that my modifications to module peano_unit_tests (I commented out the to_peano/2 tests) resulted in all tests passing, but the test suite did not provide full coverage of the peano module's functionality.

Traditional Reportage

Module qcheck2.reports provides two ways to report results as Q1 did:

show_test_results_sets(Results, !IO)
show_test_results(Description, test_results, !IO)

The predicate show_test_results_sets/3 simply iterates over Results, calling show_test_results/4 at each iteration. The predicate show_test_results/4 reports the results from qcheck/[4,7,8] in the style of Q1.

Example

Here are some of the results reported from running peano_unit_tests_with_failing_test with a call to show_test_results_sets/3:

 
...
1) 
Test description : public(peano, increment / 2) - "Makes sure we get a successor"
Number of test cases that succeeded : 100
Number of trivial tests : 0
Number of tests cases which failed the pre-condition : 0
2) 
Test description : public(peano, increment / 2) - "Checks increment/2\'s compare"
Number of test cases that succeeded : 19
Number of trivial tests : 0
Number of tests cases which failed the pre-condition : 81
Distributions of selected arguments :
13	{0, 1}
5	{1, 2}
1	{2, 3}
3) 
Test description : public(peano, to_peano / 2) - "Tests string creation"
Falsifiable :
i(-68)
 
...

The above examples demonstrate 1) a sample test report where all the tests succeeded (with no reportage on the test values used), 2) a sample where some test values were unusable (with reportage), and 3) a sample where the predicate and test values (by intention) failed the test. These tests are of the same form as those of Q1. The major difference is that test tests are reported separately from the qcheck/[4,7,8] call. This separation allows delayed (even permanently delayed) reporting of results.

Aim 2: Generation

Q1 offers a dizzying array of options when giving the user control over what test values are generated and how they are generated, that is, if these values are to be generated from user-defined, or complex (not builtin), types. It also offers a generator of such power that it is dubbed: "The Mother of all Random Number Generators" by its creator. Impressive as the above offerings are (and they are, in fact, impressive) there are two glaring wants: first, one is required to use the supplied generator -- users are not permitted alternate generators for their own testing, and this becomes an issue when, for example, "pure" randomness (such as the values provided by random.org), or cryptological-strength randomness is a requirement of the tested system, and, second, restricting the ranges of primitive builtins (or other "unbound" enumerated types (such as integer)) is not directly feasible (albeit possibly with some esoteric indirection). We address each of these wants in the new system in this document by turns.

Want 1: User-supplied random number generators

Q1 was built to hide its inner workings. This software principle is considered to be good practice, but, since one of the inner workings is random number generation to generate test values, this good practice obstructs the ability to replace the random number generator when so required. The new architecture in qcheck2 exposes the random number generator in the state variable, allowing its replacement by alternate equivalent types. The change also comes with a supplied state initialization predicate that provides the default random number generator.

The design of the system requires the user to wrap their random number generator (hereinafter referred to as the RNG) in type described in the next section, and it must conform to the following typeclass:

:- typeclass random_number_generator(RNG) where [
        % gives a random float on the range [0, 1)
        pred rnd(float::out, RNG::in, RNG::out) is det,
	pred reseed(int::in, RNG::unused, RNG::out) is det
].
where:
rnd/3 supplies a float between 0.0 and 1.0 and updates the state of the RNG; and
reseed/3 reinitializes the RNG with the seed supplied as the first argument.

Want 2: User-controllable numeric ranges

It is very easy for the user of Q1 to specify a discriminated-union type and have the system generate test examples. The problem is for builtin types: Q1 does not consider bounds when generating floats, ints and, surprisingly, chars.2 One could argue that by choosing unbound types, the user must be prepared to accept any value those types describe, and indeed this is true. Where this argument falls apart is when the user wishes to test predicates within their nominal ranges. Certainly the test framework should generate test data that tests beyond the ranges, but when every test case offered is extrinsic, nothing is gained by submitting that predicate to random testing. In short, the user must be allowed direct control over ranges of test values of builtin types when the situation warrants.

:- type generator(RNG)
        ---> generator(int_range, float_range, character_type, RNG).
where:
int_range is either range(int, int) or unbound

Endnotes

1

Well, this statement is not true in all cases -- if all the tested predicates had the same type and modality then one may simply use the name of the predicate as the Description. See, for example, modules foo and foo_unit_tests included in the distribution. The material point here is that although it is possible to use the name of a predicate as the Description it is not realistic given that most systems use predicates with different types, arities, and modalities.
2

Q1 treats strings as list(int), where each element is a char-equivalent int, which can be positive, negative or, as is most often the case, of very large magnitude.
tests/qcheck2.m0000644000076500001200000002347610575550460014632 0ustar dauclairadmin00000000000000:- module qcheck2. %---------------------------------------------------------------------------% % Copyright (C) 2001, 2003, 2005-2006 The University of Melbourne. % This file may only be copied under the terms of the GNU Library General % Public License - see the file COPYING.LIB in the Mercury distribution. %---------------------------------------------------------------------------% % % file qcheck2.m % original author: xcsm % % The source code for autotest generator similar to Haskell's % quickcheck. A user guide is available at ./tutes/ in html format. % %---------------------------------------------------------------------------% %---------------------------------------------------------------------------% :- interface. :- import_module assoc_list. :- import_module bool. :- import_module char. :- import_module float. :- import_module io. :- import_module list. :- import_module string. :- import_module type_desc. :- import_module univ. :- import_module utils. :- import_module utils.random. :- include_module qcheck2.types. :- include_module qcheck2.generators. :- include_module qcheck2.testable. :- include_module qcheck2.reports. :- include_module qcheck2.tests_digest_types. :- include_module qcheck2.tests_digest_reports. :- import_module qcheck2.types. :- import_module qcheck2.generators. :- import_module qcheck2.testable. :- import_module qcheck2.reports. :- import_module qcheck2.tests_digest_types. :- import_module qcheck2.tests_digest_reports. %---------------------------------------------------------------------------% % qcheck/4(A,B, G,H) = qcheck/8(A,B,C,100,[],[],[],G,H) % qcheck/7(A,B,C,D,E, G, H) = qcheck/8(A,B, C, D, E,[],G,H) % qcheck/8(A, B, C, D, E, F, G, H) % A : invariant test function, satisfing testable(T) % B : some test description % C : number of tests to run % D : specific frequency % E : general frequency % F : list of user-defined generator % G : qstate(RNG, TestResults) in % H : qstate(RNG, TestResults) out % % Quickcheck is able to generate random values for each input % argument of the invariant function at run time, provided % that there is a default/custom generator for that type. % The default generator is able to generate type int, char, % float, string, string, discriminated union and certain functions. % Details are explained in the tutorials. % % If any test fails, quickcheck will report the failed test, % and call io.set_exit_status(1). % If all tests pass, quickcheck will print a summary of the % tests executed -- the depth of details reported is % user-controlled with printing predicates available in % qcheck2.reports. % % Quickcheck makes the assumption that the distincation between % a function and a discriminated union is that num_functors(FuncType) % is -1, while num_functors(UnionType) is not -1. % As a result of this assumption, the function should not be called % where qcheck needs to generate a type that is not supported by the % default/custom generators. :- pred qcheck(T, Desc, qstate(RNG, Desc), qstate(RNG, Desc)) <= (testable(T), rng(RNG)). :- mode qcheck(in, in, in, out) is det. :- pred qcheck(T, Desc, int, list(list(frequency)), general_frequencies, qstate(RNG, Desc), qstate(RNG, Desc)) <= (testable(T), rng(RNG)). :- mode qcheck(in, in, in, in, in, in, out) is det. :- pred qcheck(T, Desc, int, list(list(frequency)), general_frequencies, list(user_gen_type(RNG)), qstate(RNG, Desc), qstate(RNG, Desc)) <= (testable(T), rng(RNG)). :- mode qcheck(in, in, in, in, in, list_skel_in(user_gen_inst(RNG)), in, out) is det. % The new property will store the value in T % as type univ, later calling function will count % the number of occurrence of that value :- func T `>>>` property = property. % If the 1st argument is equal to the 2nd argument % then the new property will be marked as trivial :- func to_trivial(T, T, property) = property. % If the left argument equals the right, then reture property:[yes], % otherwise reture property:[no] :- func T `===` T = property. % list_length/1 is the same as the function version of list__length. % list__length/1 always returns an int. The problem is that the % compiler doesn't know whether to call the list__length function, or % pass a curried version of the predicate version of list__length/2. :- func list_length(list(T)) = int. %---------------------------------------------------------------------------% :- implementation. :- import_module bag. :- import_module int. :- import_module pair. :- import_module require. :- import_module svbag. %---------------------------------------------------------------------------% qcheck(TestFunction, Description) --> qcheck(TestFunction, Description, 100, [], [], []). qcheck(TestFunction, Desc, Counter, SpecificFrequency, GeneralFrequency) --> qcheck(TestFunction, Desc, Counter, SpecificFrequency, GeneralFrequency, []). % qcheck/8 generates the required inputs for the invariant % function and runs it, accumulating a table of test results qcheck(TestFunction, Desc, TestCount, SpecificFrequency, GeneralFrequency, Generators, qstate(Gen0, Results), qstate(Gen1, [Desc - TestResults|Results])) :- testing(TestFunction, Desc, SpecificFrequency, GeneralFrequency, Generators, TestCount, test_state(Gen0, test_results(0, 0, 0, bag.init)), test_state(Gen1, TestResults)). % test_state assembles the test_results for just one (named) % test (as opposed to qstate which carries the map of the test % (names) to the set of test_results). :- type test_state(RNG) ---> test_state(generator(RNG), test_results). %---------------------------------------------------------------------------% % testing/8 recursively runs the test until TestCount drops to 0. % After each test it updates the statistics. :- pred testing(T, Desc, list(list(frequency)), general_frequencies, list(user_gen_type(RNG)), int, test_state(RNG), test_state(RNG)) <= (testable(T), rng(RNG)). :- mode testing(in, in, in, in, list_skel_in(user_gen_inst(RNG)), in, in, out) is det. testing(TestFunction, Desc, SpecificFrequency, GeneralFrequency, Generators, TestCount, !TestState) :- TestCount =< 0 -> true ; !.TestState = test_state(Gen0, Res0), test(TestFunction, SpecificFrequency, GeneralFrequency, Generators, result(P, Univ), Gen0, Gen1), !:TestState = test_state(Gen1, Res0), (if member(no, P), not member(condition, P) then !:TestState = test_state(Gen1, falsifiable(Univ)) else update(P, !TestState), testing(TestFunction, Desc, SpecificFrequency, GeneralFrequency, Generators, TestCount - 1, !TestState)). % update/4 analyses the current invariant test result and updates % the statistic accordingly :- pred update(property, test_state(RNG), test_state(RNG)) <= rng(RNG). :- mode update(in, in, out) is det. update(_P, test_state(Gen, falsifiable(A)), test_state(Gen, falsifiable(A))). update(P, test_state(Gen, test_results(YesCount0, TrivialCount0, FailedConditionCount0, Distribution0)), test_state(Gen, test_results(YesCount, TrivialCount, FailedConditionCount, Distribution))) :- if member(condition, P) then FailedConditionCount = FailedConditionCount0 + 1, YesCount = YesCount0, TrivialCount = TrivialCount0, Distribution = Distribution0 else YesCount = YesCount0 + 1, FailedConditionCount = FailedConditionCount0, update_dist(P, Distribution0, Distribution), (if member(trivial, P) then TrivialCount = TrivialCount0 + 1 else TrivialCount = TrivialCount0). % update_dist/3 recursively exacts the 'flag:info(univ)' from % property and adds it to the master list of distribution. :- pred update_dist(property, bag(univ), bag(univ)). :- mode update_dist(in, in, out) is det. update_dist([]) --> []. update_dist([Property|Properties], !Distro) :- (Property = info(Univ) -> insert(Univ, !Distro); true), update_dist(Properties, !Distro). %---------------------------------------------------------------------------% to_trivial(Input, Pattern, Property0) = Property :- Input = Pattern -> Property = [trivial|Property0] ; Property = Property0. Left `>>>` Right = [ info(univ(Left)) | Right]. Left `===` Right = [bool_to_property(pred_to_bool(unify(Left, Right)))]. :- func bool_to_property(bool) = flag. bool_to_property(yes) = yes. bool_to_property(no) = no. list_length(List) = list.length(List). %---------------------------------------------------------------------------% % modified: March 7, 2007, DMA (Douglas M. Auclair) % changed: Eliminated rnd submodule, replaced it with the tausworthe3 % RNG typeclasss implementation from the Mercury maillist. % modified: February 14, 2007, DMA, Happy Valentine's Day! % changed: Moved module rnd into qcheck2's submodule sphere. % modified: May 13, 2006, DMA % changed: Renamed to 'qcheck2'; renamed sub_module to conform % modified: May 9, 2006, DMA % changed: Added type-digests from tested modules. % modified: May 4, 2006, DMA % changed: Converted the Name input parameter from a string to some % generic type so that the description can be anything % useful to the user in classifying (grouping) tests. % modified: May 3, 2006, DMA % changed: Moved support functionality to their own sub-modules % (testibility, (random) argument generation, types shared % across modules and reporting). Changed the qcheck % protocol to work with a 'qstate' environment instead of % io to allow multiple qchecks to interact. Converted the % list(distribution) type and counting management algorithms % into bag(univ) that automagically takes care of the % counting housekeeping. :- end_module qcheck2. tests/qcheck2.reports.m0000644000076500001200000000676110434154212016312 0ustar dauclairadmin00000000000000:- module qcheck2.reports. % synopsis: Provides various representations of the results from % running qcheck once or severally, including printing % routines for parts of the report, including distributions. % main author: xcsm % modified by: Douglas M. Auclair (DMA) % created: April 18, 2006 % copyright (C) 2001, 2003, 2005-2006, under the LGPL % modified: May 13, 2006, DMA % changed: Conformed this module's name to the new 'qcheck2' versioning. % modified: May 9, 2006, DMA % changed: Moved reporting specific to test_desc type to % qcheck2.tests_digest_reports. % modified: May 5, 2006, DMA % changed: Sorted the frequency distribution on the frequency. % modified: May 3, 2006, DMA % changed: As we collect test results from multiple qchecks now, % I've added the show_test_result_sets/3 pred that shows % the test results as before but for all tests in one go. :- interface. :- import_module assoc_list. :- import_module io. :- import_module qcheck2.types. % show_test_result_sets/3 shows (indexed) sets of test_results :- pred show_test_result_sets(assoc_list(Desc, test_results), io, io). :- mode show_test_result_sets(in, di, uo) is det. % show_test_results/4 prints out the results and the distribution. :- pred show_test_results(Desc, test_results, io, io). :- mode show_test_results(in, in, di, uo) is det. %---------------------------------------------------------------------------% :- implementation. :- import_module deconstruct. :- import_module int. :- import_module pair. :- import_module require. :- import_module string. :- import_module univ. %---------------------------------------------------------------------------% show_test_result_sets([]) --> []. show_test_result_sets([Name - Results|Rest]) --> show_test_results(Name, Results), show_test_result_sets(Rest). show_test_results(Name, TestResults) --> format("\nTest description : %s\n", [s(string(Name))]), show_test_results_aux(TestResults). :- pred show_test_results_aux(test_results::in, io::di, io::uo) is det. show_test_results_aux(falsifiable(CounterExample)) --> set_exit_status(1), print("Falsifiable :\n"), display_univ(CounterExample). show_test_results_aux(test_results(Yesses, Trivials, FailedPreconditions, Distributions)) --> format("Number of test cases that succeeded : %d Number of trivial tests : %d Number of tests cases which failed the pre-condition : %d ", [i(Yesses), i(Trivials), i(FailedPreconditions)]), show_distributions(Distributions). :- pred show_distributions(bag(univ)::in, io::di, io::uo) is det. show_distributions(Bag, !IO) :- bag.is_empty(Bag) -> true ; to_assoc_list(Bag, RevDistros), reverse_members(RevDistros, Distros), sort(Distros, RevSort), reverse(RevSort, Sordid), print("Distributions of selected arguments :\n", !IO), write_list(Sordid, "\n", (pred(Pair::in, di, uo) is det --> { Pair = Freq - Univ }, format("%d\t", [i(Freq)]), write(univ_value(Univ))), !IO), nl(!IO). % display_univ/3 should will called with a univ of a tuple, it % will then print out the elements in that tuple. :- pred display_univ(univ::in, io::di, io::uo) is det. display_univ(Univ, !IO) :- Args = univ_value(Univ), deconstruct(Args, canonicalize, _, _, Univs), write_list(Univs, "\n", (pred(Val::in, di, uo) is det --> write(univ_value(Val))), !IO). :- end_module qcheck2.reports. tests/qcheck2.testable.m0000644000076500001200000003624610575641302016427 0ustar dauclairadmin00000000000000:- module qcheck2.testable. % synopsis: Provides the (functional-)types that are testable by qcheck. % main author: xcsm % modified by: Douglas M. Auclair (DMA) % created: April 18, 2006 % copyright (C) 2001, 2003, 2005-2006 under the LGPL :- interface. :- import_module bool. :- import_module list. :- import_module qcheck2.types. :- import_module utils.random. % The implemented instances are designed for invariant % functions with 0 to 10 arity, and returning a property. :- typeclass testable(T) where [ (pred test(T, list(list(frequency)), general_frequencies, list(user_gen_type(RNG)), qcheck2.types.result, generator(RNG), generator(RNG)) <= rng(RNG)), (mode test(in, in, in, list_skel_in(user_gen_inst(RNG)), out, in, out) is det) ]. % Mercury doesn't allow instance declarations for function types. % Hence we have to wrap up the function types in user-defined % types f1(T), f2(T1, T2), f3(T1, T2, T3), ... :- type f0 ---> f((func) = property). :- type f1(T1) ---> f(func(T1) = property). :- type f2(T1, T2) ---> f(func(T1, T2) = property). :- type f3(T1, T2, T3) ---> f(func(T1, T2, T3) = property). :- type f4(T1, T2, T3, T4) ---> f(func(T1, T2, T3, T4) = property). :- type f5(T1, T2, T3, T4, T5) ---> f(func(T1, T2, T3, T4, T5) = property). :- type f6(T1, T2, T3, T4, T5, T6) ---> f(func(T1, T2, T3, T4, T5, T6) = property). :- type f7(T1, T2, T3, T4, T5, T6, T7) ---> f(func(T1, T2, T3, T4, T5, T6, T7) = property). :- type f8(T1, T2, T3, T4, T5, T6, T7, T8) ---> f(func(T1, T2, T3, T4, T5, T6, T7, T8) = property). :- type f9(T1, T2, T3, T4, T5, T6, T7, T8, T9) ---> f(func(T1, T2, T3, T4, T5, T6, T7, T8, T9) = property). :- type f10(T1, T2, T3, T4, T5, T6, T7, T8, T9, T10) ---> f(func(T1, T2, T3, T4, T5, T6, T7, T8, T9, T10) = property). :- instance testable(f0). :- instance testable(f1(T1)). :- instance testable(f2(T1, T2)). :- instance testable(f3(T1, T2, T3)). :- instance testable(f4(T1, T2, T3, T4)). :- instance testable(f5(T1, T2, T3, T4, T5)). :- instance testable(f6(T1, T2, T3, T4, T5, T6)). :- instance testable(f7(T1, T2, T3, T4, T5, T6, T7)). :- instance testable(f8(T1, T2, T3, T4, T5, T6, T7, T8)). :- instance testable(f9(T1, T2, T3, T4, T5, T6, T7, T8, T9)). :- instance testable(f10(T1, T2, T3, T4, T5, T6, T7, T8, T9, T10)). % If the right argument is a property, then 'flag:condition' will % be added into the original property provided the left argument is % 'bool:yes' or '(pred):succeed' % If the right argument is (func) = property, then `===>` will return % 'property:[condition]' without evaluating the (func) if the left % argument is 'bool:yes' or '(pred):succeed'. :- typeclass conditional(T1, T2) where [ func T1 `===>` T2 = property ]. :- instance conditional(bool, property). :- instance conditional(bool, f0). :- instance conditional((pred), property). :- instance conditional((pred), f0). %---------------------------------------------------------------------------% :- implementation. :- import_module univ. %---------------------------------------------------------------------------% % The following are the 11 instances of testable % Each instance began by inst cast the invariant test function from % ground to func(in, in, ...) = out. % Then the specific frequency is extracted; if the SF list is shorter % than the list of arguments, then the last few argument will have % [] as their SF; if the SF list is longer than the list of arguments, % then the list few SF is not used. % test/7 then calls gen/6 to generate the arguments, the invariant % function is then run with those arguments. % The test result is returned along with the arguments generated. :- instance testable(f0) where [ (test(F, _, _, _, R, !Gen) :- inst_cast_f0(F, NF), univ({"no argument"}) = Args, R = result(apply(NF), Args)) ]. :- instance testable(f1(T1)) where [ (test(F, SF0, GF, Generators, R, !Gen) :- gen(X, det_headlist(SF0, _), GF, Generators, !Gen), inst_cast_f1(F, NF), univ({ X }) = Args, result(NF(X), Args) = R) ]. :- instance testable(f2(T1, T2)) where [ (test(F, SF0, GF, Generators, R, !RNG) :- gen(X, det_headlist(SF0, SF1), GF, Generators, !RNG), gen(Y, det_headlist(SF1, _), GF, Generators, !RNG), inst_cast_f2(F, NF), R = result(apply(NF, X, Y), univ({X, Y}))) ]. :- instance testable(f3(T1, T2, T3)) where [ (test(F, SF0, GF, Generators, R, !RNG) :- gen(X, det_headlist(SF0, SF1), GF, Generators, !RNG), gen(Y, det_headlist(SF1, SF2), GF, Generators, !RNG), gen(Z, det_headlist(SF2, _), GF, Generators, !RNG), inst_cast_f3(F, NF), R = result(NF(X, Y, Z), univ({X, Y, Z}))) ]. :- instance testable(f4(T1, T2, T3, T4)) where [ (test(F, SF0, GF, Generators, R, !RNG) :- gen(X1, det_headlist(SF0, SF1), GF, Generators, !RNG), gen(X2, det_headlist(SF1, SF2), GF, Generators, !RNG), gen(X3, det_headlist(SF2, SF3), GF, Generators, !RNG), gen(X4, det_headlist(SF3, _), GF, Generators, !RNG), inst_cast_f4(F, NF), R = result(NF(X1, X2, X3, X4), univ({X1, X2, X3, X4}))) ]. :- instance testable(f5(T1, T2, T3, T4, T5)) where [ (test(F, SF0, GF, Generators, R, !RNG) :- gen(X1, det_headlist(SF0, SF1), GF, Generators, !RNG), gen(X2, det_headlist(SF1, SF2), GF, Generators, !RNG), gen(X3, det_headlist(SF2, SF3), GF, Generators, !RNG), gen(X4, det_headlist(SF3, SF4), GF, Generators, !RNG), gen(X5, det_headlist(SF4, _), GF, Generators, !RNG), univ({X1, X2, X3, X4, X5}) = Args, inst_cast_f5(F, NF), R = result(NF(X1, X2, X3, X4, X5), Args)) ]. :- instance testable(f6(T1, T2, T3, T4, T5, T6)) where [ (test(F, SF0, GF, Generators, R, !RNG) :- gen(X1, det_headlist(SF0, SF1), GF, Generators, !RNG), gen(X2, det_headlist(SF1, SF2), GF, Generators, !RNG), gen(X3, det_headlist(SF2, SF3), GF, Generators, !RNG), gen(X4, det_headlist(SF3, SF4), GF, Generators, !RNG), gen(X5, det_headlist(SF4, SF5), GF, Generators, !RNG), gen(X6, det_headlist(SF5, _), GF, Generators, !RNG), inst_cast_f6(F, NF), univ({X1, X2, X3, X4, X5, X6}) = Args, R = result(NF(X1, X2, X3, X4, X5, X6), Args)) ]. :- instance testable(f7(T1, T2, T3, T4, T5, T6, T7)) where [ (test(F, SF0, GF, Generators, R, !RNG) :- gen(X1, det_headlist(SF0, SF1), GF, Generators, !RNG), gen(X2, det_headlist(SF1, SF2), GF, Generators, !RNG), gen(X3, det_headlist(SF2, SF3), GF, Generators, !RNG), gen(X4, det_headlist(SF3, SF4), GF, Generators, !RNG), gen(X5, det_headlist(SF4, SF5), GF, Generators, !RNG), gen(X6, det_headlist(SF5, SF6), GF, Generators, !RNG), gen(X7, det_headlist(SF6, _), GF, Generators, !RNG), inst_cast_f7(F, NF), univ({X1, X2, X3, X4, X5, X6, X7}) = Args, R = result(NF(X1, X2, X3, X4, X5, X6, X7), Args)) ]. :- instance testable(f8(T1, T2, T3, T4, T5, T6, T7, T8)) where [ (test(F, SF0, GF, Generators, R, !RNG) :- gen(X1, det_headlist(SF0, SF1), GF, Generators, !RNG), gen(X2, det_headlist(SF1, SF2), GF, Generators, !RNG), gen(X3, det_headlist(SF2, SF3), GF, Generators, !RNG), gen(X4, det_headlist(SF3, SF4), GF, Generators, !RNG), gen(X5, det_headlist(SF4, SF5), GF, Generators, !RNG), gen(X6, det_headlist(SF5, SF6), GF, Generators, !RNG), gen(X7, det_headlist(SF6, SF7), GF, Generators, !RNG), gen(X8, det_headlist(SF7, _), GF, Generators, !RNG), inst_cast_f8(F, NF), univ({X1, X2, X3, X4, X5, X6, X7, X8}) = Args, R = result(NF(X1, X2, X3, X4, X5, X6, X7, X8), Args)) ]. :- instance testable(f9(T1, T2, T3, T4, T5, T6, T7, T8, T9)) where [ (test(F, SF0, GF, Generators, R, !RNG) :- gen(X1, det_headlist(SF0, SF1), GF, Generators, !RNG), gen(X2, det_headlist(SF1, SF2), GF, Generators, !RNG), gen(X3, det_headlist(SF2, SF3), GF, Generators, !RNG), gen(X4, det_headlist(SF3, SF4), GF, Generators, !RNG), gen(X5, det_headlist(SF4, SF5), GF, Generators, !RNG), gen(X6, det_headlist(SF5, SF6), GF, Generators, !RNG), gen(X7, det_headlist(SF6, SF7), GF, Generators, !RNG), gen(X8, det_headlist(SF7, SF8), GF, Generators, !RNG), gen(X9, det_headlist(SF8, _), GF, Generators, !RNG), inst_cast_f9(F, NF), univ({X1, X2, X3, X4, X5, X6, X7, X8, X9}) = Args, R = result(NF(X1, X2, X3, X4, X5, X6, X7, X8, X9), Args)) ]. :- instance testable(f10(T1, T2, T3, T4, T5, T6, T7, T8, T9, T10)) where [ (test(F, SF0, GF, Generators, R, !RNG) :- gen(X1, det_headlist(SF0, SF1), GF, Generators, !RNG), gen(X2, det_headlist(SF1, SF2), GF, Generators, !RNG), gen(X3, det_headlist(SF2, SF3), GF, Generators, !RNG), gen(X4, det_headlist(SF3, SF4), GF, Generators, !RNG), gen(X5, det_headlist(SF4, SF5), GF, Generators, !RNG), gen(X6, det_headlist(SF5, SF6), GF, Generators, !RNG), gen(X7, det_headlist(SF6, SF7), GF, Generators, !RNG), gen(X8, det_headlist(SF7, SF8), GF, Generators, !RNG), gen(X9, det_headlist(SF8, _), GF, Generators, !RNG), gen(X10, det_headlist(SF8, _), GF, Generators, !RNG), inst_cast_f10(F, NF), univ({X1, X2, X3, X4, X5, X6, X7, X8, X9, X10}) = Args, R = result(NF(X1, X2, X3, X4, X5, X6, X7, X8, X9, X10), Args)) ]. % The following are the 11 inst casts, each corresponding to the 11 % insances of testable. :- pred inst_cast_f0(f0, (func) = property). :- mode inst_cast_f0(in, out((func) = out is det)) is det. :- pragma c_code(inst_cast_f0(F0::in, F1::out((func) = out is det)), [thread_safe, will_not_call_mercury], "F1 = F0;"). :- pred inst_cast_f1(f1(T1), func(T1) = property). :- mode inst_cast_f1(in, out(func(in) = out is det)) is det. :- pragma c_code(inst_cast_f1(F0::in, F1::out(func(in) = out is det)), [thread_safe, will_not_call_mercury], "F1 = F0;"). :- pred inst_cast_f2(f2(T1, T2), func(T1, T2) = property). :- mode inst_cast_f2(in, out(func(in, in) = out is det)) is det. :- pragma c_code(inst_cast_f2(F0::in, F1::out(func(in, in) = out is det)), [thread_safe, will_not_call_mercury], "F1 = F0;"). :- pred inst_cast_f3(f3(T1, T2, T3), func(T1, T2, T3) = property). :- mode inst_cast_f3(in, out(func(in, in, in) = out is det)) is det. :- pragma c_code(inst_cast_f3(F0::in, F1::out(func(in, in, in) = out is det)), [thread_safe, will_not_call_mercury], "F1 = F0;"). :- pred inst_cast_f4(f4(T1, T2, T3, T4), func(T1, T2, T3, T4) = property). :- mode inst_cast_f4(in, out(func(in, in, in, in) = out is det)) is det. :- pragma c_code(inst_cast_f4(F0::in, F1::out(func(in, in, in, in) = out is det)), [thread_safe, will_not_call_mercury], "F1 = F0;"). :- pred inst_cast_f5(f5(T1, T2, T3, T4, T5), func(T1, T2, T3, T4, T5) = property). :- mode inst_cast_f5(in, out(func(in, in, in, in, in) = out is det)) is det. :- pragma c_code(inst_cast_f5(F0::in, F1::out(func(in, in, in, in, in)=out is det)), [thread_safe, will_not_call_mercury], "F1 = F0;"). :- pred inst_cast_f6(f6(T1, T2, T3, T4, T5, T6), func(T1, T2, T3, T4, T5, T6) = property). :- mode inst_cast_f6(in, out(func(in, in, in, in, in, in) = out is det)) is det. :- pragma c_code(inst_cast_f6(F0::in, F1::out(func(in, in, in, in, in, in) = out is det)), [thread_safe, will_not_call_mercury], "F1 = F0;"). :- pred inst_cast_f7(f7(T1, T2, T3, T4, T5, T6, T7), func(T1, T2, T3, T4, T5, T6, T7) = property). :- mode inst_cast_f7(in, out(func(in, in, in, in, in, in, in) = out is det)) is det. :- pragma c_code(inst_cast_f7(F0::in, F1::out(func(in, in, in, in, in, in, in) = out is det)), [thread_safe, will_not_call_mercury], "F1 = F0;"). :- pred inst_cast_f8(f8(T1, T2, T3, T4, T5, T6, T7, T8), func(T1, T2, T3, T4, T5, T6, T7, T8) = property). :- mode inst_cast_f8(in, out(func(in, in, in, in, in, in, in, in) = out is det)) is det. :- pragma c_code(inst_cast_f8(F0::in, F1::out(func(in, in, in, in, in, in, in, in) = out is det)), [thread_safe, will_not_call_mercury], "F1 = F0;"). :- pred inst_cast_f9(f9(T1, T2, T3, T4, T5, T6, T7, T8, T9), func(T1, T2, T3, T4, T5, T6, T7, T8, T9) = property). :- mode inst_cast_f9(in, out(func(in, in, in, in, in, in, in, in, in) = out is det)) is det. :- pragma c_code(inst_cast_f9(F0::in, F1::out(func(in, in, in, in, in, in, in, in, in) = out is det)), [thread_safe, will_not_call_mercury], "F1 = F0;"). :- pred inst_cast_f10(f10(T1, T2, T3, T4, T5, T6, T7, T8, T9, T10), func(T1, T2, T3, T4, T5, T6, T7, T8, T9, T10) = property). :- mode inst_cast_f10(in, out(func(in, in, in, in, in, in, in, in, in, in) = out is det)) is det. :- pragma c_code(inst_cast_f10(F0::in, F1::out(func(in, in, in, in, in, in, in, in, in, in) = out is det)), [thread_safe, will_not_call_mercury], "F1 = F0;"). %---------------------------------------------------------------------------% % The following are the 4 instances of conditional, and an inst cast % from ground to (pred) :- instance conditional(bool, property) where [ (Left `===>` Right = Property :- (if Left = yes then Property = Right else Property = [condition|Right])) ]. :- instance conditional(bool, f0) where [ (Left `===>` Right = Property :- inst_cast_f0(Right, Right_Cast), (if Left = yes then Property = apply(Right_Cast) else Property = [condition])) ]. :- instance conditional((pred), property) where [ (Left `===>` Right = Property :- inst_cast_p0(Left, Left_Cast), (if call(Left_Cast) then Property = Right else Property = [condition|Right])) ]. :- instance conditional((pred), f0) where [ (Left `===>` Right = Property :- inst_cast_p0(Left, Left_Cast), inst_cast_f0(Right, Right_Cast), (if call(Left_Cast) then Property = apply(Right_Cast) else Property = [condition])) ]. :- pred inst_cast_p0((pred), (pred)). :- mode inst_cast_p0(in, out((pred) is semidet)) is det. :- pragma c_code(inst_cast_p0(F0::in, F1::out((pred) is semidet)), [thread_safe, will_not_call_mercury], "F1 = F0;"). %---------------------------------------------------------------------------% % det_headlist/2 returns the first element of a list of lists, % and the list of lists without the first element. % If the input list is [], then return [] for both. :- func det_headlist(list(list(T)), list(list(T))) = list(T). :- mode det_headlist(in, out) = out is det. det_headlist([], []) = []. det_headlist([X|Xs], Xs) = X. %---------------------------------------------------------------------------% % modified: March 8, 2007, DMA % changed: Changed the typeclass constraint from the internal, % defunct, RNG to the tausworthe3 RNG implementation. % modified: May 13, 2006, DMA % changed: Conformed this module's name to the new 'qcheck2' versioning. % modified: May 5, 2006, DMA % changed: Added the surrounding type to the typeclassed random % number generator. :- end_module qcheck2.testable. tests/qcheck2.tests_digest_reports.m0000644000076500001200000001415410575570706021106 0ustar dauclairadmin00000000000000:- module qcheck2.tests_digest_reports. % synopsis: Provides reports on types specifically defined by running % module-and-pred-or-func type-maker thingie against the % system to be tested. % author: Douglas M. Auclair (DMA) % created: May 9, 2006 :- interface. :- import_module assoc_list. :- import_module io. :- import_module qcheck2.types. :- import_module qcheck2.tests_digest_types. % Gives a short result statement per module of tested preds/funcs :- type test_map(Module, Pred) == assoc_list(test_description(Module, Pred), test_results). :- pred show_module_tests_summary(test_map(Module, Pred), list(Module), list(full_predicate_signature(Module, Pred)), io, io). :- mode show_module_tests_summary(in, in, in, di, uo) is det. :- implementation. :- import_module list, map, multi_map, pair, set, string. :- use_module svmap. :- type total ---> total(int, int). :- type test_count(Pred) == map(public_predicate_signature(Pred), total). :- type pred_count(Module, Pred) == assoc_list(Module, test_count(Pred)). show_module_tests_summary(Map, Modules, TestedPreds) --> { modules_tested(Modules, Map, Tested, Ignored) }, maybe_write_warning_missing_modules(Ignored), print("Qcheck2 tested the following modules:\n"), write_module_summaries(Tested, TestedPreds), nl. :- pred maybe_write_warning_missing_modules(list(Module)::in, io::di, io::uo) is det. maybe_write_warning_missing_modules([]) --> []. maybe_write_warning_missing_modules(Ignored@[_|_]) --> print("!!!WARNING!!! Did not test modules "), write_list(Ignored, ", ", print), nl. :- pred write_module_summaries(pred_count(Module, Pred)::in, list(full_predicate_signature(Module, Pred))::in, io::di, io::uo) is det. write_module_summaries([], _) --> []. write_module_summaries([Module - TestedPreds|Summaries], AllPreds, !IO) :- filter((pred(FullSig::in) is semidet :- FullSig = public(Module, _)), AllPreds, ModulePreds, OtherPreds), delete_elems(map((func(ModQualFn) = Fn :- ModQualFn = public(_, Fn)), ModulePreds), map.keys(TestedPreds), NotTestedFns), ModulePredCount = length(ModulePreds), collect_results(map.to_assoc_list(TestedPreds), 0, GoodPreds, 0, GoodTests, 0, AllTests), (GoodPreds = ModulePredCount, GoodTests = AllTests -> Prologue = "" ; Prologue = "*** "), format("%s%d/%d tests passed on %d/%d predicates in %s\n", [s(Prologue), i(GoodTests), i(AllTests), i(GoodPreds), i(ModulePredCount), s(string(Module))], !IO), write_fns_not_tested(NotTestedFns, !IO), write_module_summaries(Summaries, OtherPreds, !IO). :- pred write_fns_not_tested(list(public_predicate_signature(Pred))::in, io::di, io::uo) is det. write_fns_not_tested([]) --> []. write_fns_not_tested(Fns@[_|_]) --> print(" (did not test "), write_list(Fns, ", ", (pred(FnAr::in, di, uo) is det --> { FnAr = Fn / Ar }, format("%s/%d", [s(string(Fn)), i(Ar)]))), print(")\n"). :- pred collect_results(assoc_list(public_predicate_signature(Pred), total)::in, int::in, int::out, int::in, int::out, int::in, int::out) is det. collect_results([], !GoodPreds, !GoodTests, !AllTests). collect_results([_ - total(X, Y)|Rest], !GoodPreds, !GoodTests, !AllTests) :- (X = Y -> increment(1, !GoodPreds); true), increment(X, !GoodTests), increment(Y, !AllTests), collect_results(Rest, !GoodPreds, !GoodTests, !AllTests). :- pred increment(int::in, int::in, int::out) is det. increment(A, B, A + B). :- pred modules_tested(list(Module)::in, test_map(Module, Pred)::in, pred_count(Module, Pred)::out, list(Module)::out) is det. modules_tested(AllModules, Map, TestResults, Ignored) :- map((pred(Key::in, Module::out) is det :- Key = public(Module, _) - _), keys(Map), TestedModulesRedundant), TestedModules = to_sorted_list(set(TestedModulesRedundant)), delete_elems(AllModules, TestedModules, Ignored), predicate_test_count(TestedModules, Map, map.init, [], TestResults). :- pred predicate_test_count(list(Module)::in, test_map(Module, Pred)::in, test_count(Pred)::in, pred_count(Module, Pred)::in, pred_count(Module, Pred)::out) is det. predicate_test_count([], _, _) --> []. predicate_test_count([Module|Modules], QcheckResults, Preds0) --> { count_preds(Module, QcheckResults, Preds0, Preds) }, cons(Module - Preds), predicate_test_count(Modules, QcheckResults, map.init). :- pred count_preds(Module::in, test_map(Module, Pred)::in, test_count(Pred)::in, test_count(Pred)::out) is det. count_preds(Module, Map, !Counts) :- filter_map((pred(TestPair::in, PredPair::out) is semidet :- TestPair = (public(Module, Pred) - _String) - Res, PredPair = Pred - success(Res)), Map, Preds), from_flat_assoc_list(Preds) = Mmap, pred_count(multi_map.keys(Mmap), Mmap, !Counts). :- pred pred_count(list(public_predicate_signature(Pred))::in, multi_map(public_predicate_signature(Pred), int)::in, test_count(Pred)::in, test_count(Pred)::out) is det. pred_count([], _) --> []. pred_count([Pred|Signatures], Mmap) --> { multi_map.lookup(Mmap, Pred, Marks), Sum = foldl(plus, Marks, 0) }, svmap.det_insert(Pred, total(Sum, length(Marks))), pred_count(Signatures, Mmap). :- func success(test_results) = int. success(test_results(_, _, _, _)) = 1. success(falsifiable(_)) = 0. % modified: March 13, 2007, DMA % changed: Generalized the input types to allowing testing of modules % with predicate types that are not known until post-qcpt/pre-compile % time. % modified: March 8, 2007, DMA % changed: Corrected a type error: program_module should bed tested_module. % modified: May 21, 2006, DMA % changed: Added check for full-coverage of testing all public % (interface) predicates and functions; report out % predicates /not/ tested in a module. % modified: May 13, 2006, DMA % changed: Conformed this module's name to the new 'qcheck2' versioning. :- end_module qcheck2.tests_digest_reports. tests/qcheck2.tests_digest_types.m0000644000076500001200000000131510575571505020545 0ustar dauclairadmin00000000000000:- module qcheck2.tests_digest_types. % synopsis: Declares the polymorphic types that provide descriptions % of the modules (units) being tested and the public % predicates and functions of those modules that should be tested. % created: circa May 2006; converted from automated file March 13, 2007 % author: Douglas M. Auclair :- interface. :- import_module pair. :- type public_predicate_signature(Pred) ---> Pred / int. :- type full_predicate_signature(Module, Pred) ---> public(Module, public_predicate_signature(Pred)). :- type test_description(Module, Pred) == pair(full_predicate_signature(Module, Pred), string). :- end_module qcheck2.tests_digest_types. tests/qcheck2.types.m0000644000076500001200000001203610574035116015756 0ustar dauclairadmin00000000000000:- module qcheck2.types. % synopsis: The types used by qcheck and its supporting modules. % main author: xcsm % modified by: Douglas M. Auclair (DMA) % created: April 18, 2006 % copyright (C) 2001, 2003, 2005-2006 under the LGPL :- interface. :- import_module assoc_list. :- import_module bag. :- import_module list. :- import_module univ. %---------------------------------------------------------------------------% % The invariant function must return a property to % indicate the result of invariant function. % yes : success % no : failure % trivial : mark the property being returned by a trivial test % info(univ) : store some arbitrary information in type univ, % condition : mark the property being returned by a test which failed % the pre-conditional :- type property == list(flag). :- type flag ---> yes ; no ; trivial ; info(univ) ; condition. % Each result composes of a property, which is the property % returned by the invariant test funcion. The second argument % stores the generated inputs in a univ. :- type result ---> result(property, univ). % test_results collects the cartesian sum of the the % individual qcheck tests. If one of the tests demonstrates % that the tested predicate is untenable, the entire result % set reduces to the falsifiable example. :- type test_results ---> test_results(int, int, int, bag(univ)) ; falsifiable(univ). % The following types constrain (or do not constrain) the % value generated from the RNG. :- type numeric_range(Num) ---> range(Num, Num) ; unbound. :- type int_range == numeric_range(int). :- type float_range == numeric_range(float). :- type character_type ---> utf8; utf16; utf32. % This type carries around the random number generator (which % generates [0, 1) floats and provides it information on how % to generate ints, floats, chars and strings (lists of chars) :- type generator(RNG) ---> generator(int_range, float_range, character_type, RNG). % After we generate a (n appropriately ranged) number, this % predicate updates the type with the resulting generator. :- pred update_generator(RNG, generator(RNG), generator(RNG)). :- mode update_generator(in, in, out) is det. % Gives int.max_int if unbound or MaxInt if range(_, MaxInt) :- func max_int_argument(generator(RNG)) = int. % Carries around the the state of the world from tested % predicate to tested predicate, accumulating the test results % for eventual reportage. :- type qstate(RNG, Description) ---> qstate(generator(RNG), assoc_list(Description, test_results)). :- type what_to_alter ---> int_range(int_range) ; float_range(float_range) ; char_type(character_type). % Modifies the generator value of the qstate, returning the % previous constraint. :- pred altered_state(what_to_alter::in, what_to_alter::out, qstate(RNG, Desc)::in, qstate(RNG, Desc)::out) is det. :- implementation. update_generator(RNG, generator(I, F, C, _RNG0), generator(I, F, C, RNG)). max_int_argument(generator(unbound, _Float, _Char, _RNG)) = int.max_int. max_int_argument(generator(range(_, MaxInt), _F, _C, _R)) = MaxInt. altered_state(int_range(A), int_range(B), qstate(generator(B, F, C, RNG), Desc), qstate(generator(A, F, C, RNG), Desc)). altered_state(float_range(A), float_range(B), qstate(generator(I, B, C, RNG), Desc), qstate(generator(I, A, C, RNG), Desc)). altered_state(char_type(A), char_type(B), qstate(generator(I, F, B, RNG), Desc), qstate(generator(I, F, A, RNG), Desc)). % modified: March 8, 2007, DMA % changed: Using tausworthe3 RNG typeclass as proposed in the % Mercury maillists, discarding internal RNG typeclass. % modified: May 13, 2006, DMA % changed: Conformed this module to the new 'qcheck2' versioning. % modified: May 4, 2006, DMA % changed: Converted the Name input parameter into qcheck/8 from a % string to a generic type so that the user may use % whatever type is appropriate for classifying tests. % This means that the qstate type must be further % generalized. % % Added a surrounding type to the typeclassed random % number generator so that the user can dictate (and % change, dynamically) the ranges of the values generated. % modified: May 3, 2006, DMA % changed: Deleted the distribution type (which was an association % of a count to a value). Replaced the list(distribution) % functionality wholesale with bag(Value) typing. Added % a test_results type that simplifies the the management % of results during the process of actual unit testing. % modified: April 19, 2006, DMA % changed: Moved the RNG types to qcheck.generators. Added a % typeclass for a generic RNG that allows the ranges % to be controlled as part of the process of unit % testing. :- end_module qcheck2.types.