diff --git a/include/proper.hrl b/include/proper.hrl index 803408ae..fea058ec 100644 --- a/include/proper.hrl +++ b/include/proper.hrl @@ -47,9 +47,9 @@ %%------------------------------------------------------------------------------ -import(proper_types, [integer/2, float/2, atom/0, binary/0, binary/1, - bitstring/0, bitstring/1, list/1, vector/2, union/1, - weighted_union/1, tuple/1, loose_tuple/1, exactly/1, - fixed_list/1, function/2, map/2, any/0]). + bitstring/0, bitstring/1, list/1, map/1, map/2, map_union/2, + vector/2, union/1, weighted_union/1, tuple/1, loose_tuple/1, + exactly/1, fixed_list/1, fixed_map/1, function/2, any/0]). %%------------------------------------------------------------------------------ diff --git a/src/proper_gen.erl b/src/proper_gen.erl index 6f603917..e283091f 100644 --- a/src/proper_gen.erl +++ b/src/proper_gen.erl @@ -42,8 +42,8 @@ binary_rev/1, binary_len_gen/1, bitstring_gen/1, bitstring_rev/1, bitstring_len_gen/1, list_gen/2, distlist_gen/3, vector_gen/2, union_gen/1, weighted_union_gen/1, tuple_gen/1, loose_tuple_gen/2, - loose_tuple_rev/2, exactly_gen/1, fixed_list_gen/1, function_gen/2, - any_gen/1, native_type_gen/2, safe_weighted_union_gen/1, + loose_tuple_rev/2, exactly_gen/1, fixed_list_gen/1, fixed_map_gen/1, + function_gen/2, any_gen/1, native_type_gen/2, safe_weighted_union_gen/1, safe_union_gen/1]). %% Public API types @@ -344,6 +344,12 @@ clean_instance({'$to_part',ImmInstance}) -> clean_instance(ImmInstance); clean_instance(ImmInstance) when is_list(ImmInstance) -> clean_instance_list(ImmInstance); +clean_instance(ImmInstance) when is_map(ImmInstance) -> + %% maps:map only changes the values, this handles both values and keys + maps:from_list([ + {clean_instance(Key), clean_instance(Value)} + || {Key, Value} <- maps:to_list(ImmInstance) + ]); clean_instance(ImmInstance) when is_tuple(ImmInstance) -> list_to_tuple(clean_instance_list(tuple_to_list(ImmInstance))); clean_instance(ImmInstance) -> ImmInstance. @@ -576,6 +582,15 @@ fixed_list_gen({ProperHead,ImproperTail}) -> fixed_list_gen(ProperFields) -> [generate(F) || F <- ProperFields]. +%% @private +-spec fixed_map_gen(map()) -> imm_instance(). +fixed_map_gen(Map) when is_map(Map) -> + maps:from_list([ + {generate(KeyOrType), generate(ValueOrType)} + || + {KeyOrType, ValueOrType} <- maps:to_list(Map) + ]). + %% @private -spec function_gen(arity(), proper_types:type()) -> function(). function_gen(Arity, RetType) -> diff --git a/src/proper_shrink.erl b/src/proper_shrink.erl index 1d90c2ba..1aa7179b 100644 --- a/src/proper_shrink.erl +++ b/src/proper_shrink.erl @@ -33,6 +33,7 @@ -export([number_shrinker/4, union_first_choice_shrinker/3, union_recursive_shrinker/3]). -export([split_shrinker/3, remove_shrinker/3]). +-export([map_remove_shrinker/3, map_key_shrinker/3, map_value_shrinker/3]). -export_type([state/0, shrinker/0]). @@ -397,6 +398,110 @@ elements_shrinker(Instance, Type, elements_shrinker(Instance, Type, {inner,Indices,GetElemType,{shrunk,N,InnerState}}). +-spec map_remove_shrinker( + proper_gen:imm_instance(), proper_types:type(), state() +) -> {[proper_gen:imm_instance()], state()}. +map_remove_shrinker(Instance, Type, init) when is_map(Instance) -> + GetKeys = proper_types:get_prop(get_keys, Type), + Keys = GetKeys(Instance), + map_remove_shrinker(Instance, Type, {shrunk, 1, {keys, ordsets:new(), Keys}}); +map_remove_shrinker(Instance, _Type, {keys, _Checked, []}) when is_map(Instance) -> + {[], done}; +map_remove_shrinker(Instance, Type, {keys, Checked, [Key | Rest]}) when is_map(Instance) -> + Remove = proper_types:get_prop(remove, Type), + {[Remove(Key, Instance)], {keys, ordsets:add_element(Key, Checked), Rest}}; +map_remove_shrinker(Instance, Type, {shrunk, 1, {keys, Checked, ToCheck}}) when is_map(Instance) -> + %% GetKeys = proper_types:get_prop(get_keys, Type), + %% Keys = ordsets:from_list(GetKeys(Instance)), + %% NewToCheck = ordsets:subtract(Keys, Checked), + map_remove_shrinker(Instance, Type, {keys, Checked, ToCheck}). + +-spec map_value_shrinker( + proper_gen:imm_instance(), proper_types:type(), state() +) -> {[proper_gen:imm_instance()], state()}. +map_value_shrinker(Instance, _Type, init) when map_size(Instance) =:= 0 -> + {[], done}; +map_value_shrinker(Instance, Type, init) when is_map(Instance) -> + GetKeys = proper_types:get_prop(get_keys, Type), + TypeMap = proper_types:get_prop(internal_types, Type), + Keys = GetKeys(Instance), + ValueTypeMap = maps:map(fun(Key, Value) -> + {_KeyType, ValueType} = get_map_field_candidates(Key, Value, TypeMap), + ValueType + end, Instance), + map_value_shrinker(Instance, Type, {inner, Keys, ValueTypeMap, init}); +map_value_shrinker(Instance, _Type, {inner, [], _ValueTypeMap, init}) when is_map(Instance) -> + {[], done}; +map_value_shrinker( + Instance, Type, {inner, [_Key | Rest], ValueTypeMap, done} +) when is_map(Instance) -> + map_value_shrinker(Instance, Type, {inner, Rest, ValueTypeMap, init}); +map_value_shrinker( + Instance, Type, {inner, Keys = [Key | _], ValueTypeMap, InnerState} +) when is_map(Instance) -> + Retrieve = proper_types:get_prop(retrieve, Type), + Update = proper_types:get_prop(update, Type), + Value = Retrieve(Key, Instance), + ValueType = Retrieve(Key, ValueTypeMap), + {NewValues, NewInnerState} = shrink(Value, ValueType, InnerState), + NewInstances = [Update(Key, NewValue, Instance) || NewValue <- NewValues], + {NewInstances, {inner, Keys, ValueTypeMap, NewInnerState}}; +map_value_shrinker( + Instance, Type, {shrunk, N, {inner, ToCheck, ValueTypeMap, InnerState}} +) when is_map(Instance) -> + map_value_shrinker( + Instance, Type, {inner, ToCheck, ValueTypeMap, {shrunk, N, InnerState}} + ). + +-spec map_key_shrinker( + proper_gen:imm_instance(), proper_types:type(), state() +) -> {[proper_gen:imm_instance()], state()}. +map_key_shrinker(Instance, Type, init) when is_map(Instance) -> + GetKeys = proper_types:get_prop(get_keys, Type), + TypeMap = proper_types:get_prop(internal_types, Type), + Keys = GetKeys(Instance), + KeyTypeMap = maps:map(fun(Key, Value) -> + {KeyType, _ValueType} = get_map_field_candidates(Key, Value, TypeMap), + KeyType + end, Instance), + map_key_shrinker(Instance, Type, {inner, Keys, KeyTypeMap, init}); +map_key_shrinker(Instance, _Type, {inner, [], _ValueTypeMap, init}) when is_map(Instance) -> + {[], done}; +map_key_shrinker( + Instance, Type, {inner, [_Key | Rest], KeyTypeMap, done} +) when is_map(Instance) -> + map_key_shrinker(Instance, Type, {inner, Rest, KeyTypeMap, init}); +map_key_shrinker( + Instance, Type, {inner, Keys = [Key | _], KeyTypeMap, InnerState} +) when is_map(Instance) -> + Retrieve = proper_types:get_prop(retrieve, Type), + Update = proper_types:get_prop(update, Type), + Remove = proper_types:get_prop(remove, Type), + Value = Retrieve(Key, Instance), + KeyType = Retrieve(Key, KeyTypeMap), + {NewKeys, NewInnerState} = shrink(Key, KeyType, InnerState), + InstanceWithoutKey = Remove(Key, Instance), + NewInstances = [ + Update(NewKey, Value, InstanceWithoutKey) || NewKey <- NewKeys + ], + {NewInstances, {inner, Keys, KeyTypeMap, NewInnerState}}; +map_key_shrinker( + Instance, Type, {shrunk, N, {inner, ToCheck, KeyTypeMap, InnerState}} +) when is_map(Instance) -> + map_key_shrinker( + Instance, Type, {inner, ToCheck, KeyTypeMap, {shrunk, N, InnerState}} + ). + +get_map_field_candidates(Key, Value, TypeMap) -> + Candidates = maps:filter(fun(KeyType, ValueType) -> + (not proper_types:is_type(Key) andalso Key =:= KeyType + orelse proper_types:is_instance(Key, KeyType)) + andalso + (not proper_types:is_type(Value) andalso Value =:= ValueType + orelse proper_types:is_instance(Value, ValueType)) + end, TypeMap), + {KeyType, ValueType, _} = maps:next(maps:iterator(Candidates)), + {KeyType, ValueType}. %%------------------------------------------------------------------------------ %% Custom shrinkers diff --git a/src/proper_types.erl b/src/proper_types.erl index 676aff22..65683295 100644 --- a/src/proper_types.erl +++ b/src/proper_types.erl @@ -141,14 +141,14 @@ -export([integer/2, float/2, atom/0, binary/0, binary/1, bitstring/0, bitstring/1, list/1, vector/2, union/1, weighted_union/1, tuple/1, - loose_tuple/1, exactly/1, fixed_list/1, function/2, map/0, map/2, - any/0, shrink_list/1, safe_union/1, safe_weighted_union/1]). + loose_tuple/1, exactly/1, fixed_list/1, fixed_map/1, function/2, map/0, + map/1, map/2, any/0, shrink_list/1, safe_union/1, safe_weighted_union/1]). -export([integer/0, non_neg_integer/0, pos_integer/0, neg_integer/0, range/2, float/0, non_neg_float/0, number/0, boolean/0, byte/0, char/0, nil/0, list/0, tuple/0, string/0, wunion/1, term/0, timeout/0, arity/0]). -export([int/0, nat/0, largeint/0, real/0, bool/0, choose/2, elements/1, oneof/1, frequency/1, return/1, default/2, orderedlist/1, function0/1, - function1/1, function2/1, function3/1, function4/1, + function1/1, function2/1, function3/1, function4/1, map_union/1, weighted_default/2]). -export([resize/2, non_empty/1, noshrink/1]). @@ -258,7 +258,7 @@ | {'shrinkers', [proper_shrink:shrinker()]} | {'noshrink', boolean()} | {'internal_type', raw_type()} - | {'internal_types', tuple() | maybe_improper_list(type(),type() | [])} + | {'internal_types', tuple() | map() | maybe_improper_list(type(),type() | [])} %% The items returned by 'remove' must be of this type. | {'get_length', fun((proper_gen:imm_instance()) -> length())} %% If this is a container type, this should return the number of elements @@ -312,6 +312,8 @@ cook_outer(RawType) when is_tuple(RawType) -> tuple(tuple_to_list(RawType)); cook_outer(RawType) when is_list(RawType) -> fixed_list(RawType); %% CAUTION: this must handle improper lists +cook_outer(RawType) when is_map(RawType) -> + fixed_map(RawType); cook_outer(RawType) -> %% default case (integers, floats, atoms, binaries, ...) exactly(RawType). @@ -1113,12 +1115,91 @@ function_is_instance(Type, X) -> %% TODO: what if it's not a function we produced? andalso equal_types(RetType, proper_gen:get_ret_type(X)). +%% @doc A map whose keys and values are defined by the given `Map'. +%% +%% Shrinks towards the empty map. That is, all keys are assumed to be optional. +%% +%% Also written simply as a {@link maps. map}. +-spec map(#{Key::raw_type() => Value::raw_type()}) -> proper_types:type(). +map(Map) when is_map(Map) -> + MapType = fixed_map(Map), + Shrinkers = get_prop(shrinkers, MapType), + add_props([ + {remove,fun maps:remove/2}, + {shrinkers, [ + fun proper_shrink:map_remove_shrinker/3, + fun proper_shrink:map_key_shrinker/3 + | Shrinkers + ]} + ], MapType). + %% @doc A map whose keys are defined by the generator `K' and values %% by the generator `V'. -spec map(K::raw_type(), V::raw_type()) -> proper_types:type(). map(K, V) -> ?LET(L, list({K, V}), maps:from_list(L)). +%% @doc A map merged from the given map generators. +-spec map_union([Map::raw_type()]) -> proper_types:type(). +map_union(RawMaps) when is_list(RawMaps) -> + ?LET(Maps, RawMaps, lists:foldl(fun maps:merge/2, #{}, Maps)). + +%% @doc A map whose keys and values are defined by the given `Map'. +%% Also written simply as a {@link maps. map}. +-spec fixed_map(#{Key::raw_type() => Value::raw_type()}) -> proper_types:type(). +fixed_map(Map) when is_map(Map) -> + WithValueTypes = maps:map(fun(_Key, Value) -> cook_outer(Value) end, Map), + ?CONTAINER([ + {generator, {typed, fun map_gen/1}}, + {is_instance, {typed, fun map_is_instance/2}}, + {shrinkers, [ + fun proper_shrink:map_value_shrinker/3 + ]}, + {internal_types, WithValueTypes}, + {get_length, fun maps:size/1}, + {join, fun maps:merge/2}, + {get_keys, fun maps:keys/1}, + {retrieve, fun maps:get/2}, + {update, fun maps:put/3} + ]). + +map_gen(Type) -> + Map = get_prop(internal_types, Type), + proper_gen:fixed_map_gen(Map). + +map_is_instance(Type, X) when is_map(X) -> + Map = get_prop(internal_types, Type), + map_all( + fun (Key, ValueType) when is_map_key(Key, X) -> + is_instance(maps:get(Key, X), ValueType); + (KeyOrType, ValueType) -> + case is_raw_type(KeyOrType) of + true -> + map_all(fun(Key, Value) -> + case is_instance(Key, KeyOrType) of + true -> is_instance(Value, ValueType); + false -> true %% Ignore other keys + end + end, X); + false -> + %% The key not a type and not in `X' + false + end + end, + Map + ); +map_is_instance(_Type, _X) -> + false. + +map_all(Fun, Map) when is_function(Fun, 2) andalso is_map(Map) -> + map_all_internal(Fun, maps:next(maps:iterator(Map)), true). + +map_all_internal(Fun, _, false) when is_function(Fun, 2) -> + false; +map_all_internal(Fun, none, Result) when is_function(Fun, 2) andalso is_boolean(Result) -> + Result; +map_all_internal(Fun, {Key, Value, NextIterator}, true) when is_function(Fun, 2) -> + map_all_internal(Fun, NextIterator, Fun(Key, Value)). %% @doc All Erlang terms (that PropEr can produce). For reasons of efficiency, %% functions are never produced as instances of this type.
diff --git a/src/proper_typeserver.erl b/src/proper_typeserver.erl index c5ea8112..120f6936 100644 --- a/src/proper_typeserver.erl +++ b/src/proper_typeserver.erl @@ -1648,6 +1648,8 @@ convert(_Mod, {type,_,nonempty_string,[]}, State, _Stack, _VarDict) -> {ok, {simple,proper_types:non_empty(proper_types:string())}, State}; convert(_Mod, {type,_,map,any}, State, _Stack, _VarDict) -> {ok, {simple,proper_types:map()}, State}; +convert(Mod, {type,_,map,Fields}, State, Stack, VarDict) -> + convert_map(Mod, Fields, State, Stack, VarDict); convert(_Mod, {type,_,tuple,any}, State, _Stack, _VarDict) -> {ok, {simple,proper_types:tuple()}, State}; convert(Mod, {type,_,tuple,ElemForms}, State, Stack, VarDict) -> @@ -1787,6 +1789,57 @@ convert_normal_rec_list(RecFun, RecArgs, NonEmpty) -> NewRecArgs = clean_rec_args(RecArgs), {NewRecFun, NewRecArgs}. +-spec convert_map(mod_name(), [Field], state(), stack(), var_dict()) -> + rich_result2(ret_type(), state()) +when + Field :: {type, erl_anno:anno(), map_field_assoc, [abs_type()]} + | {type, erl_anno:anno(), map_field_exact, [abs_type()]}. +convert_map(Mod, Fields, State1, Stack, VarDict) -> + {AbstractRequiredFields, AbstractOptionalFields} = lists:partition( + fun ({type, _, map_field_exact, _FieldType}) -> + true; + ({type, _, map_field_assoc, _FieldType}) -> + false + end, + Fields + ), + case process_map_fields(Mod, AbstractRequiredFields, State1, Stack, VarDict) of + {ok, RequiredFields, State2} -> + case process_map_fields(Mod, AbstractOptionalFields, State2, Stack, VarDict) of + {ok, OptionalFields, State3} -> + Required = proper_types:fixed_map(maps:from_list(RequiredFields)), + Optional = proper_types:map(maps:from_list(OptionalFields)), + {ok, {simple, proper_types:map_union([Required, Optional])}, State3}; + {error, Reason} -> + {error, Reason} + end; + {error, Reason} -> + {error, Reason} + end. + +process_map_fields(Mod, AbstractFields, State, Stack, VarDict) -> + Process = + fun ({type, _, _, RawFieldTypes}, {ok, Fields, State1}) when + length(RawFieldTypes) =:= 2 + -> + case process_list( + Mod, RawFieldTypes, State1, [map | Stack], VarDict + ) of + {ok, FieldTypes, State2} -> + {ok, [list_to_tuple(FieldTypes) | Fields], State2}; + {error, Reason} -> + {error, Reason} + end; + (_FieldTypes, {error, Reason}) -> + {error, Reason} + end, + case lists:foldl(Process, {ok, [], State}, AbstractFields) of + {ok, ReverseFields, NewState} -> + {ok, lists:reverse(ReverseFields), NewState}; + {error, Reason} -> + {error, Reason} + end. + -spec convert_tuple(mod_name(), [abs_type()], boolean(), state(), stack(), var_dict()) -> rich_result2(ret_type(),state()). convert_tuple(Mod, ElemForms, ToList, State, Stack, VarDict) -> diff --git a/test/proper_exported_types_test.erl b/test/proper_exported_types_test.erl index 7b7e801b..e90bc27f 100644 --- a/test/proper_exported_types_test.erl +++ b/test/proper_exported_types_test.erl @@ -40,9 +40,6 @@ %% %% Still, the test is currently not 100% there. %% TODOs: -%% - Eliminate the 12 errors that `proper_typeserver:demo_translate_type/2` -%% currently returns. (Three of these errors are due to the incomplete -%% handling of maps.) %% - Handle symbolic instances (the {'$call', ...} case below). %% diff --git a/test/proper_tests.erl b/test/proper_tests.erl index 6960872c..f6691135 100644 --- a/test/proper_tests.erl +++ b/test/proper_tests.erl @@ -410,6 +410,11 @@ simple_types_with_data() -> {[], [[]], [], [[a],[1,2,3]], "[]"}, {fixed_list([neg_integer(),pos_integer()]), [[-12,32],[-1,1]], [-1,1], [[0,0]], none}, + {map(#{key => value, pos_integer() => neg_integer()}), + [#{key => value, 1 => -1}], #{}, [not_a_map], none}, + {fixed_map(#{key => value, some_number => neg_integer()}), + [#{key => value, some_number => -3}], #{key => value, some_number => -1}, + [not_a_map], none}, {[atom(),integer(),atom(),float()], [[forty_two,42,forty_two,42.0]], ['',0,'',0.0], [[proper,is,licensed],[under,the,gpl]], none}, {[42 | list(integer())], [[42],[42,44,22]], [42], [[],[11,12]], none}, @@ -773,7 +778,7 @@ cant_generate_test_() -> [?_test(assert_cant_generate(Type)) || Type <- impossible_types()]. proper_exported_types_test_() -> - [?_assertEqual({[],12}, proper_exported_types_test:not_handled())]. + [?_assertEqual({[],0}, proper_exported_types_test:not_handled())]. %%------------------------------------------------------------------------------ %% Verify that failing constraints are correctly reported