Add shrinking indication parameter

Set's a `shrinking` parameter to `true` when property is being executed
during a shrinking phase. Also sets it to `done` after the shrinking is
done. Useful for adjusting generators during shrinking phase or for
`on_output` printers.

Author: x4lldux

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(),

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)),