Add noshrink/1
diff --git a/include/triq.hrl b/include/triq.hrl
index fe09a4e..e611c6d 100644
--- a/include/triq.hrl
+++ b/include/triq.hrl
@@ -93,6 +93,7 @@
bitstring/1,
non_empty/1,
resize/2,
+ noshrink/1,
non_neg_integer/0,
pos_integer/0,
diff --git a/src/triq.erl b/src/triq.erl
index 3d23d74..ede5e9e 100644
--- a/src/triq.erl
+++ b/src/triq.erl
@@ -22,7 +22,7 @@
%%
%% For each ?FORALL, we try to shrink the value
-%% this many iterations.
+%% this many iterations (if it is shrinkable).
%%
-define(SHRINK_COUNT, 1000).
@@ -66,6 +66,14 @@
{ok, triq_rnd} = triq_rand_compat:init("triq_rnd"),
ok.
+shrink_count(Domain) ->
+ case triq_dom:is_shrinkable(Domain) of
+ true ->
+ ?SHRINK_COUNT;
+ false ->
+ 0
+ end.
+
check_input(Fun,Input,IDom,#triq{count=Count}=QCT) ->
try Fun(Input) of
true ->
@@ -372,7 +380,7 @@
%% Run the shrinking function
%%
- Simp = shrink_loop(Fun,Input,InputDom,?SHRINK_COUNT,tl(Context)),
+ Simp = shrink_loop(Fun,Input,InputDom,shrink_count(InputDom),tl(Context)),
%%
%% Compute the counter example
@@ -408,7 +416,7 @@
%% ?FORALL smaller; after trying the outer.
%%
shrink_deeper(Input,[{_,F1,I1,G1}|T]) ->
- [Input | shrink_loop(F1,I1,G1,?SHRINK_COUNT,T)];
+ [Input | shrink_loop(F1,I1,G1,shrink_count(G1),T)];
shrink_deeper(Input,[]) -> [Input].
diff --git a/src/triq_dom.erl b/src/triq_dom.erl
index 455629f..e74a3a2 100644
--- a/src/triq_dom.erl
+++ b/src/triq_dom.erl
@@ -88,7 +88,8 @@
{kind :: atom() | tuple(),
pick = fun error_pick/2 :: pick_fun(T),
shrink = fun error_shrink/2 :: shrink_fun(T),
- empty_ok = true :: boolean()
+ empty_ok = true :: boolean(),
+ noshrink = false :: boolean()
}).
@@ -102,6 +103,7 @@
-record(resize,{size, dom}).
-record(bind, {dom, body}).
-record(sized, {body}).
+-record(noshrink, {dom}).
-record(suchthat,{dom,pred}).
-record(bound_domain,{dom1,val1,dom2,fun2,size}).
-record(choose,{min,max}).
@@ -138,6 +140,7 @@
bitstring/1,
non_empty/1,
resize/2,
+ noshrink/1,
non_neg_integer/0,
pos_integer/0]).
@@ -154,6 +157,7 @@
%% using a generator
-export([bind/2,
bindshrink/2,
+ is_shrinkable/1,
suchthat/2,
pick/2,
shrink/2,
@@ -266,6 +270,8 @@
%%
%% @spec shrink(Domain::domain(T),Value::T) -> {domain(T), T}
-spec shrink(domain(T),T) -> {domain(T), T}.
+shrink(Dom=#?DOM{noshrink=true}, Value) ->
+ {Dom, Value};
shrink(Domain=#?DOM{shrink=SFun}, Value) ->
SFun(Domain,Value);
shrink(TupDom,Tup) when is_tuple(TupDom),
@@ -939,6 +945,14 @@
Dom#?DOM{empty_ok=false}.
+%% @doc Tell whether the domain can possibly be shrinked.
+%% @private
+-spec is_shrinkable(domain(_)) -> boolean().
+is_shrinkable(#?DOM{noshrink=true}) ->
+ false;
+is_shrinkable(_) ->
+ true.
+
%% @doc Support function for the `?LET(Vars,Dom1,Dom2)' macro.
%% @private
%% @spec bind(domain(T), fun( (T) -> domain(D) )) -> domain(D)
@@ -1144,8 +1158,8 @@
-spec return(Value::Type) -> domain(Type).
return(Val) ->
domain(return,
- fun(Self,_) -> {Self,Val} end,
- fun(Self,_) -> {Self,Val} end).
+ fun(Self,_) -> {noshrink(Self),Val} end,
+ fun error_shrink/2).
%% @doc Support function for the ?SIZED macro.
%% @spec sized( fun((integer()) -> domain(T)) ) -> domain(T)
@@ -1162,6 +1176,17 @@
end
}.
+noshrink_pick(#?DOM{kind=#noshrink{dom=InnerDom}}, Size) ->
+ {Dom, Val} = pick(InnerDom, Size),
+ {noshrink(Dom), Val}.
+
+-spec noshrink(domain(T)) -> domain(T).
+noshrink(Dom) ->
+ #?DOM{
+ kind=#noshrink{dom=Dom},
+ pick=fun noshrink_pick/2,
+ noshrink=true}.
+
-spec choose(M::integer(), N::integer()) -> domrec(integer()).
choose(M,N) when is_integer(M), is_integer(N), M=<N ->
#?DOM{kind={choose,M,N},
diff --git a/test/triq_tests.erl b/test/triq_tests.erl
index 832ca9c..18fbdf9 100644
--- a/test/triq_tests.erl
+++ b/test/triq_tests.erl
@@ -247,6 +247,17 @@
X > 1),
false))).
+noshrink_test() ->
+ noshrink_test(100).
+
+noshrink_test(0) ->
+ true;
+noshrink_test(Size) ->
+ {Dom, Val} = triq_dom:pick(triq_dom:noshrink(any()), Size),
+ {ShrinkedDom, ShrinkedVal} = triq_dom:shrink(Dom, Val),
+ ?assertEqual({ShrinkedDom, ShrinkedVal}, {Dom, Val}),
+ noshrink_test(Size - 1).
+
%%
%% Test passing counterexamples to properties
%%
