1%%% -*- coding: utf-8; erlang-indent-level: 2 -*- 2%%% ------------------------------------------------------------------- 3%%% Copyright 2010-2021 Manolis Papadakis <manopapad@gmail.com>, 4%%% Eirini Arvaniti <eirinibob@gmail.com>, 5%%% Kostis Sagonas <kostis@cs.ntua.gr>, 6%%% and Andreas Löscher <andreas.loscher@it.uu.se> 7%%% 8%%% This file is part of PropEr. 9%%% 10%%% PropEr is free software: you can redistribute it and/or modify 11%%% it under the terms of the GNU General Public License as published by 12%%% the Free Software Foundation, either version 3 of the License, or 13%%% (at your option) any later version. 14%%% 15%%% PropEr is distributed in the hope that it will be useful, 16%%% but WITHOUT ANY WARRANTY; without even the implied warranty of 17%%% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 18%%% GNU General Public License for more details. 19%%% 20%%% You should have received a copy of the GNU General Public License 21%%% along with PropEr. If not, see <http://www.gnu.org/licenses/>. 22 23%%% @copyright 2010-2021 Manolis Papadakis, Eirini Arvaniti, Kostis Sagonas and Andreas Löscher 24%%% @version {@version} 25%%% @author Manolis Papadakis 26 27%%% @doc This is the main PropEr module. 28%%% 29%%% == How to write properties == 30%%% The simplest properties that PropEr can test consist of a single boolean 31%%% expression (or a statement block that returns a boolean), which is expected 32%%% to evaluate to `true'. Thus, the test `true' always succeeds, while the test 33%%% `false' always fails (the failure of a property may also be signified by 34%%% throwing an exception, error or exit. More complex (and useful) properties 35%%% can be written by wrapping such a boolean expression with one or more of the 36%%% following wrappers: 37%%% 38%%% <dl> 39%%% <dt>`?FORALL(<Xs>, <Xs_type>, <Prop>)'</dt> 40%%% <dd>The `<Xs>' field can either be a single variable, a tuple of variables 41%%% or a list of variables. The `<Xs_type>' field must then be a single type, 42%%% a tuple of types of the same length as the tuple of variables or a list 43%%% of types of the same length as the list of variables, respectively. 44%%% Tuples and lists can be combined in any way, as long as `<Xs>' and 45%%% `<Xs_type>' are compatible. Both PropEr-provided types, as listed in the 46%%% {@link proper_types} module, and types declared in Erlang's built-in 47%%% typesystem (we will refer to such types in as <em>native types</em>) may 48%%% be used in the `<Xs_type>' field. The use of native types in `?FORALL's is 49%%% subject to some limitations, as described in the documentation for the 50%%% {@link proper_typeserver} module. All the variables inside `<Xs>' can 51%%% (and should) be present as free variables inside the wrapped property 52%%% `<Prop>'. When a `?FORALL' wrapper is encountered, a random instance of 53%%% `<Xs_type>' is produced and each variable in `<Xs>' is replaced inside 54%%% `<Prop>' by its corresponding instance.</dd> 55%%% <dt>`?FORALL_TARGETED(<Xs>, <Xs_type>, <Prop>)'</dt> 56%%% <dd>This is the targeted version of the `?FORALL' macro that uses the 57%%% targeted PBT component of PropEr.</dd> 58%%% <dt>`?IMPLIES(<Precondition>, <Prop>)'</dt> 59%%% <dd>This wrapper only makes sense when in the scope of at least one 60%%% `?FORALL'. The `<Precondition>' field must be a boolean expression or a 61%%% statement block that returns a boolean. If the precondition evaluates to 62%%% `false' for the variable instances produced in the enclosing `?FORALL' 63%%% wrappers, the test case is rejected (it doesn't count as a failing test 64%%% case), and PropEr starts over with a new random test case. Also, in 65%%% verbose mode, an `x' is printed on screen.</dd> 66%%% <dt>`?WHENFAIL(<Action>, <Prop>)'</dt> 67%%% <dd>The `<Action>' field should contain an expression or statement block 68%%% that produces some side-effect (e.g. prints something to the screen). 69%%% In case this test fails, `<Action>' will be executed. Note that the output 70%%% of such actions is not affected by the verbosity setting of the main 71%%% application.</dd> 72%%% <dt>`?EXISTS(<Xs>, <Xs_type>, <Prop>)'</dt> 73%%% <dd> The `?EXISTS' macro uses the targeted PBT component of PropEr to try 74%%% to find one instance of `<Xs>' that makes the `<Prop>' true. If such a `<Xs>' 75%%% is found the property passes. Note that there is no counterexample if no 76%%% such `<Xs>' could be found.</dd> 77%%% <dt>`?NOT_EXISTS(<Xs>, <Xs_type>, <Prop>)'</dt> 78%%% <dd> The `?NOT_EXISTS' macro is similar to the `?EXISTS' macro with the 79%%% difference that if an `<Xs>' is found that makes `<Prop>' true, the 80%%% property fails and this `<Xs>' is a counterexample to the property.</dd> 81%%% <dt>`?TRAPEXIT(<Prop>)'</dt> 82%%% <dd>If the code inside `<Prop>' spawns and links to a process that dies 83%%% abnormally, PropEr will catch the exit signal and treat it as a test 84%%% failure, instead of crashing. `?TRAPEXIT' cannot contain any more 85%%% wrappers.</dd> 86%%% <dt>`?TIMEOUT(<Time_limit>, <Prop>)'</dt> 87%%% <dd>Signifies that `<Prop>' should be considered failing if it takes more 88%%% than `<Time_limit>' milliseconds to return. The purpose of this wrapper is 89%%% to test code that may hang if something goes wrong. `?TIMEOUT' cannot 90%%% contain any more wrappers.</dd> 91%%% <dt>`?SETUP(<Setup_fun>, <Prop>)'</dt> 92%%% <dd>Adds a setup `<Setup_fun>'ction to the property which will be called 93%%% before the first test. This function has to return a finalize function of 94%%% arity 0, which should return the atom `ok', that will be called after 95%%% the last test. 96%%% It is possible to use multiple `?SETUP' macros on the same property.</dd> 97%%% <dt>`conjunction(<SubProps>)'</dt> 98%%% <dd>See the documentation for {@link conjunction/1}.</dd> 99%%% <dt>`equals(<A>, <B>)'</dt> 100%%% <dd>See the documentation for {@link equals/2}.</dd> 101%%% </dl> 102%%% 103%%% There are also multiple wrappers that can be used to collect statistics on 104%%% the distribution of test data: 105%%% 106%%% <ul> 107%%% <li>{@link collect/2}</li> 108%%% <li>{@link collect/3}</li> 109%%% <li>{@link aggregate/2}</li> 110%%% <li>{@link aggregate/3}</li> 111%%% <li>{@link classify/3}</li> 112%%% <li>{@link measure/3}</li> 113%%% </ul> 114%%% 115%%% <span id="external-wrappers"></span> 116%%% A property may also be wrapped with one or more of the following outer-level 117%%% wrappers, which control the behaviour of the testing subsystem. If an 118%%% outer-level wrapper appears more than once in a property, the innermost 119%%% instance takes precedence. 120%%% 121%%% <ul> 122%%% <li>{@link numtests/2}</li> 123%%% <li>{@link fails/2}</li> 124%%% <li>{@link on_output/2}</li> 125%%% </ul> 126%%% 127%%% For some actual usage examples, see the code in the examples directory, or 128%%% check out PropEr's site. The testing modules in the tests directory may also 129%%% be of interest. 130%%% 131%%% == Program behaviour == 132%%% When running in verbose mode (this is the default), each sucessful test 133%%% prints a '.' on screen. If a test fails, a '!' is printed, along with the 134%%% failing test case (the instances of the types in every `?FORALL') and the 135%%% cause of the failure, if it was not simply the falsification of the 136%%% property. 137%%% Then, unless the test was expected to fail, PropEr attempts to produce a 138%%% minimal test case that fails the property in the same way. This process is 139%%% called <em>shrinking</em>. During shrinking, a '.' is printed for each 140%%% successful simplification of the failing test case. When PropEr reaches its 141%%% shrinking limit or realizes that the instance cannot be shrunk further while 142%%% still failing the test, it prints the minimal failing test case and failure 143%%% reason and exits. 144%%% 145%%% The return value of PropEr can be one of the following: 146%%% 147%%% <ul> 148%%% <li>`true': The property held for all valid produced inputs.</li> 149%%% <li>`false': The property failed for some input.</li> 150%%% <li>`{error, <Type_of_error>}': An error occured; see the {@section Errors} 151%%% section for more information.</li> 152%%% </ul> 153%%% 154%%% To test all properties exported from a module (a property is a 0-arity 155%%% function whose name begins with `prop_'), you can use {@link module/1} or 156%%% {@link module/2}. This returns a list of all failing properties, represented 157%%% by MFAs. Testing progress is also printed on screen (unless quiet mode is 158%%% active). The provided options are passed on to each property, except for 159%%% `long_result', which controls the return value format of the `module' 160%%% function itself. 161%%% 162%%% == Counterexamples == 163%%% A counterexample for a property is represented as a list of terms; each such 164%%% term corresponds to the type in a `?FORALL'. The instances are provided in 165%%% the same order as the `?FORALL' wrappers in the property, i.e. the instance 166%%% at the head of the list corresponds to the outermost `?FORALL' etc. 167%%% Instances generated inside a failing sub-property of a conjunction are 168%%% marked with the sub-property's tag. 169%%% 170%%% The last (simplest) counterexample produced by PropEr during a (failing) run 171%%% can be retrieved after testing has finished, by running 172%%% {@link counterexample/0}. When testing a whole module, run 173%%% {@link counterexamples/0} to get a counterexample for each failing property, 174%%% as a list of `{mfa(), '{@type counterexample()}`}' tuples. To enable this 175%%% functionality, some information has to remain in the process dictionary 176%%% even after PropEr has returned. If, for some reason, you want to completely 177%%% clean up the process dictionary of PropEr-produced entries, run 178%%% {@link clean_garbage/0}. 179%%% 180%%% Counterexamples can also be retrieved by running PropEr in long-result mode, 181%%% where counterexamples are returned as part of the return value. 182%%% Specifically, when testing a single property under long-result mode 183%%% (activated by supplying the option `long_result', or by calling 184%%% {@link counterexample/1} or {@link counterexample/2} instead of 185%%% {@link quickcheck/1} and {@link quickcheck/2} respectively), PropEr will 186%%% return a counterexample in case of failure (instead of simply returning 187%%% `false'). When testing a whole module under long-result mode (activated by 188%%% supplying the option `long_result' to {@link module/2}), PropEr will return 189%%% a list of `{mfa(), '{@type counterexample()}`}' tuples, one for each failing 190%%% property. 191%%% 192%%% You can re-check a specific counterexample against the property that it 193%%% previously falsified by running {@link check/2} or {@link check/3}. This 194%%% will return one of the following (both in short- and long-result mode): 195%%% 196%%% <ul> 197%%% <li>`true': The property now holds for this test case.</li> 198%%% <li>`false': The test case still fails (although not necessarily for the 199%%% same reason as before).</li> 200%%% <li>`{error, <Type_of_error>}': An error occured - see the {@section Errors} 201%%% section for more information.</li> 202%%% </ul> 203%%% 204%%% Proper will not attempt to shrink the input in case it still fails the 205%%% property. Unless silent mode is active, PropEr will also print a message on 206%%% screen, describing the result of the re-checking. Note that PropEr can do 207%%% very little to verify that the counterexample actually corresponds to the 208%%% property that it is tested against. 209%%% 210%%% == Options == 211%%% Options can be provided as an extra argument to most testing functions (such 212%%% as {@link quickcheck/1}). A single option can be written stand-alone, or 213%%% multiple options can be provided in a list. When two settings conflict, the 214%%% one that comes first in the list takes precedence. Settings given inside 215%%% external wrappers to a property (see the {@section How to write properties} 216%%% section) override any conflicting settings provided as options. 217%%% 218%%% The available options are: 219%%% 220%%% <dl> 221%%% <dt>`quiet'</dt> 222%%% <dd>Enables quiet mode - no output is printed on screen while PropEr is 223%%% running.</dd> 224%%% <dt>`verbose'</dt> 225%%% <dd>Enables verbose mode - this is the default mode of operation.</dd> 226%%% <dt>`{to_file, <IO_device>}'</dt> 227%%% <dd>Redirects all of PropEr's output to `<IO_device>', which should be an 228%%% IO device associated with a file opened for writing.</dd> 229%%% <dt>`{on_output, <Output_function>}'</dt> 230%%% <dd>This option disables colored output (i.e,, it implies 'nocolors'), and 231%%% makes PropEr use the supplied function for all output printing. This 232%%% function should accept two arguments in the style of `io:format/2' 233%%% (i.e., a string and a list of arguments) which are supplied to the 234%%% function by PropEr.<br/> 235%%% CAUTION: The above output control options are incompatible with each 236%%% other.</dd> 237%%% <dt>`long_result'</dt> 238%%% <dd>Enables long-result mode (see the {@section Counterexamples} section 239%%% for details).</dd> 240%%% <dt>`{numtests, <Positive_integer>}' or simply `<Positive_integer>'</dt> 241%%% <dd>This is equivalent to the {@link numtests/1} property wrapper. Any 242%%% {@link numtests/1} wrappers in the actual property will overwrite this 243%%% user option.</dd> 244%%% <dt>`{start_size, <Size>}'</dt> 245%%% <dd>Specifies the initial value of the `size' parameter (default is 1), see 246%%% the documentation of the {@link proper_types} module for details.</dd> 247%%% <dt>`{max_size, <Size>}'</dt> 248%%% <dd>Specifies the maximum value of the `size' parameter (default is 42), see 249%%% the documentation of the {@link proper_types} module for details.</dd> 250%%% <dt>`{max_shrinks, <Non_negative_integer>}'</dt> 251%%% <dd>Specifies the maximum number of times a failing test case should be 252%%% shrunk before returning. Note that the shrinking may stop before so many 253%%% shrinks are achieved if the shrinking subsystem deduces that it cannot 254%%% shrink the failing test case further. Default is 500.</dd> 255%%% <dt>`noshrink'</dt> 256%%% <dd>Instructs PropEr to not attempt to shrink any failing test cases.</dd> 257%%% <dt>`{constraint_tries, <Positive_integer>}'</dt> 258%%% <dd>Specifies the maximum number of tries before the generator subsystem 259%%% gives up on producing an instance that satisfies a `?SUCHTHAT' 260%%% constraint. Default is 50.</dd> 261%%% <dt>`fails'</dt> 262%%% <dd>This is equivalent to the {@link fails/1} property wrapper.</dd> 263%%% <dt>`{spec_timeout, infinity | <Non_negative_integer>}'</dt> 264%%% <dd>When testing a spec, PropEr will consider an input to be failing if the 265%%% function under test takes more than the specified amount of milliseconds 266%%% to return for that input.</dd> 267%%% <dt>`any_to_integer'</dt> 268%%% <dd>All generated instances of the type {@link proper_types:any/0} will be 269%%% integers. This is provided as a means to speed up the testing of specs, 270%%% where `any()' is a commonly used type (see the {@section Spec testing} 271%%% section for details).</dd> 272%%% <dt>`{skip_mfas, [<MFA>]}'</dt> 273%%% <dd> When checking a module's specs, PropEr will not test the 274%%% specified MFAs. Default is [].</dd> 275%%% <dt>`{false_positive_mfas, fun((mfa(),[Arg::term()],{fail, Result::term()} | {error | exit | throw, Reason::term()}) -> boolean()) | undefined}'</dt> 276%%% <dd> When checking a module's spec(s), PropEr will treat a 277%%% counterexample as a false positive if the user supplied function 278%%% returns true. Otherwise, PropEr will treat the counterexample as 279%%% it normally does. The inputs to the user supplied function are 280%%% the MFA, the arguments passed to the MFA, and the result returned 281%%% from the MFA or an exception with it's reason. If needed, the 282%%% user supplied function can call erlang:get_stacktrace/0. Default 283%%% is undefined.</dd> 284%%% <dt>`nocolors'</dt> 285%%% <dd>Do not use term colors in output.</dd> 286%%% <dt>`{numworkers, <Non_negative_number>}'</dt> 287%%% <dd> Specifies the number of workers to spawn when performing the tests (defaults to 0). 288%%% Each worker gets their own share of the total of number of tests to perform.</dd> 289%%% <dt>`{strategy_fun, <Strategy_function>}'</dt> 290%%% <dd> Overrides the default function used to split the load of tests among the workers. 291%%% It should be of the type {@link strategy_fun()}.</dd> 292%%% <dt>`pure | impure'</dt> 293%%% <dd> Declares the type of the property, as in pure with no side-effects or state, 294%%% and impure with them. <b>Notice</b>: this option will only be taken into account if 295%%% the number of workers set is greater than 0. In addition, <i>impure</i> properties 296%%% have each worker spawned on its own node.</dd> 297%%% <dt>`{stop_nodes, boolean()}'</dt> 298%%% <dd> Specifies whether parallel PropEr should stop the nodes after running a property 299%%% or not. Defaults to true.</dd> 300%%% </dl> 301%%% 302%%% == Spec testing == 303%%% You can test the accuracy of an exported function's spec by running 304%%% {@link check_spec/1} or {@link check_spec/2}. 305%%% Under this mode of operation, PropEr will call the provided function with 306%%% increasingly complex valid inputs (according to its spec) and test that no 307%%% unexpected value is returned. If an input is found that violates the spec, 308%%% it will be saved as a counterexample and PropEr will attempt to shrink it. 309%%% 310%%% You can test all exported functions of a module against their spec by 311%%% running {@link check_specs/1} or {@link check_specs/2}. 312%%% 313%%% The use of `check_spec' is subject to the following usage rules: 314%%% 315%%% <ul> 316%%% <li>Currently, PropEr can't test functions whose range contains a type 317%%% that exhibits a certain kind of self-reference: it is (directly or 318%%% indirectly) self-recursive and at least one recursion path contains only 319%%% unions and type references. E.g. these types are acceptable: 320%%% ``` -type a(T) :: T | {'bar',a(T)}. 321%%% -type b() :: 42 | [c()]. 322%%% -type c() :: {'baz',b()}.''' 323%%% while these are not: 324%%% ``` -type a() :: 'foo' | b(). 325%%% -type b() :: c() | [integer()]. 326%%% -type c() :: 'bar' | a(). 327%%% -type d(T) :: T | d({'baz',T}).''' </li> 328%%% <li>Throwing any exception or raising an `error:badarg' is considered 329%%% normal behaviour. Currently, users cannot fine-tune this setting.</li> 330%%% <li>Only the first clause of the function's spec is considered.</li> 331%%% <li>The only spec constraints we accept are is_subtype' constraints whose 332%%% first argument is a simple, non-'_' variable. It is not checked whether or 333%%% not these variables actually appear in the spec. The second argument of an 334%%% `is_subtype' constraint cannot contain any non-'_' variables. Multiple 335%%% constraints for the same variable are not supported.</li> 336%%% </ul> 337%%% 338%%% == Errors == 339%%% The following errors may be encountered during testing. The term provided 340%%% for each error is the error type returned by proper:quickcheck in case such 341%%% an error occurs. Normaly, a message is also printed on screen describing 342%%% the error. 343%%% 344%%% <dl> 345%%% <dt>`arity_limit'</dt> 346%%% <dd>The random instance generation subsystem has failed to produce 347%%% a function of the desired arity. Please recompile PropEr with a suitable 348%%% value for `?MAX_ARITY' (defined in `proper_internal.hrl'). This error 349%%% should only be encountered during normal operation.</dd> 350%%% <dt>`{cant_generate, [<MFA>]}'</dt> 351%%% <dd>The random instance generation subsystem has failed to 352%%% produce an instance that satisfies some `?SUCHTHAT' constraint. You 353%%% should either increase the `constraint_tries' limit, loosen the failing 354%%% constraint, or make it non-strict. The failure is due to a failing 355%%% strict constraint which is wrapped by one of the MFAs from the list of 356%%% candidates `[<MFA>]'. 357%%% This error should only be encountered during normal operation.</dd> 358%%% <dt>`cant_satisfy'</dt> 359%%% <dd>All the tests were rejected because no produced test case 360%%% would pass all `?IMPLIES' checks. You should loosen the failing `?IMPLIES' 361%%% constraint(s). This error should only be encountered during normal 362%%% operation.</dd> 363%%% <dt>`non_boolean_result'</dt> 364%%% <dd>The property code returned a non-boolean result. Please 365%%% fix your property.</dd> 366%%% <dt>`rejected'</dt> 367%%% <dd>Only encountered during re-checking, the counterexample does not 368%%% match the property, since the counterexample doesn't pass an `?IMPLIES' 369%%% check.</dd> 370%%% <dt>`too_many_instances'</dt> 371%%% <dd>Only encountered during re-checking, the counterexample 372%%% does not match the property, since the counterexample contains more 373%%% instances than there are `?FORALL's in the property.</dd> 374%%% <dt>`type_mismatch'</dt> 375%%% <dd>The variables' and types' structures inside a `?FORALL' don't 376%%% match. Please check your properties.</dd> 377%%% <dt>`{typeserver, <SubError>}'</dt> 378%%% <dd>The typeserver encountered an error. The `<SubError>' field contains 379%%% specific information regarding the error.</dd> 380%%% <dt>`{unexpected, <Result>}'</dt> 381%%% <dd>A test returned an unexpected result during normal operation. If you 382%%% ever get this error, it means that you have found a bug in PropEr 383%%% - please send an error report to the maintainers and remember to include 384%%% both the failing test case and the output of the program, if possible. 385%%% </dd> 386%%% <dt>`{erroneous_option, <Option>}'</dt> 387%%% <dd>There is something wrong in how `<Option>' is specified by the user; 388%%% most likely a value was supplied for it that is not what is expected.</dd> 389%%% <dt>`{unrecognized_option, <Option>}'</dt> 390%%% <dd>`<Option>' is not an option that PropEr understands.</dd> 391%%% </dl> 392 393-module(proper). 394 395-export([quickcheck/1, quickcheck/2, counterexample/1, counterexample/2, 396 check/2, check/3, module/1, module/2, check_spec/1, check_spec/2, 397 check_specs/1, check_specs/2]). 398-export([numtests/2, fails/1, on_output/2, conjunction/1]). 399-export([collect/2, collect/3, aggregate/2, aggregate/3, classify/3, measure/3, 400 with_title/1, equals/2]). 401-export([counterexample/0, counterexamples/0]). 402-export([clean_garbage/0, global_state_erase/0]). 403-export([test_to_outer_test/1]). 404 405-export([gen_and_print_samples/3]). 406-export([get_size/1, global_state_init_size/1, 407 global_state_init_size_seed/2, report_error/2]). 408-export([pure_check/1, pure_check/2]). 409-export([forall/2, targeted/2, exists/3, implies/2, 410 whenfail/2, trapexit/1, timeout/2, setup/2]). 411 412-export_type([test/0, outer_test/0, counterexample/0, exception/0, 413 false_positive_mfas/0, setup_opts/0]). 414 415-include("proper_internal.hrl"). 416 417%%----------------------------------------------------------------------------- 418%% Macros 419%%----------------------------------------------------------------------------- 420 421-define(MISMATCH_MSG, "Error: The input doesn't correspond to this property: "). 422 423%%----------------------------------------------------------------------------- 424%% Color printing macros 425%%----------------------------------------------------------------------------- 426 427-define(BOLD_RED, "\033[01;31m"). 428-define(BOLD_GREEN, "\033[01;32m"). 429-define(BOLD_YELLOW, "\033[01;33m"). % currently not used 430-define(BOLD_BLUE, "\033[01;34m"). 431-define(BOLD_MAGENTA, "\033[01;35m"). % currently not used 432-define(END_MARKER, "\033[00m"). 433 434-define(COLOR_WRAP(NoCol, StartMarker, Msg), 435 case NoCol of 436 true -> Msg; 437 false -> StartMarker ++ Msg ++ ?END_MARKER 438 end). 439-define(PRINT(NoCol, StartMarker, Print, Msg, Args), 440 Print(?COLOR_WRAP(NoCol, StartMarker, Msg), Args)). 441 442 443%%----------------------------------------------------------------------------- 444%% Test types 445%%----------------------------------------------------------------------------- 446 447-type imm_testcase() :: [imm_input()]. 448-type imm_input() :: proper_gen:imm_instance() 449 | {'$conjunction',sub_imm_testcases()}. 450-type sub_imm_testcases() :: [{tag(),imm_testcase()}]. 451-type imm_counterexample() :: [imm_clean_input()]. 452-type imm_clean_input() :: proper_gen:instance() 453 | {'$conjunction',sub_imm_counterexamples()}. 454-type sub_imm_counterexamples() :: [{tag(),imm_counterexample()}]. 455-type counterexample() :: [clean_input()]. 456%% @alias 457-type clean_input() :: proper_gen:instance() | sub_counterexamples(). 458%% @alias 459-type sub_counterexamples() :: [{tag(),counterexample()}]. 460 461-type sample() :: [term()]. 462-type freq_sample() :: [{term(),proper_types:frequency()}]. 463-type side_effects_fun() :: fun(() -> 'ok'). 464-type fail_actions() :: [side_effects_fun()]. 465-type output_fun() :: fun((string(),[term()]) -> 'ok'). 466%% A fun to be used by PropEr for output printing. Such a fun should follow the 467%% conventions of `io:format/2'. 468-type tag() :: atom(). 469-type title() :: atom() | string(). 470-type stats_printer() :: fun((sample()) -> 'ok') 471 | fun((sample(),output_fun()) -> 'ok'). 472%% A stats-printing function that can be passed to some of the statistics 473%% collection functions, to be used instead of the predefined stats-printer. 474%% Such a function will be called at the end of testing (in case no test fails) 475%% with a sorted list of collected terms. A commonly used stats-printer is 476%% `with_title/1'. 477-type numeric_stats() :: {number(), float(), number()}. 478-type time_period() :: non_neg_integer(). 479 480-opaque outer_test() :: test() 481 | {'fails', outer_test()} 482 | {'setup', setup_fun(), outer_test()} 483 | {'numtests', pos_integer(), outer_test()} 484 | {'on_output', output_fun(), outer_test()}. 485%% A testable property that has optionally been wrapped with one or 486%% more <a href="#external-wrappers">external wrappers</a>. 487 488%% TODO: Should the tags be of the form '$...'? 489-opaque test() :: boolean() 490 | {'forall', proper_types:raw_type(), dependent_test()} 491 | {'exists', proper_types:raw_type(), dependent_test(), boolean()} 492 | {'conjunction', [{tag(),test()}]} 493 | {'implies', boolean(), delayed_test()} 494 | {'sample', sample(), stats_printer(), test()} 495 | {'whenfail', side_effects_fun(), delayed_test()} 496 | {'trapexit', fun(() -> boolean())} 497 | {'timeout', time_period(), fun(() -> boolean())}. 498 %%| {'always', pos_integer(), delayed_test()} 499 %%| {'sometimes', pos_integer(), delayed_test()} 500%% A testable property that has not been wrapped with an 501%% <a href="#external-wrappers">external wrapper</a>. 502 503-type delayed_test() :: fun(() -> test()). 504-type dependent_test() :: fun((proper_gen:instance()) -> test()). 505-type lazy_test() :: delayed_test() | dependent_test(). 506-type raw_test_kind() :: 'test' | 'spec'. 507-type raw_test() :: {'test',test()} | {'spec',mfa()}. 508-type stripped_test() :: boolean() 509 | {proper_types:type(), dependent_test()} 510 | [{tag(),test()}]. 511-type finalize_fun() :: fun (() -> 'ok'). 512-type setup_fun() :: fun(() -> finalize_fun()) | fun ((setup_opts()) -> finalize_fun()). 513 514-type false_positive_mfas() :: fun((mfa(),Args::[term()],{fail,Result::term()} | {error | exit | throw,Reason::term()}) -> boolean()) | 'undefined'. 515 516-type purity() :: 'pure' | 'impure'. 517 518-type test_range() :: {Start :: non_neg_integer(), ToPass :: pos_integer()}. 519-type worker_args() :: test_range() | {node(), test_range()}. 520 521%% Strategy function type 522-type strategy_fun() :: fun((NumTests :: pos_integer(), NumWorkers :: pos_integer()) -> [{non_neg_integer(), non_neg_integer()}]). 523%% A function that given a number of tests and a number of workers, splits 524%% the load in the form of a list of tuples with the first element as the 525%% starting test and the second element as the number of tests to do from there on. 526 527%%----------------------------------------------------------------------------- 528%% Options and Context types 529%%----------------------------------------------------------------------------- 530 531%% TODO: Rename this to 'options()'? 532-type user_opt() :: 'any_to_integer' 533 | 'fails' 534 | 'long_result' 535 | 'nocolors' 536 | 'noshrink' 537 | purity() 538 | 'quiet' 539 | 'verbose' 540 | pos_integer() 541 | {'constraint_tries',pos_integer()} 542 | {'false_positive_mfas',false_positive_mfas()} 543 | {'max_shrinks',non_neg_integer()} 544 | {'max_size',proper_gen:size()} 545 | {'numtests',pos_integer()} 546 | {'numworkers', non_neg_integer()} 547 | {'strategy_fun', strategy_fun()} 548 | {'stop_nodes', boolean()} 549 | {'on_output',output_fun()} 550 | {'search_steps',pos_integer()} 551 | {'search_strategy',proper_target:strategy()} 552 | {'skip_mfas',[mfa()]} 553 | {'spec_timeout',timeout()} 554 | {'start_size',proper_gen:size()} 555 | {'to_file',io:device()}. 556 557-type user_opts() :: [user_opt()] | user_opt(). 558-record(opts, {output_fun = fun io:format/2 :: output_fun(), 559 long_result = false :: boolean(), 560 numtests = 100 :: pos_integer(), 561 search_steps = 1000 :: pos_integer(), 562 search_strategy = proper_sa :: proper_target:strategy(), 563 start_size = 1 :: proper_gen:size(), 564 seed = os:timestamp() :: proper_gen:seed(), 565 max_size = 42 :: proper_gen:size(), 566 max_shrinks = 500 :: non_neg_integer(), 567 noshrink = false :: boolean(), 568 constraint_tries = 50 :: pos_integer(), 569 expect_fail = false :: boolean(), 570 any_type :: {'type', proper_types:type()} | 'undefined', 571 spec_timeout = infinity :: timeout(), 572 skip_mfas = [] :: [mfa()], 573 false_positive_mfas :: false_positive_mfas(), 574 setup_funs = [] :: [setup_fun()], 575 numworkers = 0 :: non_neg_integer(), 576 property_type = pure :: purity(), 577 strategy_fun = default_strategy_fun() :: strategy_fun(), 578 stop_nodes = true :: boolean(), 579 parent = self() :: pid(), 580 nocolors = false :: boolean()}). 581-type opts() :: #opts{}. 582-record(ctx, {mode = new :: 'new' | 'try_shrunk' | 'try_cexm', 583 bound = [] :: imm_testcase() | counterexample(), 584 actions = [] :: fail_actions(), 585 samples = [] :: [sample()], 586 printers = [] :: [stats_printer()]}). 587-type ctx() :: #ctx{}. 588 589-type setup_opts() :: #{numtests := pos_integer(), 590 search_steps := pos_integer(), 591 search_strategy := proper_target:strategy(), 592 start_size := proper_gen:size(), 593 max_size := proper_gen:size(), 594 output_fun := output_fun()}. 595 596%%----------------------------------------------------------------------------- 597%% Result types 598%%----------------------------------------------------------------------------- 599 600-record(pass, {reason :: pass_reason() | 'undefined', 601 samples :: [sample()], 602 printers :: [stats_printer()], 603 performed :: pos_integer() | 'undefined', 604 actions :: fail_actions()}). 605-record(fail, {reason :: fail_reason() | 'undefined', 606 bound :: imm_testcase() | counterexample(), 607 actions :: fail_actions(), 608 performed :: pos_integer() | 'undefined'}). 609%% @alias 610-type error() :: {'error', error_reason()}. 611 612-type pass_reason() :: 'true_prop' | 'didnt_crash'. 613-type fail_reason() :: 'false_prop' | 'time_out' | {'trapped',exc_reason()} 614 | exception() | {'sub_props',[{tag(),fail_reason()},...]} 615 | 'exists' | 'not_found'. 616%% @private_type 617-type exception() :: {'exception',exc_kind(),exc_reason(),stacktrace()}. 618-type exc_kind() :: 'throw' | 'error' | 'exit'. 619-type exc_reason() :: term(). 620-type stacktrace() :: [call_record()]. 621-type call_record() :: {mod_name(),fun_name(),arity() | list(),location()}. 622-type location() :: [{atom(),term()}]. 623-type error_reason() :: 'arity_limit' | {'cant_generate',[mfa()]} 624 | 'cant_satisfy' 625 | 'non_boolean_result' | 'rejected' | 'too_many_instances' 626 | 'type_mismatch' | 'wrong_type' | {'typeserver',term()} 627 | {'unexpected',any()} | {'erroneous_option',user_opt()} 628 | {'unrecognized_option',term()}. 629 630-type run_result() :: #pass{performed :: 'undefined'} 631 | #fail{performed :: 'undefined'} 632 | error(). 633-type imm_result() :: #pass{reason :: 'undefined'} | #fail{} | error(). 634-type long_result() :: 'true' | counterexample() | error(). 635-type short_result() :: boolean() | error(). 636-type result() :: long_result() | short_result(). 637-type long_module_result() :: [{mfa(),counterexample()}] | error(). 638-type short_module_result() :: [mfa()] | error(). 639-type module_result() :: long_module_result() | short_module_result(). 640-type shrinking_result() :: {non_neg_integer(),imm_testcase()}. 641 642%%----------------------------------------------------------------------------- 643%% State handling functions 644%%----------------------------------------------------------------------------- 645 646-spec grow_size(opts()) -> 'ok'. 647grow_size(#opts{max_size = MaxSize} = Opts) -> 648 Size = get('$size'), 649 case Size < MaxSize of 650 true -> 651 case get('$left') of 652 0 -> 653 {ToRun, NextSize} = tests_at_next_size(Size, Opts), 654 put('$size', NextSize), 655 put('$left', ToRun - 1), 656 ok; 657 Left -> 658 put('$left', Left - 1), 659 ok 660 end; 661 false -> 662 ok 663 end. 664 665-spec tests_at_next_size(proper_gen:size(), opts()) -> 666 {pos_integer(), proper_gen:size()}. 667tests_at_next_size(_Size, #opts{numtests = 1, start_size = StartSize}) -> 668 {1, StartSize}; 669tests_at_next_size(Size, #opts{numtests = NumTests, start_size = StartSize, 670 max_size = MaxSize}) 671 when Size < MaxSize, StartSize =< MaxSize, NumTests > 1 -> 672 SizesToTest = MaxSize - StartSize + 1, 673 case NumTests >= SizesToTest of 674 true -> 675 TotalOverflow = NumTests rem SizesToTest, 676 NextSize = erlang:max(StartSize, Size + 1), 677 Overflow = case NextSize - StartSize < TotalOverflow of 678 true -> 1; 679 false -> 0 680 end, 681 {NumTests div SizesToTest + Overflow, NextSize}; 682 false -> 683 EverySoManySizes = (SizesToTest - 1) div (NumTests - 1), 684 NextSize = 685 case Size < StartSize of 686 true -> 687 StartSize; 688 false -> 689 PrevMultiple = 690 Size - (Size - StartSize) rem EverySoManySizes, 691 PrevMultiple + EverySoManySizes 692 end, 693 {1, NextSize} 694 end. 695 696-spec size_at_nth_test(non_neg_integer(), opts()) -> proper_gen:size(). 697size_at_nth_test(NumTest, #opts{max_size = MaxSize, start_size = StartSize, 698 numtests = NumTests}) -> 699 SizesToTest = MaxSize - StartSize + 1, 700 Size = case NumTests >= SizesToTest of 701 true -> 702 Div = NumTests div SizesToTest, 703 Rem = NumTests rem SizesToTest, 704 case NumTest < Rem * (Div + 1) of 705 true -> 706 NumTest div (Div + 1) + StartSize; 707 false -> 708 (NumTest div 2) - (Rem div Div) + StartSize 709 end; 710 false -> 711 case NumTest =:= 0 of 712 true -> StartSize; 713 false -> 714 Diff = (SizesToTest - 1) div (NumTests - 1), 715 NumTest * Diff + StartSize 716 end 717 end, 718 min(MaxSize, Size). 719 720%% @private 721-spec get_size(proper_types:type()) -> proper_gen:size() | 'undefined'. 722get_size(Type) -> 723 case get('$size') of 724 undefined -> 725 undefined; 726 Size -> 727 case proper_types:find_prop(size_transform, Type) of 728 {ok,Transform} -> Transform(Size); 729 error -> Size 730 end 731 end. 732 733%% @private 734-spec global_state_init_size(proper_gen:size()) -> 'ok'. 735global_state_init_size(Size) -> 736 global_state_init(#opts{start_size = Size}). 737 738%% @private 739-spec global_state_init_size_seed(proper_gen:size(), proper_gen:seed()) -> 'ok'. 740global_state_init_size_seed(Size, Seed) -> 741 global_state_init(#opts{start_size = Size, seed = Seed}). 742 743-spec global_state_init(opts()) -> 'ok'. 744global_state_init(#opts{start_size = StartSize, constraint_tries = CTries, 745 search_strategy = Strategy, search_steps = SearchSteps, 746 any_type = AnyType, seed = Seed, numworkers = NumWorkers} = Opts) -> 747 clean_garbage(), 748 put('$size', StartSize - 1), 749 put('$left', 0), 750 put('$search_strategy', Strategy), 751 put('$search_steps', SearchSteps), 752 grow_size(Opts), 753 put('$constraint_tries', CTries), 754 put('$any_type', AnyType), 755 put('$property_id', erlang:unique_integer()), 756 put('$proper_test_incr', NumWorkers), 757 {_, _, _} = Seed, % just an assertion 758 proper_arith:rand_restart(Seed), 759 proper_typeserver:restart(), 760 ok. 761 762-spec global_state_reset(opts()) -> 'ok'. 763global_state_reset(#opts{start_size = StartSize} = Opts) -> 764 clean_garbage(), 765 put('$size', StartSize - 1), 766 put('$left', 0), 767 grow_size(Opts). 768 769%% @private 770-spec global_state_erase() -> 'ok'. 771global_state_erase() -> 772 proper_typeserver:stop(), 773 proper_arith:rand_stop(), 774 erase('$any_type'), 775 erase('$constraint_tries'), 776 erase('$left'), 777 erase('$size'), 778 erase('$parameters'), 779 erase('$search_strategy'), 780 erase('$search_steps'), 781 erase('$property_id'), 782 erase('$proper_test_incr'), 783 ok. 784 785-spec setup_test(opts()) -> [finalize_fun()]. 786setup_test(#opts{output_fun = OutputFun, 787 numtests = NumTests, 788 search_steps = SearchSteps, 789 search_strategy = Strategy, 790 start_size = StartSize, 791 max_size = MaxSize, 792 setup_funs = Funs}) -> 793 SetupOpts = #{numtests => NumTests, 794 search_steps => SearchSteps, 795 search_strategy => Strategy, 796 start_size => StartSize, 797 max_size => MaxSize, 798 output_fun => OutputFun}, 799 [case erlang:fun_info(Fun, arity) of 800 {arity, 0} -> Fun(); 801 {arity, 1} -> Fun(SetupOpts) 802 end || Fun <- Funs]. 803 804-spec finalize_test([finalize_fun()]) -> 'ok'. 805finalize_test(Finalizers) -> 806 lists:foreach(fun (Fun) -> ok = Fun() end, Finalizers). 807 808%% @private 809-spec spawn_link_migrate(node(), fun(() -> 'ok')) -> pid(). 810spawn_link_migrate(Node, ActualFun) -> 811 PDictStuff = get(), 812 Fun = fun() -> 813 lists:foreach(fun({K,V}) -> put(K,V) end, PDictStuff), 814 proper_arith:rand_reseed(), 815 ok = ActualFun() 816 end, 817 case Node of 818 undefined -> 819 spawn_link(Fun); 820 Node -> 821 spawn_link(Node, Fun) 822 end. 823 824-spec save_counterexample(counterexample()) -> 'ok'. 825save_counterexample(CExm) -> 826 put('$counterexample', CExm), 827 ok. 828 829%% @doc Retrieves the last (simplest) counterexample produced by PropEr during 830%% the most recent testing run. 831-spec counterexample() -> counterexample() | 'undefined'. 832counterexample() -> 833 get('$counterexample'). 834 835-spec save_counterexamples([{mfa(),counterexample()}]) -> 'ok'. 836save_counterexamples(CExms) -> 837 put('$counterexamples', CExms), 838 ok. 839 840%% @doc Returns a counterexample for each failing property of the most recent 841%% module testing run. 842-spec counterexamples() -> [{mfa(),counterexample()}] | 'undefined'. 843counterexamples() -> 844 get('$counterexamples'). 845 846%% @doc Cleans up the process dictionary of all PropEr-produced entries. 847-spec clean_garbage() -> 'ok'. 848clean_garbage() -> 849 erase('$counterexample'), 850 erase('$counterexamples'), 851 ok. 852 853 854%%----------------------------------------------------------------------------- 855%% Public interface functions 856%%----------------------------------------------------------------------------- 857 858%% @doc Runs PropEr on the property `OuterTest'. 859-spec quickcheck(outer_test()) -> result(). 860quickcheck(OuterTest) -> 861 quickcheck(OuterTest, []). 862 863%% @doc Same as {@link quickcheck/1}, but also accepts a list of options. 864-spec quickcheck(outer_test(), user_opts()) -> result(). 865quickcheck(OuterTest, UserOpts) -> 866 try parse_opts(UserOpts) of 867 ImmOpts -> 868 {Test,Opts} = peel_test(OuterTest, ImmOpts), 869 test({test,Test}, Opts) 870 catch 871 throw:{Err,_Opt} = Reason when Err =:= erroneous_option; 872 Err =:= unrecognized_option -> 873 report_error(Reason, fun io:format/2), 874 {error, Reason} 875 end. 876 877%% @equiv quickcheck(OuterTest, [long_result]) 878-spec counterexample(outer_test()) -> long_result(). 879counterexample(OuterTest) -> 880 counterexample(OuterTest, []). 881 882%% @doc Same as {@link counterexample/1}, but also accepts a list of options. 883-spec counterexample(outer_test(), user_opts()) -> long_result(). 884counterexample(OuterTest, UserOpts) -> 885 quickcheck(OuterTest, add_user_opt(long_result, UserOpts)). 886 887%% @private 888%% @doc Runs PropEr in pure mode. Under this mode, PropEr will perform no I/O 889%% and will not access the caller's process dictionary in any way. Please note 890%% that PropEr will not actually run as a pure function under this mode. 891-spec pure_check(outer_test()) -> result(). 892pure_check(OuterTest) -> 893 pure_check(OuterTest, []). 894 895%% @private 896%% @doc Same as {@link pure_check/2}, but also accepts a list of options. 897-spec pure_check(outer_test(), user_opts()) -> result(). 898pure_check(OuterTest, ImmUserOpts) -> 899 Parent = self(), 900 UserOpts = add_user_opt(quiet, ImmUserOpts), 901 spawn_link(fun() -> Parent ! {result, quickcheck(OuterTest, UserOpts)} end), 902 receive 903 {result, Result} -> Result 904 end. 905 906%% @doc Tests the accuracy of an exported function's spec. 907-spec check_spec(mfa()) -> result(). 908check_spec(MFA) -> 909 check_spec(MFA, []). 910 911%% @doc Same as {@link check_spec/1}, but also accepts a list of options. 912-spec check_spec(mfa(), user_opts()) -> result(). 913check_spec(MFA, UserOpts) -> 914 try parse_opts(UserOpts) of 915 Opts -> 916 test({spec,MFA}, Opts) 917 catch 918 throw:{Err,_Opt} = Reason when Err =:= erroneous_option; 919 Err =:= unrecognized_option -> 920 report_error(Reason, fun io:format/2), 921 {error, Reason} 922 end. 923 924%% @doc Re-checks a specific counterexample `CExm' against the property 925%% `OuterTest' that it previously falsified. 926-spec check(outer_test(), counterexample()) -> short_result(). 927check(OuterTest, CExm) -> 928 check(OuterTest, CExm, []). 929 930%% @doc Same as {@link check/2}, but also accepts a list of options. 931-spec check(outer_test(), counterexample(), user_opts()) -> short_result(). 932check(OuterTest, CExm, UserOpts) -> 933 try parse_opts(UserOpts) of 934 ImmOpts -> 935 {Test,Opts} = peel_test(OuterTest, ImmOpts), 936 retry(Test, CExm, Opts) 937 catch 938 throw:{Err,_Opt} = Reason when Err =:= erroneous_option; 939 Err =:= unrecognized_option -> 940 report_error(Reason, fun io:format/2), 941 {error, Reason} 942 end. 943 944%% @doc Tests all properties (i.e., all 0-arity functions whose name begins with 945%% `prop_') exported from module `Mod'. 946-spec module(mod_name()) -> module_result(). 947module(Mod) -> 948 module(Mod, []). 949 950%% @doc Same as {@link module/1}, but also accepts a list of options. 951-spec module(mod_name(), user_opts()) -> module_result(). 952module(Mod, UserOpts) -> 953 multi_test_prep(Mod, test, UserOpts). 954 955%% @doc Tests all exported, `-spec'ed functions of a module `Mod' against their 956%% spec. 957-spec check_specs(mod_name()) -> module_result(). 958check_specs(Mod) -> 959 check_specs(Mod, []). 960 961%% @doc Same as {@link check_specs/1}, but also accepts a list of options. 962-spec check_specs(mod_name(), user_opts()) -> module_result(). 963check_specs(Mod, UserOpts) -> 964 multi_test_prep(Mod, spec, UserOpts). 965 966-spec multi_test_prep(mod_name(), raw_test_kind(), user_opts()) -> 967 module_result(). 968multi_test_prep(Mod, Kind, UserOpts) -> 969 try parse_opts(UserOpts) of 970 Opts -> 971 multi_test(Mod, Kind, Opts) 972 catch 973 throw:{Err,_Opt} = Reason when Err =:= erroneous_option; 974 Err =:= unrecognized_option -> 975 report_error(Reason, fun io:format/2), 976 {error, Reason} 977 end. 978 979%% @doc A type-conversion function that can be used to convert an argument of 980%% a {@type proper:test()} opaque type to a {@type proper:outer_test()} opaque 981%% type so that the latter type can be passed to functions such as 982%% {@link proper:quickcheck/1} without a warning from dialyzer. 983-spec test_to_outer_test(test()) -> outer_test(). 984test_to_outer_test(Test) -> Test. 985 986%%----------------------------------------------------------------------------- 987%% Options parsing functions 988%%----------------------------------------------------------------------------- 989 990-spec add_user_opt(user_opt(), user_opts()) -> [user_opt(),...]. 991add_user_opt(NewUserOpt, UserOptsList) when is_list(UserOptsList) -> 992 [NewUserOpt | UserOptsList]; 993add_user_opt(NewUserOpt, SingleUserOpt) -> 994 add_user_opt(NewUserOpt, [SingleUserOpt]). 995 996-spec parse_opts(user_opts()) -> opts(). 997parse_opts(UserOptsList) when is_list(UserOptsList) -> 998 parse_opts(lists:reverse(UserOptsList), maybe_override_numworkers(#opts{})); 999parse_opts(SingleUserOpt) -> 1000 parse_opts([SingleUserOpt]). 1001 1002-spec parse_opts([user_opt()], opts()) -> opts(). 1003parse_opts([], Opts) -> 1004 Opts; 1005parse_opts([UserOpt | Rest], Opts) -> 1006 parse_opts(Rest, parse_opt(UserOpt,Opts)). 1007 1008-spec maybe_override_numworkers(opts()) -> opts(). 1009maybe_override_numworkers(Opts) -> 1010 case os:getenv("NUMWORKERS") of 1011 false -> Opts; 1012 N -> Opts#opts{numworkers = erlang:list_to_integer(N)} 1013 end. 1014 1015-define(POS_INTEGER(N), (is_integer(N) andalso N > 0)). 1016-define(NON_NEG_INTEGER(N), (is_integer(N) andalso N >= 0)). 1017-define(VALIDATE_OPT(Check, NewOpts), 1018 try Check of 1019 true -> NewOpts; 1020 false -> throw({erroneous_option,UserOpt}) 1021 catch _:_ -> throw({erroneous_option,UserOpt}) 1022 end). 1023 1024-spec parse_opt(user_opt(), opts()) -> opts(). 1025parse_opt(UserOpt, Opts) -> 1026 case UserOpt of 1027 %% atom options, alphabetically 1028 any_to_integer -> Opts#opts{any_type = {type,proper_types:integer()}}; 1029 fails -> Opts#opts{expect_fail = true}; 1030 long_result -> Opts#opts{long_result = true}; 1031 nocolors -> Opts#opts{nocolors = true}; 1032 noshrink -> Opts#opts{noshrink = true}; 1033 quiet -> Opts#opts{output_fun = fun(_,_) -> ok end}; 1034 verbose -> Opts#opts{output_fun = fun io:format/2}; 1035 PropertyType when PropertyType =:= pure orelse PropertyType =:= impure -> 1036 Opts#opts{property_type = PropertyType}; 1037 %% integer 1038 N when is_integer(N) -> 1039 ?VALIDATE_OPT(?POS_INTEGER(N), Opts#opts{numtests = N}); 1040 %% tuple options, sorted on tag 1041 {constraint_tries,N} -> 1042 ?VALIDATE_OPT(?POS_INTEGER(N), Opts#opts{constraint_tries = N}); 1043 {false_positive_mfas,F} -> 1044 ?VALIDATE_OPT(is_function(F, 3) orelse F =:= undefined, 1045 Opts#opts{false_positive_mfas = F}); 1046 {max_shrinks,N} -> 1047 ?VALIDATE_OPT(?NON_NEG_INTEGER(N), Opts#opts{max_shrinks = N}); 1048 {max_size,Size} -> 1049 ?VALIDATE_OPT(?NON_NEG_INTEGER(Size), Opts#opts{max_size = Size}); 1050 {numtests,N} -> 1051 ?VALIDATE_OPT(?POS_INTEGER(N), Opts#opts{numtests = N}); 1052 {numworkers,N} -> 1053 ?VALIDATE_OPT(?NON_NEG_INTEGER(N), Opts#opts{numworkers = N}); 1054 {strategy_fun,Fun} -> 1055 ?VALIDATE_OPT(is_function(Fun, 2), Opts#opts{strategy_fun = Fun}); 1056 {stop_nodes,B} -> 1057 ?VALIDATE_OPT(is_boolean(B), Opts#opts{stop_nodes = B}); 1058 {on_output,Print} -> 1059 ?VALIDATE_OPT(is_function(Print, 2), 1060 Opts#opts{output_fun = Print, nocolors = true}); 1061 {search_steps,N} -> 1062 ?VALIDATE_OPT(?POS_INTEGER(N), Opts#opts{search_steps = N}); 1063 {search_strategy,S} -> 1064 ?VALIDATE_OPT(is_atom(S), Opts#opts{search_strategy = S}); 1065 {skip_mfas,L} -> 1066 IsMFA = fun ({M,F,A}) when is_atom(M), is_atom(F), 1067 is_integer(A), 0 =< A, A =< 255 -> true; 1068 (_) -> false 1069 end, 1070 ?VALIDATE_OPT(lists:all(IsMFA, L), Opts#opts{skip_mfas = L}); 1071 {spec_timeout,T} -> 1072 ?VALIDATE_OPT(?NON_NEG_INTEGER(T) orelse (T =:= infinity), 1073 Opts#opts{spec_timeout = T}); 1074 {start_size,Size} -> 1075 ?VALIDATE_OPT(?NON_NEG_INTEGER(Size), Opts#opts{start_size = Size}); 1076 {to_file,IoDev} -> 1077 Opts#opts{output_fun = fun (S, F) -> io:format(IoDev, S, F) end}; 1078 _OTHER -> 1079 throw({unrecognized_option,UserOpt}) 1080 end. 1081 1082-spec peel_test(outer_test(), opts()) -> {test(),opts()}. 1083peel_test({numtests,N,OuterTest}, Opts) -> 1084 peel_test(OuterTest, Opts#opts{numtests = N}); 1085peel_test({fails,OuterTest}, Opts) -> 1086 peel_test(OuterTest, Opts#opts{expect_fail = true}); 1087peel_test({on_output,Print,OuterTest}, Opts) -> 1088 peel_test(OuterTest, Opts#opts{output_fun = Print}); 1089peel_test({setup,Fun,OuterTest}, #opts{setup_funs = Funs} = Opts) -> 1090 peel_test(OuterTest, Opts#opts{setup_funs = [Fun|Funs]}); 1091peel_test({exists,_,_,_} = ExistsTest, Opts) -> 1092 {ExistsTest, Opts#opts{numtests=1}}; 1093peel_test(Test, Opts) -> 1094 {Test, Opts}. 1095 1096%%----------------------------------------------------------------------------- 1097%% Test declaration functions 1098%%----------------------------------------------------------------------------- 1099 1100%% @doc Specifies the number `N' of tests to run when testing the property 1101%% `Test'. Default is 100. 1102-spec numtests(pos_integer(), outer_test()) -> outer_test(). 1103numtests(N, Test) -> 1104 {numtests, N, Test}. 1105 1106%% @doc Specifies that we expect the property `Test' to fail for some input. The 1107%% property will be considered failing if it passes all the tests. 1108-spec fails(outer_test()) -> outer_test(). 1109fails(Test) -> 1110 {fails, Test}. 1111 1112%% @doc Specifies an output function `Print' to be used by PropEr for all output 1113%% printing during the testing of property `Test'. This wrapper is equivalent to 1114%% the `on_output' option. 1115-spec on_output(output_fun(), outer_test()) -> outer_test(). 1116on_output(Print, Test) -> 1117 {on_output, Print, Test}. 1118 1119%% @private 1120-spec setup(setup_fun(), outer_test()) -> outer_test(). 1121setup(Fun, Test) -> 1122 {setup, Fun, Test}. 1123 1124%% @private 1125-spec forall(proper_types:raw_type(), dependent_test()) -> test(). 1126forall(RawType, DTest) -> 1127 {forall, RawType, DTest}. 1128 1129%% @private 1130-spec exists(proper_types:raw_type(), dependent_test(), boolean()) -> test(). 1131exists(RawType, DTest, Not) -> 1132 {exists, RawType, DTest, Not}. 1133 1134%% @private 1135-spec targeted(proper_types:raw_type(), dependent_test()) -> outer_test(). 1136targeted(RawType, DTest) -> 1137 setup(fun (#{numtests := Numtests} = Opts) -> 1138 put('$search_steps', Numtests), 1139 NewOpts = Opts#{search_steps => Numtests}, 1140 proper_target:init_strategy(NewOpts), 1141 proper_target:init_target(RawType), 1142 fun proper_target:cleanup_strategy/0 1143 end, 1144 forall(proper_target:targeted(RawType), DTest)). 1145 1146%% @doc Returns a property that is true only if all of the sub-properties 1147%% `SubProps' are true. Each sub-property should be tagged with a distinct atom. 1148%% If this property fails, each failing sub-property will be reported and saved 1149%% inside the counterexample along with its tag. 1150-spec conjunction([{tag(),test()}]) -> test(). 1151conjunction(SubProps) -> 1152 {conjunction, SubProps}. 1153 1154%% @private 1155-spec implies(boolean(), delayed_test()) -> test(). 1156implies(Pre, DTest) -> 1157 {implies, Pre, DTest}. 1158 1159%% @doc Specifies that test cases produced by this property should be 1160%% categorized under the term `Category'. This field can be an expression or 1161%% statement block that evaluates to any term. All produced categories are 1162%% printed at the end of testing (in case no test fails) along with the 1163%% percentage of test cases belonging to each category. Multiple `collect' 1164%% wrappers are allowed in a single property, in which case the percentages for 1165%% each `collect' wrapper are printed separately. 1166-spec collect(term(), test()) -> test(). 1167collect(Category, Test) -> 1168 collect(with_title(""), Category, Test). 1169 1170%% @doc Same as {@link collect/2}, but also accepts a fun `Printer' to be used 1171%% as the stats printer. 1172-spec collect(stats_printer(), term(), test()) -> test(). 1173collect(Printer, Category, Test) -> 1174 aggregate(Printer, [Category], Test). 1175 1176%% @doc Same as {@link collect/2}, but accepts a list of categories under which 1177%% to classify the produced test case. 1178-spec aggregate(sample(), test()) -> test(). 1179aggregate(Sample, Test) -> 1180 aggregate(with_title(""), Sample, Test). 1181 1182%% @doc Same as {@link collect/3}, but accepts a list of categories under which 1183%% to classify the produced test case. 1184-spec aggregate(stats_printer(), sample(), test()) -> test(). 1185aggregate(Printer, Sample, Test) -> 1186 {sample, Sample, Printer, Test}. 1187 1188%% @doc Same as {@link collect/2}, but can accept both a single category and a 1189%% list of categories. `Count' is a boolean flag: when `false', the particular 1190%% test case will not be counted. 1191-spec classify(Count::boolean(), term() | sample(), test()) -> test(). 1192classify(false, _TermOrSample, Test) -> 1193 aggregate([], Test); 1194classify(true, Sample, Test) when is_list(Sample) -> 1195 aggregate(Sample, Test); 1196classify(true, Term, Test) -> 1197 collect(Term, Test). 1198 1199%% @doc A function that collects numeric statistics on the produced instances. 1200%% The number (or numbers) provided are collected and some statistics over the 1201%% collected sample are printed at the end of testing (in case no test fails), 1202%% prepended with `Title', which should be an atom or string. 1203-spec measure(title(), number() | [number()], test()) -> test(). 1204measure(Title, Sample, Test) when is_number(Sample) -> 1205 measure(Title, [Sample], Test); 1206measure(Title, Sample, Test) when is_list(Sample) -> 1207 aggregate(numeric_with_title(Title), Sample, Test). 1208 1209%% @private 1210-spec whenfail(side_effects_fun(), delayed_test()) -> test(). 1211whenfail(Action, DTest) -> 1212 {whenfail, Action, DTest}. 1213 1214%% @private 1215-spec trapexit(fun(() -> boolean())) -> test(). 1216trapexit(DTest) -> 1217 {trapexit, DTest}. 1218 1219%% @private 1220-spec timeout(time_period(), fun(() -> boolean())) -> test(). 1221timeout(Limit, DTest) -> 1222 {timeout, Limit, DTest}. 1223 1224%% @doc A custom property that evaluates to `true' only if `A =:= B', else 1225%% evaluates to `false' and prints "`A =/= B'" on the screen. 1226-spec equals(term(), term()) -> test(). 1227equals(A, B) -> 1228 ?WHENFAIL(io:format("~w =/= ~w~n",[A,B]), A =:= B). 1229 1230 1231%%----------------------------------------------------------------------------- 1232%% Bulk testing functions 1233%%----------------------------------------------------------------------------- 1234 1235-spec test(raw_test(), opts()) -> result(). 1236test(RawTest, Opts) -> 1237 global_state_init(Opts), 1238 Finalizers = setup_test(Opts), 1239 Result = inner_test(RawTest, Opts), 1240 ok = finalize_test(Finalizers), 1241 global_state_erase(), 1242 Result. 1243 1244-spec inner_test(raw_test(), opts()) -> result(). 1245inner_test(RawTest, Opts) -> 1246 #opts{numtests = NumTests, long_result = Long, output_fun = Print, 1247 numworkers = NumWorkers} = Opts, 1248 Test = cook_test(RawTest, Opts), 1249 ImmResult = case NumWorkers > 0 of 1250 true -> 1251 Opts1 = case NumWorkers > NumTests of 1252 true -> Opts#opts{numworkers = NumTests}; 1253 false -> Opts 1254 end, 1255 parallel_perform(Test, Opts1); 1256 false -> 1257 perform(NumTests, Test, Opts) 1258 end, 1259 Print("~n", []), 1260 report_imm_result(ImmResult, Opts), 1261 {ShortResult,LongResult} = get_result(ImmResult, Test, Opts), 1262 case Long of 1263 true -> LongResult; 1264 false -> ShortResult 1265 end. 1266 1267%% @private 1268-spec spawn_workers_and_get_result( 1269 SpawnFun :: fun((worker_args()) -> [{non_neg_integer(), non_neg_integer()}]), 1270 WorkerArgs :: [worker_args()]) -> imm_result(). 1271spawn_workers_and_get_result(SpawnFun, WorkerArgs) -> 1272 _ = maybe_start_cover_server(WorkerArgs), 1273 WorkerList = lists:map(SpawnFun, WorkerArgs), 1274 InitialResult = #pass{samples = [], printers = [], actions = []}, 1275 AggregatedImmResult = aggregate_imm_result(WorkerList, InitialResult), 1276 ok = maybe_stop_cover_server(WorkerArgs), 1277 AggregatedImmResult. 1278 1279%% @private 1280%% @doc Runs PropEr in parallel mode, through the use of workers to perform the tests. 1281%% Under this mode, PropEr needs information whether a property is pure or impure, 1282%% and this information is passed via an option. 1283%% When testing impure properties, PropEr will start a node for every worker that will be 1284%% spawned in order to avoid test collisions between them. 1285-spec parallel_perform(test(), opts()) -> imm_result(). 1286parallel_perform(Test, #opts{property_type = pure, numtests = NumTests, 1287 numworkers = NumWorkers, strategy_fun = StrategyFun} = Opts) -> 1288 SpawnFun = fun({Start, ToPass}) -> 1289 spawn_link_migrate(undefined, fun() -> perform(Start, ToPass, Test, Opts) end) 1290 end, 1291 TestsPerWorker = StrategyFun(NumTests, NumWorkers), 1292 spawn_workers_and_get_result(SpawnFun, TestsPerWorker); 1293parallel_perform(Test, #opts{property_type = impure, numtests = NumTests, 1294 numworkers = NumWorkers, strategy_fun = StrategyFun, 1295 stop_nodes = StopNodes} = Opts) -> 1296 TestsPerWorker = StrategyFun(NumTests, NumWorkers), 1297 Nodes = start_nodes(NumWorkers), 1298 ensure_code_loaded(Nodes), 1299 NodeList = lists:zip(Nodes, TestsPerWorker), 1300 SpawnFun = fun({Node, {Start, ToPass}}) -> 1301 spawn_link_migrate(Node, fun() -> perform(Start, ToPass, Test, Opts) end) 1302 end, 1303 AggregatedImmResult = spawn_workers_and_get_result(SpawnFun, NodeList), 1304 ok = case StopNodes of 1305 true -> stop_nodes(); 1306 false -> ok 1307 end, 1308 AggregatedImmResult. 1309 1310-spec retry(test(), counterexample(), opts()) -> short_result(). 1311retry(Test, CExm, Opts) -> 1312 global_state_init(Opts), 1313 Finalizers = setup_test(Opts), 1314 RunResult = rerun(Test, false, CExm), 1315 report_rerun_result(RunResult, Opts), 1316 ShortResult = get_rerun_result(RunResult), 1317 ok = finalize_test(Finalizers), 1318 global_state_erase(), 1319 ShortResult. 1320 1321-spec multi_test(mod_name(), raw_test_kind(), opts()) -> module_result(). 1322multi_test(Mod, RawTestKind, Opts) -> 1323 #opts{long_result = Long, output_fun = Print, skip_mfas = SkipMFAs} = Opts, 1324 global_state_init(Opts), 1325 MaybeMFAs = 1326 case RawTestKind of 1327 test -> 1328 {ok,[{Mod,Name,0} || {Name,0} <- Mod:module_info(exports), 1329 lists:prefix(?PROPERTY_PREFIX, 1330 atom_to_list(Name))]}; 1331 spec -> 1332 proper_typeserver:get_exp_specced(Mod) 1333 end, 1334 {ShortResult, LongResult} = 1335 case MaybeMFAs of 1336 {ok,MFAs} -> 1337 RawLRes = [{MFA,mfa_test(MFA,RawTestKind,Opts)} || MFA <- MFAs--SkipMFAs], 1338 LRes = [T || {_MFA,Res} = T <- RawLRes, is_list(Res)], 1339 SRes = [MFA || {MFA,_Res} <- LRes], 1340 save_counterexamples(LRes), 1341 {SRes, LRes}; 1342 {error,SubReason} -> 1343 Reason = {typeserver,SubReason}, 1344 report_error(Reason, Print), 1345 Error = {error,Reason}, 1346 {Error, Error} 1347 end, 1348 global_state_erase(), 1349 case Long of 1350 true -> LongResult; 1351 false -> ShortResult 1352 end. 1353 1354-spec mfa_test(mfa(), raw_test_kind(), opts()) -> long_result(). 1355mfa_test({Mod,Fun,Arity} = MFA, RawTestKind, ImmOpts) -> 1356 {RawTest,#opts{output_fun = Print, numworkers = NumWorkers} = Opts} = 1357 case RawTestKind of 1358 test -> 1359 OuterTest = Mod:Fun(), 1360 {Test,FinalOpts} = peel_test(OuterTest, ImmOpts), 1361 {{test,Test}, FinalOpts}; 1362 spec -> 1363 {{spec,MFA}, ImmOpts} 1364 end, 1365 global_state_reset(Opts), 1366 Print("Testing ~w:~w/~b~n", [Mod,Fun,Arity]), 1367 Finalizers = setup_test(Opts), 1368 Opts1 = case NumWorkers > 0 of 1369 true -> 1370 _ = start_nodes(NumWorkers), 1371 Opts#opts{stop_nodes = false}; 1372 false -> Opts 1373 end, 1374 LongResult = inner_test(RawTest, Opts1#opts{long_result = true}), 1375 ok = finalize_test(Finalizers), 1376 ok = stop_nodes(), 1377 Print("~n", []), 1378 LongResult. 1379 1380-spec cook_test(raw_test(), opts()) -> test(). 1381cook_test({test,Test}, _Opts) -> 1382 Test; 1383cook_test({spec,MFA}, #opts{spec_timeout = SpecTimeout, false_positive_mfas = FalsePositiveMFAs}) -> 1384 case proper_typeserver:create_spec_test(MFA, SpecTimeout, FalsePositiveMFAs) of 1385 {ok,Test} -> 1386 Test; 1387 {error,Reason} -> 1388 ?FORALL(_, dummy, throw({'$typeserver',Reason})) 1389 end. 1390 1391-spec get_result(imm_result(),test(),opts()) -> {short_result(),long_result()}. 1392get_result(#pass{}, _Test, _Opts) -> 1393 {true, true}; 1394get_result(#fail{reason = not_found, bound=[]}, _Test, _Opts) -> 1395 {false, false}; 1396get_result(#fail{reason = Reason, bound = Bound}, Test, Opts) -> 1397 case shrink(Bound, Test, Reason, Opts) of 1398 {ok,MinImmTestCase} -> 1399 MinTestCase = clean_testcase(MinImmTestCase), 1400 save_counterexample(MinTestCase), 1401 {false, MinTestCase}; 1402 {error,ErrorReason} = Error -> 1403 report_error(ErrorReason, Opts#opts.output_fun), 1404 {Error, Error} 1405 end; 1406get_result({error,_Reason} = ErrorResult, _Test, _Opts) -> 1407 {ErrorResult, ErrorResult}. 1408 1409-spec get_rerun_result(run_result()) -> short_result(). 1410get_rerun_result(#pass{}) -> 1411 true; 1412get_rerun_result(#fail{}) -> 1413 false; 1414get_rerun_result({error,_Reason} = ErrorResult) -> 1415 ErrorResult. 1416 1417-spec check_if_early_fail() -> 'ok'. 1418check_if_early_fail() -> 1419 Id = get('$property_id'), 1420 receive 1421 {worker_msg, {failed_test, From}, Id} -> 1422 Passed = get('$tests_passed'), 1423 From ! {worker_msg, {performed, Passed, Id}}, 1424 ok 1425 after 0 -> ok 1426 end. 1427 1428-spec update_tests_passed(non_neg_integer()) -> non_neg_integer(). 1429update_tests_passed(Passed) -> 1430 case get('$tests_passed') of 1431 undefined -> put('$tests_passed', Passed); 1432 Passed2 -> put('$tests_passed', Passed + Passed2) 1433 end. 1434 1435-spec perform(non_neg_integer(), test(), opts()) -> imm_result() | 'ok'. 1436perform(NumTests, Test, Opts) -> 1437 perform(0, NumTests, ?MAX_TRIES_FACTOR * NumTests, Test, none, none, Opts). 1438 1439-spec perform(non_neg_integer(), pos_integer(), test(), opts()) -> imm_result() | 'ok'. 1440perform(Passed, NumTests, Test, Opts) -> 1441 Size = size_at_nth_test(Passed, Opts), 1442 put('$size', Size), 1443 %% When working on parallelizing PropEr initially we used to hit 1444 %% too easily the default maximum number of tries that PropEr had, 1445 %% so when running on parallel it has a higher than usual max 1446 %% number of tries. The number was picked after testing locally 1447 %% with different values. 1448 perform(Passed, NumTests, 3 * ?MAX_TRIES_FACTOR * NumTests, Test, none, none, Opts). 1449 1450-spec perform(non_neg_integer(), pos_integer(), non_neg_integer(), test(), 1451 [sample()] | 'none', [stats_printer()] | 'none', opts()) -> 1452 imm_result() | 'ok'. 1453perform(Passed, _ToPass, 0, _Test, Samples, Printers, 1454 #opts{numworkers = NumWorkers, parent = From} = _Opts) when NumWorkers > 0 -> 1455 R = case Passed of 1456 0 -> {error, cant_satisfy}; 1457 _ -> #pass{samples = Samples, printers = Printers, performed = Passed, actions = []} 1458 end, 1459 update_tests_passed(Passed), 1460 From ! {worker_msg, R, self(), get('$property_id')}, 1461 ok; 1462perform(Passed, _ToPass, 0, _Test, Samples, Printers, _Opts) -> 1463 case Passed of 1464 0 -> {error, cant_satisfy}; 1465 _ -> #pass{samples = Samples, printers = Printers, performed = Passed, actions = []} 1466 end; 1467perform(ToPass, ToPass, _TriesLeft, _Test, Samples, Printers, 1468 #opts{numworkers = NumWorkers, parent = From} = _Opts) when NumWorkers > 0 -> 1469 R = #pass{samples = Samples, printers = Printers, performed = ToPass, actions = []}, 1470 check_if_early_fail(), 1471 From ! {worker_msg, R#pass{performed = floor(ToPass div NumWorkers + 1)}, self(), get('$property_id')}, 1472 ok; 1473perform(ToPass, ToPass, _TriesLeft, _Test, Samples, Printers, _Opts) -> 1474 #pass{samples = Samples, printers = Printers, performed = ToPass, actions = []}; 1475perform(Passed, ToPass, TriesLeft, Test, Samples, Printers, 1476 #opts{output_fun = Print, numworkers = NumWorkers, parent = From} = Opts) when NumWorkers > 0 -> 1477 check_if_early_fail(), 1478 case run(Test, Opts) of 1479 #pass{reason = true_prop, samples = MoreSamples, 1480 printers = MorePrinters} -> 1481 Print(".", []), 1482 NewSamples = add_samples(MoreSamples, Samples), 1483 NewPrinters = case Printers of 1484 none -> MorePrinters; 1485 _ -> Printers 1486 end, 1487 grow_size(Opts), 1488 update_tests_passed(floor((Passed + 1) div NumWorkers + 1)), 1489 perform(Passed + get('$proper_test_incr'), ToPass, TriesLeft - 1, Test, 1490 NewSamples, NewPrinters, Opts); 1491 #fail{} = FailResult -> 1492 Print("!", []), 1493 R = FailResult#fail{performed = (Passed + 1) div NumWorkers + 1}, 1494 From ! {worker_msg, R, self(), get('$property_id')}, 1495 ok; 1496 {error, rejected} -> 1497 Print("x", []), 1498 grow_size(Opts), 1499 perform(Passed, ToPass, TriesLeft - 1, Test, 1500 Samples, Printers, Opts); 1501 {error, Reason} = Error when Reason =:= arity_limit 1502 orelse Reason =:= non_boolean_result 1503 orelse Reason =:= type_mismatch -> 1504 From ! {worker_msg, Error, self(), get('$property_id')}, 1505 ok; 1506 {error, {cant_generate,_MFAs}} = Error -> 1507 From ! {worker_msg, Error, self(), get('$property_id')}, 1508 ok; 1509 {error, {typeserver,_SubReason}} = Error -> 1510 From ! {worker_msg, Error, self(), get('$property_id')}, 1511 ok; 1512 Other -> 1513 From ! {worker_msg, {error, {unexpected, Other}}, self(), get('$property_id')}, 1514 ok 1515 end; 1516perform(Passed, ToPass, TriesLeft, Test, Samples, Printers, 1517 #opts{output_fun = Print} = Opts) -> 1518 case run(Test, Opts) of 1519 #pass{reason = true_prop, samples = MoreSamples, 1520 printers = MorePrinters} -> 1521 Print(".", []), 1522 NewSamples = add_samples(MoreSamples, Samples), 1523 NewPrinters = case Printers of 1524 none -> MorePrinters; 1525 _ -> Printers 1526 end, 1527 grow_size(Opts), 1528 perform(Passed + 1, ToPass, TriesLeft - 1, Test, 1529 NewSamples, NewPrinters, Opts); 1530 #fail{} = FailResult -> 1531 Print("!", []), 1532 FailResult#fail{performed = Passed + 1}; 1533 {error, rejected} -> 1534 Print("x", []), 1535 grow_size(Opts), 1536 perform(Passed, ToPass, TriesLeft - 1, Test, 1537 Samples, Printers, Opts); 1538 {error, Reason} = Error when Reason =:= arity_limit 1539 orelse Reason =:= non_boolean_result 1540 orelse Reason =:= type_mismatch -> 1541 Error; 1542 {error, {cant_generate,_MFAs}} = Error -> 1543 Error; 1544 {error, {typeserver,_SubReason}} = Error -> 1545 Error; 1546 Other -> 1547 {error, {unexpected,Other}} 1548 end. 1549 1550perform_search(NumSteps, Target, DTest, Ctx, Opts, Not) -> 1551 NumTries = ?MAX_TRIES_FACTOR * NumSteps, 1552 perform_search(0, NumSteps, NumTries, Target, DTest, Ctx, Opts, Not). 1553 1554perform_search(_Steps, _NumSteps, 0, _Target, _Ctx, _DTest, _Opts, _Not) -> 1555 {error, cant_satisfy}; 1556perform_search(NumSteps, NumSteps, _TriesLeft, _Target, _DTest, Ctx, _Opts, true) -> 1557 create_pass_result(Ctx, true_prop); 1558perform_search(NumSteps, NumSteps, _TriesLeft, _Target, _DTest, Ctx, _Opts, false) -> 1559 create_fail_result(Ctx, not_found); 1560perform_search(Steps, NumSteps, TriesLeft, Target, DTest, 1561 #ctx{bound = Bound} = Ctx, 1562 #opts{output_fun = Print} = Opts, Not) -> 1563 %% Search Step 1564 case proper_gen:safe_generate(Target) of 1565 {ok, ImmInstance} -> 1566 Instance = proper_gen:clean_instance(ImmInstance), 1567 NewBound = [ImmInstance | Bound], 1568 case force(Instance, DTest, Ctx#ctx{bound = NewBound}, Opts) of 1569 #pass{reason = true_prop, actions = Actions} -> 1570 %% the search is finished 1571 Print("!", []), 1572 case Not of 1573 true -> 1574 NCtx = Ctx#ctx{bound = NewBound, actions = Actions}, 1575 create_fail_result(NCtx, false_prop); 1576 false -> 1577 create_pass_result(Ctx, true_prop) 1578 end; 1579 #fail{reason = false_prop} -> 1580 Print(".", []), 1581 grow_size(Opts), 1582 perform_search(Steps + 1, NumSteps, TriesLeft - 1, 1583 Target, DTest, Ctx, Opts, Not); 1584 #fail{} = FailResult -> %% TODO check that fails in the EXIST macros trigger a bug 1585 Print("!", []), 1586 FailResult#fail{performed = Steps + 1}; 1587 {error, rejected} -> 1588 Print("x", []), 1589 grow_size(Opts), 1590 perform_search(Steps, NumSteps, TriesLeft - 1, 1591 Target, DTest, Ctx, Opts, Not); 1592 {error, _} = Error -> 1593 Error; 1594 Other -> 1595 {error, {unexpected, Other}} 1596 end; 1597 {error, _Reason} = Error -> 1598 Error 1599 end. 1600 1601-spec add_samples([sample()], [sample()] | 'none') -> [sample()]. 1602add_samples(MoreSamples, none) -> 1603 MoreSamples; 1604add_samples(MoreSamples, Samples) -> 1605 [M ++ S || {M, S} <- proper_arith:safe_zip(MoreSamples, Samples)]. 1606 1607%% Evaluated only for its side-effects. 1608-spec gen_and_print_samples(proper_types:raw_type(), 1609 proper_gen:size(), proper_gen:size()) -> 'ok'. 1610gen_and_print_samples(RawType, StartSize, EndSize) -> 1611 Tests = EndSize - StartSize + 1, 1612 Prop = ?FORALL(X, RawType, begin io:format("~p~n",[X]), true end), 1613 Opts = [quiet,{start_size,StartSize},{max_size,EndSize},{numtests,Tests}], 1614 _ = quickcheck(Prop, Opts), 1615 ok. 1616 1617%%----------------------------------------------------------------------------- 1618%% Single test runner functions 1619%%----------------------------------------------------------------------------- 1620 1621-spec run(test(), opts()) -> run_result(). 1622run(Test, Opts) -> 1623 run(Test, #ctx{}, Opts). 1624 1625-spec rerun(test(), boolean(), imm_testcase() | counterexample()) -> run_result(). 1626rerun(Test, IsImm, ToTry) -> 1627 Mode = case IsImm of 1628 true -> try_shrunk; 1629 false -> try_cexm 1630 end, 1631 Ctx = #ctx{mode = Mode, bound = ToTry}, 1632 Opts = #opts{}, 1633 run(Test, Ctx, Opts). 1634 1635-spec run(test(), ctx(), opts()) -> run_result(). 1636run(Result, #ctx{mode = Mode, bound = Bound} = Ctx, _Opts) when is_boolean(Result) -> 1637 case Mode =:= new orelse Bound =:= [] of 1638 true -> 1639 case Result of 1640 true -> create_pass_result(Ctx, true_prop); 1641 false -> create_fail_result(Ctx, false_prop) 1642 end; 1643 false -> 1644 {error, too_many_instances} 1645 end; 1646run({exists, RawType, Prop, Not}, #ctx{mode = new} = Ctx, 1647 #opts{search_strategy = Strat, search_steps = Steps, 1648 output_fun = Print, start_size = StartSize} = Opts) -> 1649 InitOpts = #{search_steps => Steps, search_strategy => Strat}, 1650 proper_target:init_strategy(InitOpts), 1651 proper_target:init_target(RawType), 1652 Target = proper_target:targeted(RawType), 1653 BackupSize = get('$size'), 1654 put('$size', StartSize - 1), 1655 Print("[", []), 1656 SR = perform_search(Steps, Target, Prop, Ctx, Opts, Not), 1657 Print("]", []), 1658 put('$size', BackupSize), 1659 proper_target:cleanup_strategy(), 1660 SR; 1661run({exists, _, _, _} = Exists, #ctx{mode = try_shrunk, bound = []}, Opts) -> 1662 run(Exists, #ctx{mode = new, bound = []}, Opts#opts{output_fun = fun (_, _) -> ok end}); 1663run({exists, _RawType, _Prop, _Not}, #ctx{bound = []} = Ctx, _Opts) -> 1664 create_pass_result(Ctx, didnt_crash); 1665run({exists, RawType, Prop, Not}, 1666 #ctx{mode = try_shrunk, bound = [ImmInstance | Rest]} = Ctx, Opts) -> 1667 ShrinkerType = proper_target:get_shrinker(RawType), 1668 case proper_types:safe_is_instance(ImmInstance, ShrinkerType) of 1669 true -> 1670 Instance = proper_gen:clean_instance(ImmInstance), 1671 case {force(Instance, Prop, Ctx#ctx{bound = Rest}, Opts), Not} of 1672 {#fail{}, true} -> create_pass_result(Ctx, true_prop); 1673 {#pass{}, true} -> create_fail_result(Ctx, false_prop); 1674 {R, _} -> R 1675 end; 1676 false -> 1677 %% TODO: could try to fix the instances here 1678 {error, wrong_type}; 1679 {error, _Reason} = Error -> 1680 Error 1681 end; 1682run({exists, _RawType, Prop, Not}, 1683 #ctx{mode = try_cexm, bound = [Instance | Rest]} = Ctx, Opts) -> 1684 case {force(Instance, Prop, Ctx#ctx{bound = Rest}, Opts), Not} of 1685 {#fail{}, true} -> create_pass_result(Ctx, true_prop); 1686 {#pass{}, true} -> create_fail_result(Ctx, false_prop); 1687 {R, _} -> R 1688 end; 1689run({forall, RawType, Prop}, #ctx{mode = new, bound = Bound} = Ctx, Opts) -> 1690 case proper_gen:safe_generate(RawType) of 1691 {ok, ImmInstance} -> 1692 Instance = proper_gen:clean_instance(ImmInstance), 1693 NewCtx = Ctx#ctx{bound = [ImmInstance | Bound]}, 1694 force(Instance, Prop, NewCtx, Opts); 1695 {error,_Reason} = Error -> 1696 Error 1697 end; 1698run({forall, _RawType, _Prop}, #ctx{bound = []} = Ctx, _Opts) -> 1699 create_pass_result(Ctx, didnt_crash); 1700run({forall, RawType, Prop}, #ctx{mode = try_shrunk, 1701 bound = [ImmInstance | Rest]} = Ctx, Opts) -> 1702 case proper_types:safe_is_instance(ImmInstance, RawType) of 1703 true -> 1704 Instance = proper_gen:clean_instance(ImmInstance), 1705 force(Instance, Prop, Ctx#ctx{bound = Rest}, Opts); 1706 false -> 1707 %% TODO: could try to fix the instances here 1708 {error, wrong_type}; 1709 {error, _Reason} = Error -> 1710 Error 1711 end; 1712run({forall, _RawType, Prop}, #ctx{mode = try_cexm, 1713 bound = [Instance | Rest]} = Ctx, Opts) -> 1714 force(Instance, Prop, Ctx#ctx{bound = Rest}, Opts); 1715run({conjunction, SubProps}, #ctx{mode = new} = Ctx, Opts) -> 1716 run_all(SubProps, [], Ctx, Opts); 1717run({conjunction, SubProps}, #ctx{mode = try_shrunk, bound = Bound} = Ctx, Opts) -> 1718 case Bound of 1719 [] -> 1720 create_pass_result(Ctx, didnt_crash); 1721 [{'$conjunction', SubImmTCs}] -> 1722 run_all(SubProps, SubImmTCs, Ctx#ctx{bound = []}, Opts); 1723 _ -> 1724 {error, too_many_instances} 1725 end; 1726run({conjunction, SubProps}, #ctx{mode = try_cexm, bound = Bound} = Ctx, Opts) -> 1727 RealBound = case Bound of [] -> [[]]; _ -> Bound end, 1728 case RealBound of 1729 [SubTCs] -> run_all(SubProps, SubTCs, Ctx#ctx{bound = []}, Opts); 1730 _ -> {error, too_many_instances} 1731 end; 1732run({implies, true, Prop}, Ctx, Opts) -> 1733 force(Prop, Ctx, Opts); 1734run({implies, false, _Prop}, _Ctx, _Opts) -> 1735 {error, rejected}; 1736run({sample, NewSample, NewPrinter, Prop}, #ctx{samples = Samples, 1737 printers = Printers} = Ctx, Opts) -> 1738 NewCtx = Ctx#ctx{samples = [NewSample | Samples], 1739 printers = [NewPrinter | Printers]}, 1740 run(Prop, NewCtx, Opts); 1741run({whenfail, NewAction, Prop}, #ctx{actions = Actions} = Ctx, Opts) -> 1742 NewCtx = Ctx#ctx{actions = [NewAction | Actions]}, 1743 force(Prop, NewCtx, Opts); 1744run({trapexit, Prop}, Ctx, Opts) -> 1745 OldFlag = process_flag(trap_exit, true), 1746 Self = self(), 1747 Child = spawn_link_migrate(undefined, fun() -> child(Self, Prop, Ctx, Opts) end), 1748 Result = 1749 receive 1750 {result, RecvResult} -> 1751 RecvResult; 1752 {'EXIT', Child, ExcReason} -> 1753 create_fail_result(Ctx, {trapped, ExcReason}) 1754 end, 1755 true = process_flag(trap_exit, OldFlag), 1756 Result; 1757run({timeout, Limit, Prop}, Ctx, Opts) -> 1758 Self = self(), 1759 Child = spawn_link_migrate(undefined, fun() -> child(Self, Prop, Ctx, Opts) end), 1760 receive 1761 {result, RecvResult} -> RecvResult 1762 after Limit -> 1763 unlink(Child), 1764 exit(Child, kill), 1765 clear_mailbox(), 1766 create_fail_result(Ctx, time_out) 1767 end; 1768run(_Other, _Ctx, _Opts) -> 1769 {error, non_boolean_result}. 1770 1771-spec run_all([{tag(),test()}], sub_imm_testcases() | sub_counterexamples(), 1772 ctx(), opts()) -> run_result(). 1773run_all(SubProps, Bound, Ctx, Opts) -> 1774 run_all(SubProps, Bound, [], Ctx, Opts). 1775 1776-spec run_all([{tag(),test()}], sub_imm_testcases() | sub_counterexamples(), 1777 [{tag(),fail_reason()}], ctx(), opts()) -> run_result(). 1778run_all([], SubBound, SubReasons, #ctx{mode = new, bound = OldBound} = Ctx, _Opts) -> 1779 NewBound = [{'$conjunction',lists:reverse(SubBound)} | OldBound], 1780 NewCtx = Ctx#ctx{bound = NewBound}, 1781 case SubReasons of 1782 [] -> create_pass_result(NewCtx, true_prop); 1783 _ -> create_fail_result(NewCtx, {sub_props,lists:reverse(SubReasons)}) 1784 end; 1785run_all([], SubBound, SubReasons, Ctx, _Opts) -> 1786 case {SubBound,SubReasons} of 1787 {[],[]} -> 1788 create_pass_result(Ctx, true_prop); 1789 {[],_ } -> 1790 create_fail_result(Ctx, {sub_props,lists:reverse(SubReasons)}); 1791 {_ ,_ } -> 1792 {error, too_many_instances} 1793 end; 1794run_all([{Tag,Prop}|Rest], OldSubBound, SubReasons, 1795 #ctx{mode = Mode, actions = Actions, samples = Samples, 1796 printers = Printers} = Ctx, Opts) -> 1797 {SubCtxBound,SubBound} = 1798 case Mode of 1799 new -> {[], OldSubBound}; 1800 _ -> {proplists:get_value(Tag, OldSubBound, []), 1801 proplists:delete(Tag, OldSubBound)} 1802 end, 1803 case run(Prop, #ctx{mode = Mode, bound = SubCtxBound}, Opts) of 1804 #pass{samples = MoreSamples, printers = MorePrinters} -> 1805 NewSamples = lists:reverse(MoreSamples, Samples), 1806 NewPrinters = lists:reverse(MorePrinters, Printers), 1807 NewCtx = Ctx#ctx{samples = NewSamples, printers = NewPrinters}, 1808 run_all(Rest, SubBound, SubReasons, NewCtx, Opts); 1809 #fail{reason = Reason, bound = SubImmTC, actions = MoreActions} -> 1810 NewActions = lists:reverse(MoreActions, Actions), 1811 NewCtx = Ctx#ctx{actions = NewActions}, 1812 NewSubBound = 1813 case Mode of 1814 new -> [{Tag,SubImmTC}|SubBound]; 1815 _ -> SubBound 1816 end, 1817 NewSubReasons = [{Tag,Reason}|SubReasons], 1818 run_all(Rest, NewSubBound, NewSubReasons, NewCtx, Opts); 1819 {error,_Reason} = Error -> 1820 Error 1821 end. 1822 1823-spec force(delayed_test(), ctx(), opts()) -> run_result(). 1824force(Prop, Ctx, Opts) -> 1825 apply_args([], Prop, Ctx, Opts). 1826 1827-spec force(proper_gen:instance(), dependent_test(), ctx(), opts()) -> run_result(). 1828force(Arg, Prop, Ctx, Opts) -> 1829 apply_args([proper_symb:internal_eval(Arg)], Prop, Ctx, Opts). 1830 1831-spec apply_args([proper_gen:instance()], lazy_test(), ctx(), opts()) -> run_result(). 1832apply_args(Args, Prop, Ctx, Opts) -> 1833 try apply(Prop, Args) of 1834 InnerProp -> run(InnerProp, Ctx, Opts) 1835 catch 1836 ?STACKTRACE(error, ErrReason, RawTrace) %, is in macro 1837 case ErrReason =:= function_clause 1838 andalso threw_exception(Prop, RawTrace) of 1839 true -> 1840 {error, type_mismatch}; 1841 false -> 1842 Trace = clean_stacktrace(RawTrace), 1843 create_fail_result(Ctx, {exception,error,ErrReason,Trace}) 1844 end; 1845 throw:'$arity_limit' -> 1846 {error, arity_limit}; 1847 throw:{'$cant_generate',MFAs} -> 1848 {error, {cant_generate,MFAs}}; 1849 throw:{'$typeserver',SubReason} -> 1850 {error, {typeserver,SubReason}}; 1851 ?STACKTRACE(ExcKind, ExcReason, Trace) %, is in macro 1852 create_fail_result(Ctx, {exception,ExcKind,ExcReason,Trace}) 1853 end. 1854 1855-spec create_pass_result(ctx(), pass_reason()) -> 1856 #pass{performed :: 'undefined'}. 1857create_pass_result(#ctx{samples = Samples, printers = Printers, actions= Actions}, Reason) -> 1858 #pass{reason = Reason, samples = lists:reverse(Samples), 1859 printers = lists:reverse(Printers), actions = Actions}. 1860 1861-spec create_fail_result(ctx(), fail_reason()) -> 1862 #fail{performed :: 'undefined'}. 1863create_fail_result(#ctx{bound = Bound, actions = Actions}, Reason) -> 1864 #fail{reason = Reason, bound = lists:reverse(Bound), 1865 actions = lists:reverse(Actions)}. 1866 1867-spec child(pid(), delayed_test(), ctx(), opts()) -> 'ok'. 1868child(Father, Prop, Ctx, Opts) -> 1869 Result = force(Prop, Ctx, Opts), 1870 Father ! {result,Result}, 1871 ok. 1872 1873-spec clear_mailbox() -> 'ok'. 1874clear_mailbox() -> 1875 receive 1876 _ -> clear_mailbox() 1877 after 0 -> 1878 ok 1879 end. 1880 1881-spec threw_exception(function(), stacktrace()) -> boolean(). 1882threw_exception(Fun, [{TopMod,TopName,TopArgs,_Location} | _Rest]) -> 1883 {module,FunMod} = erlang:fun_info(Fun, module), 1884 {name,FunName} = erlang:fun_info(Fun, name), 1885 {arity,FunArity} = erlang:fun_info(Fun, arity), 1886 TopArity = if 1887 is_integer(TopArgs) -> TopArgs; 1888 is_list(TopArgs) -> length(TopArgs) 1889 end, 1890 FunMod =:= TopMod andalso FunName =:= TopName andalso FunArity =:= TopArity. 1891 1892-spec clean_stacktrace(stacktrace()) -> stacktrace(). 1893clean_stacktrace(RawTrace) -> 1894 {Trace,_Rest} = lists:splitwith(fun is_not_proper_call/1, RawTrace), 1895 %% If the clean trace is empty it's probably because of a bad call to 1896 %% the proper API, so we let the whole stacktrace through 1897 case Trace of 1898 [] -> RawTrace; 1899 _ -> Trace 1900 end. 1901 1902-spec is_not_proper_call(call_record()) -> boolean(). 1903is_not_proper_call({Mod,_Fun,_Args,_Location}) -> 1904 not lists:prefix("proper", atom_to_list(Mod)). 1905 1906-spec clean_testcase(imm_testcase()) -> counterexample(). 1907clean_testcase(ImmTestCase) -> 1908 finalize_counterexample(preclean_testcase(ImmTestCase, [])). 1909 1910-spec preclean_testcase(imm_testcase(), imm_counterexample()) -> 1911 imm_counterexample(). 1912preclean_testcase([], Acc) -> 1913 lists:reverse(Acc); 1914preclean_testcase([{'$conjunction',SubImmTCs} | Rest], Acc) -> 1915 Rest = [], 1916 case preclean_sub_imm_testcases(SubImmTCs, []) of 1917 [] -> preclean_testcase([], Acc); 1918 SubImmCExms -> preclean_testcase([], [{'$conjunction',SubImmCExms}|Acc]) 1919 end; 1920preclean_testcase([ImmInstance | Rest], Acc) -> 1921 preclean_testcase(Rest, [proper_gen:clean_instance(ImmInstance) | Acc]). 1922 1923-spec preclean_sub_imm_testcases(sub_imm_testcases(), 1924 sub_imm_counterexamples()) -> 1925 sub_imm_counterexamples(). 1926preclean_sub_imm_testcases([], Acc) -> 1927 lists:reverse(Acc); 1928preclean_sub_imm_testcases([{Tag,ImmTC} | Rest], Acc) -> 1929 case preclean_testcase(ImmTC, []) of 1930 [] -> preclean_sub_imm_testcases(Rest, Acc); 1931 ImmCExm -> preclean_sub_imm_testcases(Rest, [{Tag,ImmCExm} | Acc]) 1932 end. 1933 1934-spec finalize_counterexample(imm_counterexample()) -> counterexample(). 1935finalize_counterexample(ImmCExm) -> 1936 [finalize_input(ImmCleanInput) || ImmCleanInput <- ImmCExm]. 1937 1938-spec finalize_input(imm_clean_input()) -> clean_input(). 1939finalize_input({'$conjunction',SubImmCExms}) -> 1940 [{Tag,finalize_counterexample(SubImmCExm)} 1941 || {Tag,SubImmCExm} <- SubImmCExms]; 1942finalize_input(Instance) -> 1943 Instance. 1944 1945 1946%%----------------------------------------------------------------------------- 1947%% Shrinking functions 1948%%----------------------------------------------------------------------------- 1949 1950-spec shrink(imm_testcase(), test(), fail_reason(), opts()) -> 1951 {'ok',imm_testcase()} | error(). 1952shrink(ImmTestCase, Test, Reason, 1953 #opts{expect_fail = false, noshrink = false, max_shrinks = MaxShrinks, 1954 output_fun = Print, nocolors = NoColors} = Opts) -> 1955 ?PRINT(NoColors, ?BOLD_BLUE, Print, "~nShrinking ", []), 1956 try 1957 StrTest = skip_to_next(Test), 1958 fix_shrink(ImmTestCase, StrTest, Reason, 0, MaxShrinks, Opts) 1959 of 1960 {Shrinks,MinImmTestCase} -> 1961 case rerun(Test, true, MinImmTestCase) of 1962 #fail{actions = MinActions} -> 1963 report_shrinking(Shrinks, MinImmTestCase, MinActions, Opts), 1964 {ok, MinImmTestCase}; 1965 %% The cases below should never occur for deterministic tests. 1966 %% When they do happen, we have no choice but to silently 1967 %% skip the fail actions. 1968 #pass{} -> 1969 report_shrinking(Shrinks, MinImmTestCase, [], Opts), 1970 {ok, MinImmTestCase}; 1971 {error,_Reason} -> 1972 report_shrinking(Shrinks, MinImmTestCase, [], Opts), 1973 {ok, MinImmTestCase} 1974 end 1975 catch 1976 throw:non_boolean_result -> 1977 Print("~n", []), 1978 {error, non_boolean_result} 1979 end; 1980shrink(ImmTestCase, _Test, _Reason, _Opts) -> 1981 {ok, ImmTestCase}. 1982 1983-spec fix_shrink(imm_testcase(), stripped_test(), fail_reason(), 1984 non_neg_integer(), non_neg_integer(), opts()) -> 1985 shrinking_result(). 1986fix_shrink(ImmTestCase, _StrTest, _Reason, Shrinks, 0, _Opts) -> 1987 {Shrinks, ImmTestCase}; 1988fix_shrink(ImmTestCase, StrTest, Reason, Shrinks, ShrinksLeft, Opts) -> 1989 case shrink([], ImmTestCase, StrTest, Reason, 0, ShrinksLeft, init, Opts) of 1990 {0,_MinImmTestCase} -> 1991 {Shrinks, ImmTestCase}; 1992 {MoreShrinks,MinImmTestCase} -> 1993 fix_shrink(MinImmTestCase, StrTest, Reason, Shrinks + MoreShrinks, 1994 ShrinksLeft - MoreShrinks, Opts) 1995 end. 1996 1997-spec shrink(imm_testcase(), imm_testcase(), stripped_test(), fail_reason(), 1998 non_neg_integer(), non_neg_integer(), proper_shrink:state(), 1999 opts()) -> shrinking_result(). 2000%% TODO: 'tries_left' instead of 'shrinks_left'? shrinking timeout? 2001%% TODO: Can we do anything better for non-deterministic tests? 2002shrink(Shrunk, TestTail, StrTest, _Reason, 2003 Shrinks, ShrinksLeft, _State, _Opts) when is_boolean(StrTest) 2004 orelse ShrinksLeft =:= 0 2005 orelse TestTail =:= []-> 2006 {Shrinks, lists:reverse(Shrunk, TestTail)}; 2007shrink(Shrunk, [ImmInstance | Rest], {_Type,Prop}, Reason, 2008 Shrinks, ShrinksLeft, done, Opts) -> 2009 Instance = proper_gen:clean_instance(ImmInstance), 2010 NewStrTest = force_skip(Instance, Prop), 2011 shrink([ImmInstance | Shrunk], Rest, NewStrTest, Reason, 2012 Shrinks, ShrinksLeft, init, Opts); 2013shrink(Shrunk, [RawImmInstance | Rest] = TestTail, {Type,Prop} = StrTest, Reason, 2014 Shrinks, ShrinksLeft, State, Opts) -> 2015 ImmInstance = case proper_types:find_prop(is_user_nf, Type) of 2016 {ok, true} -> 2017 case proper_types:safe_is_instance(RawImmInstance, Type) of 2018 false -> 2019 CleanInstance = proper_gen:clean_instance(RawImmInstance), 2020 case proper_types:safe_is_instance(CleanInstance, Type) of 2021 true -> CleanInstance; 2022 false -> RawImmInstance 2023 end; 2024 true -> RawImmInstance 2025 end; 2026 {ok, false} -> RawImmInstance; 2027 error -> RawImmInstance 2028 end, 2029 {NewImmInstances,NewState} = proper_shrink:shrink(ImmInstance, Type, State), 2030 %% TODO: Should we try fixing the nested ?FORALLs while shrinking? We could 2031 %% also just produce new test tails. 2032 IsValid = fun(I) -> 2033 I =/= ImmInstance andalso 2034 still_fails(I, Rest, Prop, Reason) 2035 end, 2036 case proper_arith:find_first(IsValid, NewImmInstances) of 2037 none -> 2038 shrink(Shrunk, TestTail, StrTest, Reason, 2039 Shrinks, ShrinksLeft, NewState, Opts); 2040 {Pos, ShrunkImmInstance} -> 2041 (Opts#opts.output_fun)(".", []), 2042 shrink(Shrunk, [ShrunkImmInstance | Rest], StrTest, Reason, 2043 Shrinks+1, ShrinksLeft-1, {shrunk,Pos,NewState}, Opts) 2044 end; 2045shrink(Shrunk, [{'$conjunction',SubImmTCs}], SubProps, {sub_props,SubReasons}, 2046 Shrinks, ShrinksLeft, init, Opts) when is_list(SubProps) -> 2047 shrink_all(Shrunk, [], SubImmTCs, SubProps, SubReasons, 2048 Shrinks, ShrinksLeft, Opts). 2049 2050-spec shrink_all(imm_testcase(), sub_imm_testcases(), sub_imm_testcases(), 2051 [{tag(),test()}], [{tag(),fail_reason()}], 2052 non_neg_integer(), non_neg_integer(), opts()) -> 2053 shrinking_result(). 2054shrink_all(ShrunkHead, Shrunk, SubImmTCs, _SubProps, _SubReasons, 2055 Shrinks, 0, _Opts) -> 2056 ShrunkSubImmTCs = lists:reverse(Shrunk, SubImmTCs), 2057 ImmTC = lists:reverse([{'$conjunction',ShrunkSubImmTCs} | ShrunkHead]), 2058 {Shrinks, ImmTC}; 2059shrink_all(ShrunkHead, Shrunk, [], [], [], 2060 Shrinks, _ShrinksLeft, Opts) -> 2061 shrink_all(ShrunkHead, Shrunk, [], [], [], Shrinks, 0, Opts); 2062shrink_all(ShrunkHead, Shrunk, SubImmTCs, [{Tag,Prop}|Rest], SubReasons, 2063 Shrinks, ShrinksLeft, Opts) -> 2064 case lists:keytake(Tag, 1, SubReasons) of 2065 {value,{Tag,Reason},NewSubReasons} -> 2066 {value,{Tag,SubImmTC},NewSubImmTCs} = 2067 lists:keytake(Tag, 1, SubImmTCs), 2068 {MoreShrinks,MinSubImmTC} = 2069 shrink([], SubImmTC, skip_to_next(Prop), Reason, 2070 0, ShrinksLeft, init, Opts), 2071 shrink_all(ShrunkHead, [{Tag,MinSubImmTC}|Shrunk], NewSubImmTCs, 2072 Rest, NewSubReasons, Shrinks+MoreShrinks, 2073 ShrinksLeft-MoreShrinks, Opts); 2074 false -> 2075 shrink_all(ShrunkHead, Shrunk, SubImmTCs, Rest, SubReasons, 2076 Shrinks, ShrinksLeft, Opts) 2077 end. 2078 2079-spec still_fails(proper_gen:imm_instance(), imm_testcase(), dependent_test(), 2080 fail_reason()) -> boolean(). 2081still_fails(ImmInstance, TestTail, Prop, OldReason) -> 2082 Instance = proper_gen:clean_instance(ImmInstance), 2083 Ctx = #ctx{mode = try_shrunk, bound = TestTail}, 2084 case force(Instance, Prop, Ctx, #opts{}) of 2085 #fail{reason = NewReason} -> 2086 same_fail_reason(OldReason, NewReason); 2087 _ -> 2088 false 2089 end. 2090 2091-spec same_fail_reason(fail_reason(), fail_reason()) -> boolean(). 2092 %% We don't mind if the stacktraces are different. 2093same_fail_reason({trapped,{ExcReason1,_StackTrace1}}, 2094 {trapped,{ExcReason2,_StackTrace2}}) -> 2095 same_exc_reason(ExcReason1, ExcReason2); 2096same_fail_reason({exception,SameExcKind,ExcReason1,_StackTrace1}, 2097 {exception,SameExcKind,ExcReason2,_StackTrace2}) -> 2098 same_exc_reason(ExcReason1, ExcReason2); 2099same_fail_reason({sub_props,SubReasons1}, {sub_props,SubReasons2}) -> 2100 length(SubReasons1) =:= length(SubReasons2) andalso 2101 lists:all(fun({A,B}) -> same_sub_reason(A,B) end, 2102 lists:zip(lists:sort(SubReasons1),lists:sort(SubReasons2))); 2103same_fail_reason(SameReason, SameReason) -> 2104 true; 2105same_fail_reason(_, _) -> 2106 false. 2107 2108-spec same_exc_reason(exc_reason(), exc_reason()) -> boolean(). 2109same_exc_reason(ExcReason1, ExcReason2) -> 2110 %% We assume that exception reasons are either atoms or tagged tuples. 2111 %% What we try to do is force the generation of the same exception reason. 2112 if 2113 is_atom(ExcReason1) -> 2114 ExcReason1 =:= ExcReason2; 2115 is_tuple(ExcReason1) -> 2116 is_tuple(ExcReason2) 2117 andalso tuple_size(ExcReason1) >= 1 2118 andalso tuple_size(ExcReason1) =:= tuple_size(ExcReason2) 2119 %% We assume that the tag is the first element. 2120 andalso is_atom(element(1, ExcReason1)) 2121 andalso element(1, ExcReason1) =:= element(1, ExcReason2); 2122 true -> 2123 false 2124 end. 2125 2126-spec same_sub_reason({tag(),fail_reason()},{tag(),fail_reason()}) -> boolean(). 2127same_sub_reason({SameTag,Reason1}, {SameTag,Reason2}) -> 2128 same_fail_reason(Reason1, Reason2); 2129same_sub_reason(_, _) -> 2130 false. 2131 2132-spec skip_to_next(test()) -> stripped_test(). 2133skip_to_next(Result) when is_boolean(Result) -> 2134 Result; 2135skip_to_next({exists, RawType, Prop, true}) -> 2136 ShrinkerType = proper_target:get_shrinker(proper_types:cook_outer(RawType)), 2137 Type = proper_types:cook_outer(ShrinkerType), 2138 {Type, fun (X) -> not force_skip(X, Prop) end}; 2139skip_to_next({exists, RawType, Prop, false}) -> 2140 %% false; 2141 ShrinkerType = proper_target:get_shrinker(proper_types:cook_outer(RawType)), 2142 Type = proper_types:cook_outer(ShrinkerType), 2143 %% negate the property result around for ?NOT_EXISTS 2144 {Type, fun (X) -> not Prop(X) end}; 2145skip_to_next({forall,RawType,Prop}) -> 2146 Type = proper_types:cook_outer(RawType), 2147 {Type, Prop}; 2148skip_to_next({conjunction,SubProps}) -> 2149 SubProps; 2150skip_to_next({implies,Pre,Prop}) -> 2151 case Pre of 2152 true -> force_skip(Prop); 2153 false -> true 2154 end; 2155skip_to_next({sample,_Sample,_Printer,Prop}) -> 2156 skip_to_next(Prop); 2157skip_to_next({whenfail,_Action,Prop}) -> 2158 force_skip(Prop); 2159%% The following 2 clauses assume that _Prop cannot contain any other wrappers. 2160skip_to_next({trapexit,_Prop}) -> 2161 false; 2162skip_to_next({timeout,_Limit,_Prop}) -> 2163 false; 2164skip_to_next(_Other) -> 2165 throw(non_boolean_result). 2166 2167-spec force_skip(delayed_test()) -> stripped_test(). 2168force_skip(Prop) -> 2169 apply_skip([], Prop). 2170 2171-spec force_skip(proper_gen:instance(), dependent_test()) -> stripped_test(). 2172force_skip(Arg, Prop) -> 2173 apply_skip([proper_symb:internal_eval(Arg)], Prop). 2174 2175-spec apply_skip([proper_gen:instance()], lazy_test()) -> stripped_test(). 2176apply_skip(Args, Prop) -> 2177 try 2178 apply(Prop, Args) 2179 of 2180 InnerTest -> skip_to_next(InnerTest) 2181 catch 2182 %% Should be OK to catch everything here, since we have already tested 2183 %% at this point that the test still fails. 2184 _ExcKind:_ExcReason -> false 2185 end. 2186 2187 2188%%----------------------------------------------------------------------------- 2189%% Output functions 2190%%----------------------------------------------------------------------------- 2191 2192-spec aggregate_imm_result([pid()], imm_result()) -> imm_result(). 2193aggregate_imm_result([], ImmResult) -> 2194 ImmResult; 2195aggregate_imm_result(WorkerList, #pass{performed = Passed, samples = Samples} = ImmResult) -> 2196 Id = get('$property_id'), 2197 receive 2198 %% if we haven't received anything yet we use the first pass we get 2199 {worker_msg, #pass{} = Received, From, Id} when Passed =:= undefined -> 2200 aggregate_imm_result(WorkerList -- [From], Received); 2201 %% from that moment on, we accumulate the count of passed tests 2202 {worker_msg, #pass{performed = PassedRcvd, samples = SamplesRcvd}, From, Id} -> 2203 NewImmResult = ImmResult#pass{performed = Passed + PassedRcvd, 2204 samples = Samples ++ SamplesRcvd}, 2205 aggregate_imm_result(WorkerList -- [From], NewImmResult); 2206 {worker_msg, #fail{performed = FailedOn} = Received, From, Id} -> 2207 lists:foreach(fun(P) -> 2208 P ! {worker_msg, {failed_test, self()}, Id} 2209 end, WorkerList -- [From]), 2210 Performed = lists:foldl(fun(Worker, Acc) -> 2211 receive 2212 {worker_msg, {performed, undefined, Id}} -> Acc; 2213 {worker_msg, {performed, P, Id}} -> P + Acc; 2214 {worker_msg, #fail{performed = FailedOn2}, Worker, Id} -> FailedOn2 + Acc 2215 end 2216 end, 0, WorkerList -- [From]), 2217 kill_workers(WorkerList), 2218 aggregate_imm_result([], Received#fail{performed = Performed + FailedOn}); 2219 {worker_msg, {error, _Reason} = Error, _From, Id} -> 2220 kill_workers(WorkerList), 2221 aggregate_imm_result([], Error); 2222 {'EXIT', From, _ExcReason} -> 2223 aggregate_imm_result(WorkerList -- [From], ImmResult) 2224 end. 2225 2226-spec report_imm_result(imm_result(), opts()) -> 'ok'. 2227report_imm_result(#pass{samples = Samples, printers = Printers, 2228 performed = Performed}, 2229 #opts{expect_fail = ExpectF, output_fun = Print, 2230 nocolors = NoColors}) -> 2231 case ExpectF of 2232 true -> 2233 ?PRINT(NoColors, ?BOLD_RED, Print, 2234 "Failed: All tests passed when a failure was expected.~n", 2235 []); 2236 false -> 2237 ?PRINT(NoColors, ?BOLD_GREEN, Print, 2238 "OK: Passed ~b test(s).~n", [Performed]) 2239 end, 2240 SortedSamples = [lists:sort(Sample) || Sample <- Samples], 2241 lists:foreach(fun({P,S}) -> apply_stats_printer(P, S, Print) end, 2242 proper_arith:safe_zip(Printers, SortedSamples)); 2243report_imm_result(#fail{reason = Reason, bound = Bound, actions = Actions, 2244 performed = Performed}, 2245 #opts{expect_fail = ExpectF, output_fun = Print, 2246 nocolors = NoColors}) -> 2247 case ExpectF of 2248 true -> 2249 ?PRINT(NoColors, ?BOLD_GREEN, Print, 2250 "OK: Failed as expected, after ~b test(s).~n", [Performed]); 2251 false -> 2252 ?PRINT(NoColors, ?BOLD_RED, Print, 2253 "Failed: After ~b test(s).~n", [Performed]) 2254 end, 2255 report_fail_reason(Reason, "", Print), 2256 print_imm_testcase(Bound, "", Print), 2257 execute_actions(Actions); 2258report_imm_result({error,Reason}, #opts{output_fun = Print}) -> 2259 report_error(Reason, Print). 2260 2261-spec report_rerun_result(run_result(), opts()) -> 'ok'. 2262report_rerun_result(#pass{reason = Reason}, 2263 #opts{expect_fail = ExpectF, output_fun = Print, 2264 nocolors = NoColors}) -> 2265 case ExpectF of 2266 true -> ?PRINT(NoColors, ?BOLD_RED, Print, "Failed: ", []); 2267 false -> ?PRINT(NoColors, ?BOLD_GREEN, Print, "OK: ", []) 2268 end, 2269 case Reason of 2270 true_prop -> Print("The input passed the test.~n", []); 2271 didnt_crash -> Print("The input didn't raise an early exception.~n", []) 2272 end; 2273report_rerun_result(#fail{reason = Reason, actions = Actions}, 2274 #opts{expect_fail = ExpectF, output_fun = Print, 2275 nocolors = NoColors}) -> 2276 case ExpectF of 2277 true -> ?PRINT(NoColors, ?BOLD_GREEN, Print, "OK: ", []); 2278 false -> ?PRINT(NoColors, ?BOLD_RED, Print, "Failed: ", []) 2279 end, 2280 Print("The input fails the test.~n", []), 2281 report_fail_reason(Reason, "", Print), 2282 execute_actions(Actions); 2283report_rerun_result({error,Reason}, #opts{output_fun = Print}) -> 2284 report_error(Reason, Print). 2285 2286%% @private 2287-spec report_error(error_reason(), output_fun()) -> 'ok'. 2288report_error(arity_limit, Print) -> 2289 Print("Error: Couldn't produce a function of the desired arity, please " 2290 "recompile PropEr with an increased value for ?MAX_ARITY.~n", []); 2291report_error({cant_generate,MFAs}, Print) -> 2292 Print("Error: Couldn't produce an instance that satisfies all strict " 2293 "constraints from (~s) after ~b tries.~n", 2294 [mfas_to_string(MFAs),get('$constraint_tries')]); 2295report_error(cant_satisfy, Print) -> 2296 Print("Error: No valid test could be generated.~n", []); 2297report_error(non_boolean_result, Print) -> 2298 Print("Error: The property code returned a non-boolean result.~n", []); 2299report_error(rejected, Print) -> 2300 Print(?MISMATCH_MSG ++ "It failed an ?IMPLIES check.~n", []); 2301report_error(too_many_instances, Print) -> 2302 Print(?MISMATCH_MSG ++ "It's too long.~n", []); %% that's what she said 2303report_error(type_mismatch, Print) -> 2304 Print("Error: The variables' and types' structures inside a ?FORALL don't " 2305 "match.~n", []); 2306report_error(wrong_type, Print) -> 2307 Print("Internal error: 'wrong_type' error reached toplevel.~n" 2308 "Please notify the maintainers about this error.~n", []); 2309report_error({typeserver,SubReason}, Print) -> 2310 Print("Error: The typeserver encountered an error: ~w.~n", [SubReason]); 2311report_error({unexpected,Unexpected}, Print) -> 2312 Print("Internal error: The last run returned an unexpected result:~n~w~n" 2313 "Please notify the maintainers about this error.~n", [Unexpected]); 2314report_error({erroneous_option,UserOpt}, Print) -> 2315 Print("Error: Erroneous option: ~w.~n", [UserOpt]); 2316report_error({unrecognized_option,UserOpt}, Print) -> 2317 Print("Error: Unrecognized option: ~w.~n", [UserOpt]). 2318 2319-spec report_fail_reason(fail_reason(), string(), output_fun()) -> 'ok'. 2320report_fail_reason(false_prop, _Prefix, _Print) -> 2321 ok; 2322report_fail_reason(time_out, Prefix, Print) -> 2323 Print(Prefix ++ "Test execution timed out.~n", []); 2324report_fail_reason({trapped,ExcReason}, Prefix, Print) -> 2325 Print(Prefix ++ "A linked process died with reason ~w.~n", [ExcReason]); 2326report_fail_reason({exception,ExcKind,ExcReason,StackTrace}, Prefix, Print) -> 2327 Print(Prefix ++ "An exception was raised: ~w:~p.~n", [ExcKind,ExcReason]), 2328 Print(Prefix ++ "Stacktrace: ~p.~n", [StackTrace]); 2329report_fail_reason({sub_props,SubReasons}, Prefix, Print) -> 2330 Report = 2331 fun({Tag,Reason}) -> 2332 Print(Prefix ++ "Sub-property ~w failed.~n", [Tag]), 2333 report_fail_reason(Reason, ">> " ++ Prefix, Print) 2334 end, 2335 lists:foreach(Report, SubReasons); 2336report_fail_reason(exists, _Prefix, _Print) -> 2337 ok; 2338 %% Print(Prefix ++ "Found a value that should not exist.~n", []); 2339report_fail_reason(not_found, Prefix, Print) -> 2340 Print(Prefix ++ "Could not find a value that should exist.~n", []). 2341 2342-spec print_imm_testcase(imm_testcase(), string(), output_fun()) -> 'ok'. 2343print_imm_testcase(ImmTestCase, Prefix, Print) -> 2344 ImmCExm = preclean_testcase(ImmTestCase, []), 2345 print_imm_counterexample(ImmCExm, Prefix, Print). 2346 2347-spec print_imm_counterexample(imm_counterexample(), string(), output_fun()) -> 2348 'ok'. 2349print_imm_counterexample(ImmCExm, Prefix, Print) -> 2350 PrintImmCleanInput = fun(I) -> print_imm_clean_input(I, Prefix, Print) end, 2351 lists:foreach(PrintImmCleanInput, ImmCExm). 2352 2353-spec print_imm_clean_input(imm_clean_input(), string(), output_fun()) -> 'ok'. 2354print_imm_clean_input({'$conjunction',SubImmCExms}, Prefix, Print) -> 2355 PrintSubImmCExm = 2356 fun({Tag,ImmCExm}) -> 2357 Print(Prefix ++ "~w:~n", [Tag]), 2358 print_imm_counterexample(ImmCExm, ">> " ++ Prefix, Print) 2359 end, 2360 lists:foreach(PrintSubImmCExm, SubImmCExms); 2361print_imm_clean_input(Instance, Prefix, Print) -> 2362 Print(Prefix ++ "~w~n", [Instance]). 2363 2364-spec execute_actions(fail_actions()) -> 'ok'. 2365execute_actions(Actions) -> 2366 lists:foreach(fun(A) -> ?FORCE(A) end, Actions). 2367 2368-spec report_shrinking(non_neg_integer(), imm_testcase(), fail_actions(), 2369 opts()) -> 'ok'. 2370report_shrinking(NumShrinks, MinImmTestCase, MinActions, Opts) -> 2371 #opts{output_fun = Print, nocolors = NoColors} = Opts, 2372 ?PRINT(NoColors, ?BOLD_BLUE, Print, "(~b time(s))~n", [NumShrinks]), 2373 print_imm_testcase(MinImmTestCase, "", Print), 2374 execute_actions(MinActions). 2375 2376-spec default_strategy_fun() -> strategy_fun(). 2377default_strategy_fun() -> 2378 fun(NumTests,NumWorkers) -> 2379 Decr = case NumTests of 2380 1 -> 0; 2381 _ -> 1 2382 end, 2383 [begin 2384 L2 = lists:seq(X - 1, NumTests - Decr, NumWorkers), 2385 {hd(L2), lists:last(L2)} % {_Start, _NumTests} 2386 end || X <- lists:seq(1, NumWorkers)] 2387 end. 2388 2389%% @private 2390-spec update_worker_node_ref({node(), {already_running, boolean()}}) -> [node()]. 2391update_worker_node_ref(NodeName) -> 2392 NewMap = case get(worker_nodes) of 2393 undefined -> [NodeName]; 2394 Map -> [NodeName|Map] 2395 end, 2396 put(worker_nodes, NewMap). 2397 2398%% @private 2399%% @doc Starts a remote node to ensure the testing will not 2400%% crash the BEAM, and loads on it all the needed code. 2401-spec start_node(node()) -> node(). 2402start_node(SlaveName) -> 2403 [] = os:cmd("epmd -daemon"), 2404 HostName = list_to_atom(net_adm:localhost()), 2405 _ = net_kernel:start([proper_master, shortnames]), 2406 case slave:start_link(HostName, SlaveName) of 2407 {ok, Node} -> 2408 _ = update_worker_node_ref({Node, {already_running, false}}), 2409 Node; 2410 {error, {already_running, Node}} -> 2411 _ = update_worker_node_ref({Node, {already_running, true}}), 2412 Node 2413 end. 2414 2415-spec maybe_start_cover_server([tuple()]) -> {'ok', [node()]} 2416 | {'error', {'already_started', pid()}}. 2417maybe_start_cover_server(NodeList) -> 2418 case os:getenv("COVER") of 2419 false -> {ok, []}; 2420 "true" -> 2421 {Nodes, _} = lists:unzip(NodeList), 2422 cover:start(Nodes) 2423 end. 2424 2425-spec maybe_stop_cover_server([node()]) -> 'ok'. 2426maybe_stop_cover_server(NodeList) -> 2427 case os:getenv("COVER") of 2428 false -> ok; 2429 "true" -> 2430 {Nodes, _} = lists:unzip(NodeList), 2431 cover:stop(Nodes) 2432 end. 2433 2434%% @private 2435-spec maybe_load_binary([node()], module()) -> 'ok' | 'error'. 2436maybe_load_binary(Nodes, Module) -> 2437 %% we check if the module was either preloaded or cover_compiled 2438 %% and in such cases ignore those 2439 case code:is_loaded(Module) of 2440 {file, Loaded} when is_list(Loaded) -> 2441 case code:get_object_code(Module) of 2442 {Module, Binary, Filename} -> 2443 _ = rpc:multicall(Nodes, code, load_binary, [Module, Filename, Binary]), 2444 ok; 2445 error -> error 2446 end; 2447 _ -> ok 2448 end. 2449 2450%% @private 2451-spec ensure_code_loaded([node()]) -> 'ok'. 2452ensure_code_loaded(Nodes) -> 2453 %% get all the files that need to be loaded from the current directory 2454 Files = filelib:wildcard("**/*.beam"), 2455 %% but we only care about the filename, without the .beam extension 2456 Modules = [list_to_atom(filename:basename(File, ".beam")) || File <- Files], 2457 %% ensure that all modules are available on the nodes 2458 lists:foreach(fun(Module) -> maybe_load_binary(Nodes, Module) end, Modules), 2459 lists:foreach(fun(P) -> rpc:multicall(Nodes, code, add_patha, [P]) end, 2460 code:get_path()), 2461 _ = rpc:multicall(Nodes, code, ensure_modules_loaded, [Modules]), 2462 ok. 2463 2464%% @private 2465%% @doc Starts multiple (NumNodes) remote nodes. 2466-spec start_nodes(non_neg_integer()) -> [node()]. 2467start_nodes(NumNodes) -> 2468 [start_node(list_to_atom("proper_slave_" ++ integer_to_list(N))) 2469 || N <- lists:seq(1, NumNodes)]. 2470 2471%% @private 2472%% @doc Stops all the registered (started) nodes. 2473-spec stop_nodes() -> 'ok'. 2474stop_nodes() -> 2475 case get(worker_nodes) of 2476 undefined -> ok; 2477 Nodes -> 2478 StopFun = fun({Node, {already_running, false}}) -> slave:stop(Node); 2479 ({_Node, {already_running, true}}) -> ok 2480 end, 2481 lists:foreach(StopFun, Nodes), 2482 _ = net_kernel:stop(), 2483 erase(worker_nodes), 2484 ok 2485 end. 2486 2487%% @private 2488%% @doc Unlinks and kills all the workers. 2489-spec kill_workers([pid()]) -> ok. 2490kill_workers(WorkerList) -> 2491 lists:foreach(fun(P) -> unlink(P), exit(P, kill) end, WorkerList). 2492 2493%%----------------------------------------------------------------------------- 2494%% Stats printing functions 2495%%----------------------------------------------------------------------------- 2496 2497-spec apply_stats_printer(stats_printer(), sample(), output_fun()) -> 'ok'. 2498apply_stats_printer(Printer, SortedSample, Print) -> 2499 {arity,Arity} = erlang:fun_info(Printer, arity), 2500 case Arity of 2501 1 -> Printer(SortedSample); 2502 2 -> Printer(SortedSample, Print) 2503 end. 2504 2505%% @doc A predefined function that accepts an atom or string and returns a 2506%% stats printing function which is equivalent to the default one, but prints 2507%% the given title `Title' above the statistics. 2508-spec with_title(title()) -> stats_printer(). 2509with_title(Title) -> 2510 fun(S,O) -> plain_stats_printer(S, O, Title) end. 2511 2512-spec plain_stats_printer(sample(), output_fun(), title()) -> 'ok'. 2513plain_stats_printer(SortedSample, Print, Title) -> 2514 print_title(Title, Print), 2515 Total = length(SortedSample), 2516 PrFun = fun ({Cmd,Fr}) -> 2517 %% ensure frequencies are always printed using five characters 2518 case Fr =:= Total of 2519 true -> Print("100.0\% ~w~n", [Cmd]); 2520 false -> Print("~5.2f\% ~w~n", [100 * Fr / Total,Cmd]) 2521 end 2522 end, 2523 lists:foreach(PrFun, process_sorted_sample(SortedSample)). 2524 2525-spec print_title(title(), output_fun()) -> 'ok'. 2526print_title(RawTitle, Print) -> 2527 Print("~n", []), 2528 Title = if 2529 is_atom(RawTitle) -> atom_to_list(RawTitle); 2530 is_list(RawTitle) -> RawTitle 2531 end, 2532 case Title of 2533 "" -> ok; 2534 _ -> Print(Title ++ "~n", []) 2535 end. 2536 2537-spec process_sorted_sample(sample()) -> freq_sample(). 2538process_sorted_sample(SortedSample) -> 2539 Freqs = get_freqs(SortedSample, []), 2540 lists:reverse(lists:keysort(2, Freqs)). 2541 2542-spec get_freqs(sample(), freq_sample()) -> freq_sample(). 2543get_freqs([], Freqs) -> 2544 Freqs; 2545get_freqs([Term | Rest], Freqs) -> 2546 {Freq,Others} = remove_all(Term, 1, Rest), 2547 get_freqs(Others, [{Term,Freq} | Freqs]). 2548 2549-spec remove_all(term(), proper_types:frequency(), sample()) -> 2550 {proper_types:frequency(), sample()}. 2551remove_all(X, Freq, [X | Rest]) -> 2552 remove_all(X, Freq + 1, Rest); 2553remove_all(_X, Freq, Sample) -> 2554 {Freq, Sample}. 2555 2556-spec numeric_with_title(title()) -> stats_printer(). 2557numeric_with_title(Title) -> 2558 fun(S,O) -> num_stats_printer(S, O, Title) end. 2559 2560-spec num_stats_printer([number()], output_fun(), title()) -> 'ok'. 2561num_stats_printer(SortedSample, Print, Title) -> 2562 print_title(Title, Print), 2563 {Min,Avg,Max} = get_numeric_stats(SortedSample), 2564 Print("minimum: ~w~naverage: ~w~nmaximum: ~w~n", [Min,Avg,Max]). 2565 2566-spec get_numeric_stats([]) -> {'undefined', 'undefined', 'undefined'}; 2567 ([number(),...]) -> numeric_stats(). 2568get_numeric_stats([]) -> 2569 {undefined, undefined, undefined}; 2570get_numeric_stats([Min | _Rest] = SortedSample) -> 2571 {Avg, Max} = avg_and_last(SortedSample, 0, 0), 2572 {Min, Avg, Max}. 2573 2574-spec avg_and_last([number(),...], number(), non_neg_integer()) -> 2575 {float(), number()}. 2576avg_and_last([Last], Sum, Len) -> 2577 {(Sum + Last) / (Len + 1), Last}; 2578avg_and_last([X | Rest], Sum, Len) -> 2579 avg_and_last(Rest, Sum + X, Len + 1). 2580 2581-spec mfas_to_string([mfa()]) -> string(). 2582mfas_to_string(MFAs) -> 2583 string:join([mfa_to_string(MFA) || MFA <- MFAs], ", "). 2584 2585-spec mfa_to_string(mfa()) -> string(). 2586mfa_to_string({M, F, A}) -> 2587 io_lib:format("~p:~p/~p", [M, F, A]). 2588