diff --git a/src/proper.erl b/src/proper.erl index 315c89c9..3161488b 100644 --- a/src/proper.erl +++ b/src/proper.erl @@ -581,6 +581,7 @@ -type short_module_result() :: [mfa()] | error(). -type module_result() :: long_module_result() | short_module_result(). -type shrinking_result() :: {non_neg_integer(),imm_testcase()}. +-type shrinking_states() :: 'false' | 'true' | 'done'. %%----------------------------------------------------------------------------- %% State handling functions @@ -1701,11 +1702,23 @@ finalize_input(Instance) -> %% Shrinking functions %%----------------------------------------------------------------------------- +-spec set_shrinking_param(shrinking_states()) -> ok. +set_shrinking_param(Val) -> + OldParams = erlang:get('$parameters'), + case OldParams of + undefined -> + erlang:put('$parameters', [{shrinking, Val}]); + _ -> + erlang:put('$parameters', [{shrinking, Val} | OldParams]) + end, + ok. + -spec shrink(imm_testcase(), test(), fail_reason(), opts()) -> {'ok',imm_testcase()} | error(). shrink(ImmTestCase, Test, Reason, #opts{expect_fail = false, noshrink = false, max_shrinks = MaxShrinks, output_fun = Print, nocolors = NoColors} = Opts) -> + set_shrinking_param(true), % needs to be set before printing case NoColors of true -> Print("~nShrinking ", []); @@ -1719,27 +1732,32 @@ shrink(ImmTestCase, Test, Reason, {Shrinks,MinImmTestCase} -> case rerun(Test, true, MinImmTestCase) of #fail{actions = MinActions} -> - report_shrinking(Shrinks, MinImmTestCase, MinActions, - Print, NoColors), + set_shrinking_param(done), + report_shrinking(Shrinks, MinImmTestCase, MinActions, + Print, NoColors), {ok, MinImmTestCase}; %% The cases below should never occur for deterministic tests. %% When they do happen, we have no choice but to silently %% skip the fail actions. #pass{} -> - report_shrinking(Shrinks, MinImmTestCase, [], Print, - NoColors), + set_shrinking_param(done), + report_shrinking(Shrinks, MinImmTestCase, [], Print, + NoColors), {ok, MinImmTestCase}; {error,_Reason} -> - report_shrinking(Shrinks, MinImmTestCase, [], Print, - NoColors), + set_shrinking_param(done), + report_shrinking(Shrinks, MinImmTestCase, [], Print, + NoColors), {ok, MinImmTestCase} end catch throw:non_boolean_result -> + set_shrinking_param(done), Print("~n", []), {error, non_boolean_result} end; shrink(ImmTestCase, _Test, _Reason, _Opts) -> + set_shrinking_param(done), {ok, ImmTestCase}. -spec fix_shrink(imm_testcase(), stripped_test(), fail_reason(), diff --git a/test/proper_tests.erl b/test/proper_tests.erl index 44429f95..654b538e 100644 --- a/test/proper_tests.erl +++ b/test/proper_tests.erl @@ -898,6 +898,26 @@ native_type_props_test_() -> -record(untyped, {a, b = 12}). -type untyped() :: #untyped{}. +shrinking_param_phases_test_() -> + ?_test(begin + ?assertMatch( + false, + proper:quickcheck( + ?FORALL(_, 1, false), + [{numtests, 1}, + {on_output, + fun(_,_) -> + S = proper_types:parameter(shrinking, false), + put({shrink_phase_mark, S}, true) + end}])), + ?assertEqual(true, get({shrink_phase_mark, false})), + ?assertEqual(true, get({shrink_phase_mark, true})), + ?assertEqual(true, get({shrink_phase_mark, done})), + [erase({shrink_phase_mark, P}) || P <- [false, true, done]], + proper:clean_garbage(), + ?assert(state_is_clean()) + end). + true_props_test_() -> [?_passes(?FORALL(X,integer(),X < X + 1)), ?_passes(?FORALL(A,atom(),list_to_atom(atom_to_list(A)) =:= A)),