fixed bug in proper_types:with_parameters/2

src/proper.erl

@@ -290,6 +290,7 @@ global_state_erase() ->
     erase('$constraint_tries'),
     erase('$left'),
     erase('$size'),
+    erase('$parameters'),
     ok.
 
 -spec spawn_link_migrate(fun(() -> _)) -> pid().

src/proper_types.erl

@@ -230,6 +230,11 @@ add_props(PropList, {'$type',OldProps}) ->
 append_to_prop(PropName, Value, {'$type',Props}) ->
     {'$type',orddict:append(PropName, Value, Props)}.
 
+-spec append_list_to_prop(type_prop_name(), [type_prop_value()],
+			  proper_types:type()) -> proper_types:type().
+append_list_to_prop(PropName, List, {'$type',Props}) ->
+    {'$type',orddict:append_list(PropName, List, Props)}.
+
 %% @private
 -spec get_prop(type_prop_name(), proper_types:type()) -> type_prop_value().
 get_prop(PropName, {'$type',Props}) ->
@@ -897,12 +902,18 @@ noshrink(RawType) ->
     add_prop(noshrink, true, cook_outer(RawType)).
 
 -spec with_parameter(atom(), value(), raw_type()) -> proper_types:type().
-with_parameter(Param, Value, Type_gen) ->
-    add_prop(parameters, [{Param,Value}], cook_outer((Type_gen))).
+with_parameter(Param, Value, RawType) ->
+    with_parameters([{Param,Value}], RawType).
 
 -spec with_parameters([{atom(),value()}], raw_type()) -> proper_types:type().
-with_parameters(PVlist, Type_gen) ->
-    add_prop(parameters, PVlist, cook_outer((Type_gen))).
+with_parameters(PVlist, RawType) ->
+    Type = cook_outer(RawType),
+    case find_prop(parameters, Type) of
+	{ok,Params} when is_list(Params) ->
+	    append_list_to_prop(parameters, PVlist, Type);
+	error ->
+	    add_prop(parameters, PVlist, Type)
+    end.
 
 -spec parameter(atom()) -> value().
 parameter(Param) ->

test/proper_tests.erl

@@ -908,6 +908,14 @@ adts_test_() ->
 	     {boolean(),dict(boolean(),integer())},
 	     dict:erase(X, dict:store(X,42,D)) =:= D))].
 
+parameter_test_() ->
+    ?_passes(?FORALL(List, [zero1(),zero2(),zero3(),zero4()],
+		     begin
+			 [?assertMatch(undefined, proper_types:parameter(P))
+			  || P <- [x1,x2,y2,x3,y3,x4,y4,v,w,z]],
+			 lists:all(fun is_zero/1, List)
+		     end)).
+
 zip_test_() ->
     [?_assertEqual(proper_statem:zip(X, Y), Expected)
      || {X,Y,Expected} <- lists_to_zip()].
@@ -938,6 +946,13 @@ can_generate_commands0_test_() ->
     [?_test(assert_can_generate(proper_statem:commands(Module),true))
      || Module <- [pdict_statem]].
 
+can_generate_with_parameters_test_() ->
+    {timeout, 10,
+     [?_test(assert_can_generate(
+	       proper_types:with_parameters(
+		 [{table_type,set}], proper_statem:commands(Module)),true))
+      || Module <- [ets_statem]]}.
+
 can_generate_commands1_test_() ->
     [?_test(assert_can_generate(proper_statem:commands(Module, StartState), true))
      || {Module,StartState} <- [{pdict_statem,[{a,1},{b,1},{c,100}]}]].
@@ -1034,6 +1049,8 @@ equal_ignoring_chars([Char1|Rest1] = Str1, [Char2|Rest2] = Str2, Ignore) ->
 smaller_lengths_than_my_own(L) ->
     lists:seq(0,length(L)).
 
+is_zero(X) -> X =:= 0.
+
 
 %%------------------------------------------------------------------------------
 %% Functions to test
@@ -1168,6 +1185,36 @@ gen_tree(ElemType, Size) ->
 -type k() :: 'null' | {'tag',[{k(),k()}]}.
 -type l() :: 'null' | {'tag',l(),[l(),...]}.
 
+zero1() ->
+    proper_types:with_parameter(
+      x1, 0, ?SUCHTHAT(I, range(-2, 2), I =:= proper_types:parameter(x1))).
+
+zero2() ->
+    proper_types:with_parameters(
+      [{x2,41}],
+      ?LET(X,
+	   proper_types:with_parameter(
+	     y2, 43,
+	     ?SUCHTHAT(
+		I, range(40, 45),
+		I > proper_types:parameter(x2)
+		andalso I < proper_types:parameter(y2))),
+	   X - 42)).
+
+zero3() ->
+    ?SUCHTHAT(I, range(-2, 2),
+	      I > proper_types:parameter(x3, -1)
+	      andalso I < proper_types:parameter(y3, 1)).
+
+zero4() ->
+    proper_types:with_parameters(
+      [{x4,-2}, {y4,2}],
+      proper_types:with_parameters(
+	[{x4,-1}, {y4,1}],
+	?SUCHTHAT(I, range(-2, 2),
+		  I > proper_types:parameter(x4)
+		  andalso I < proper_types:parameter(y4)))).
+
 
 %%------------------------------------------------------------------------------
 %% Old Tests and datatypes