%%% Copyright 2010-2013 Manolis Papadakis , %%% Eirini Arvaniti %%% and Kostis Sagonas %%% %%% This file is part of PropEr. %%% %%% PropEr is free software: you can redistribute it and/or modify %%% it under the terms of the GNU General Public License as published by %%% the Free Software Foundation, either version 3 of the License, or %%% (at your option) any later version. %%% %%% PropEr is distributed in the hope that it will be useful, %%% but WITHOUT ANY WARRANTY; without even the implied warranty of %%% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the %%% GNU General Public License for more details. %%% %%% You should have received a copy of the GNU General Public License %%% along with PropEr. If not, see . %%% @copyright 2010-2013 Manolis Papadakis, Eirini Arvaniti and Kostis Sagonas %%% @version {@version} %%% @author Manolis Papadakis %%% @doc Generator subsystem and generators for basic types. %%% %%% You can use these functions to try out the random %%% instance generation and shrinking subsystems. %%% %%% CAUTION: These functions should never be used inside properties. They are %%% meant for demonstration purposes only. -module(proper_gen). -export([pick/1, pick/2, pick/3, sample/1, sample/3, sampleshrink/1, sampleshrink/2]). -export([safe_generate/1]). -export([generate/1, normal_gen/1, alt_gens/1, clean_instance/1, get_ret_type/1]). -export([integer_gen/3, float_gen/3, atom_gen/1, atom_rev/1, binary_gen/1, 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, safe_union_gen/1]). -export_type([instance/0, imm_instance/0, sized_generator/0, nosize_generator/0, generator/0, reverse_gen/0, combine_fun/0, alt_gens/0]). -include("proper_internal.hrl"). %%----------------------------------------------------------------------------- %% Types %%----------------------------------------------------------------------------- %% TODO: update imm_instance() when adding more types: be careful when reading %% anything that returns it %% @private_type -type imm_instance() :: proper_types:raw_type() | instance() | {'$used', imm_instance(), imm_instance()} | {'$to_part', imm_instance()}. -type instance() :: term(). %% A value produced by the random instance generator. -type error_reason() :: 'arity_limit' | 'cant_generate' | {'typeserver',term()}. %% @private_type -type sized_generator() :: fun((size()) -> imm_instance()). %% @private_type -type typed_sized_generator() :: {'typed', fun((proper_types:type(),size()) -> imm_instance())}. %% @private_type -type nosize_generator() :: fun(() -> imm_instance()). %% @private_type -type typed_nosize_generator() :: {'typed', fun((proper_types:type()) -> imm_instance())}. %% @private_type -type generator() :: sized_generator() | typed_sized_generator() | nosize_generator() | typed_nosize_generator(). %% @private_type -type plain_reverse_gen() :: fun((instance()) -> imm_instance()). %% @private_type -type typed_reverse_gen() :: {'typed', fun((proper_types:type(),instance()) -> imm_instance())}. %% @private_type -type reverse_gen() :: plain_reverse_gen() | typed_reverse_gen(). %% @private_type -type combine_fun() :: fun((instance()) -> imm_instance()). %% @private_type -type alt_gens() :: fun(() -> [imm_instance()]). %% @private_type -type fun_seed() :: {non_neg_integer(),non_neg_integer()}. %%----------------------------------------------------------------------------- %% Instance generation functions %%----------------------------------------------------------------------------- %% @private -spec safe_generate(proper_types:raw_type()) -> {'ok',imm_instance()} | {'error',error_reason()}. safe_generate(RawType) -> try generate(RawType) of ImmInstance -> {ok, ImmInstance} catch throw:'$arity_limit' -> {error, arity_limit}; throw:'$cant_generate' -> {error, cant_generate}; throw:{'$typeserver',SubReason} -> {error, {typeserver,SubReason}} end. %% @private -spec generate(proper_types:raw_type()) -> imm_instance(). generate(RawType) -> Type = proper_types:cook_outer(RawType), ok = add_parameters(Type), Instance = generate(Type, get('$constraint_tries'), none), ok = remove_parameters(Type), Instance. -spec add_parameters(proper_types:type()) -> 'ok'. add_parameters(Type) -> case proper_types:find_prop(parameters, Type) of {ok, Params} -> OldParams = erlang:get('$parameters'), case OldParams of undefined -> erlang:put('$parameters', Params); _ -> erlang:put('$parameters', Params ++ OldParams) end, ok; _ -> ok end. -spec remove_parameters(proper_types:type()) -> 'ok'. remove_parameters(Type) -> case proper_types:find_prop(parameters, Type) of {ok, Params} -> AllParams = erlang:get('$parameters'), case AllParams of Params-> erlang:erase('$parameters'); _ -> erlang:put('$parameters', AllParams -- Params) end, ok; _ -> ok end. -spec generate(proper_types:type(), non_neg_integer(), 'none' | {'ok',imm_instance()}) -> imm_instance(). generate(_Type, 0, none) -> throw('$cant_generate'); generate(_Type, 0, {ok,Fallback}) -> Fallback; generate(Type, TriesLeft, Fallback) -> ImmInstance = case proper_types:get_prop(kind, Type) of constructed -> PartsType = proper_types:get_prop(parts_type, Type), Combine = proper_types:get_prop(combine, Type), ImmParts = generate(PartsType), Parts = clean_instance(ImmParts), ImmInstance1 = Combine(Parts), %% TODO: We can just generate the internal type: if it's not %% a type, it will turn into an exactly. ImmInstance2 = case proper_types:is_raw_type(ImmInstance1) of true -> generate(ImmInstance1); false -> ImmInstance1 end, {'$used',ImmParts,ImmInstance2}; _ -> ImmInstance1 = normal_gen(Type), case proper_types:is_raw_type(ImmInstance1) of true -> generate(ImmInstance1); false -> ImmInstance1 end end, case proper_types:satisfies_all(clean_instance(ImmInstance), Type) of {_,true} -> ImmInstance; {true,false} -> generate(Type, TriesLeft - 1, {ok,ImmInstance}); {false,false} -> generate(Type, TriesLeft - 1, Fallback) end. %% @equiv pick(Type, 10) -spec pick(Type::proper_types:raw_type()) -> {'ok',instance()} | 'error'. pick(RawType) -> pick(RawType, 10). %% @equiv pick(Type, Size, now()) -spec pick(Type::proper_types:raw_type(), size()) -> {'ok', instance()} | 'error'. pick(RawType, Size) -> pick(RawType, Size, now()). %% @doc Generates a random instance of `Type', of size `Size' with seed `Seed'. -spec pick(Type::proper_types:raw_type(), size(), seed()) -> {'ok',instance()} | 'error'. pick(RawType, Size, Seed) -> proper:global_state_init_size_seed(Size, Seed), case clean_instance(safe_generate(RawType)) of {ok,Instance} = Result -> Msg = "WARNING: Some garbage has been left in the process registry " "and the code server~n" "to allow for the returned function(s) to run normally.~n" "Please run proper:global_state_erase() when done.~n", case contains_fun(Instance) of true -> io:format(Msg, []); false -> proper:global_state_erase() end, Result; {error,Reason} -> proper:report_error(Reason, fun io:format/2), proper:global_state_erase(), error end. %% @equiv sample(Type, 10, 20) -spec sample(Type::proper_types:raw_type()) -> 'ok'. sample(RawType) -> sample(RawType, 10, 20). %% @doc Generates and prints one random instance of `Type' for each size from %% `StartSize' up to `EndSize'. -spec sample(Type::proper_types:raw_type(), size(), size()) -> 'ok'. sample(RawType, StartSize, EndSize) when StartSize =< EndSize -> Tests = EndSize - StartSize + 1, Prop = ?FORALL(X, RawType, begin io:format("~p~n",[X]), true end), Opts = [quiet,{start_size,StartSize},{max_size,EndSize},{numtests,Tests}], _ = proper:quickcheck(Prop, Opts), ok. %% @equiv sampleshrink(Type, 10) -spec sampleshrink(Type::proper_types:raw_type()) -> 'ok'. sampleshrink(RawType) -> sampleshrink(RawType, 10). %% @doc Generates a random instance of `Type', of size `Size', then shrinks it %% as far as it goes. The value produced on each step of the shrinking process %% is printed on the screen. -spec sampleshrink(Type::proper_types:raw_type(), size()) -> 'ok'. sampleshrink(RawType, Size) -> proper:global_state_init_size(Size), Type = proper_types:cook_outer(RawType), case safe_generate(Type) of {ok,ImmInstance} -> Shrunk = keep_shrinking(ImmInstance, [], Type), PrintInst = fun(I) -> io:format("~p~n",[clean_instance(I)]) end, lists:foreach(PrintInst, Shrunk); {error,Reason} -> proper:report_error(Reason, fun io:format/2) end, proper:global_state_erase(), ok. -spec keep_shrinking(imm_instance(), [imm_instance()], proper_types:type()) -> [imm_instance(),...]. keep_shrinking(ImmInstance, Acc, Type) -> case proper_shrink:shrink(ImmInstance, Type, init) of {[], _NewState} -> lists:reverse([ImmInstance|Acc]); {[Shrunk|_Rest], _NewState} -> keep_shrinking(Shrunk, [ImmInstance|Acc], Type) end. -spec contains_fun(term()) -> boolean(). contains_fun(List) when is_list(List) -> proper_arith:safe_any(fun contains_fun/1, List); contains_fun(Tuple) when is_tuple(Tuple) -> contains_fun(tuple_to_list(Tuple)); contains_fun(Fun) when is_function(Fun) -> true; contains_fun(_Term) -> false. %%----------------------------------------------------------------------------- %% Utility functions %%----------------------------------------------------------------------------- %% @private -spec normal_gen(proper_types:type()) -> imm_instance(). normal_gen(Type) -> case proper_types:get_prop(generator, Type) of {typed, Gen} -> if is_function(Gen, 1) -> Gen(Type); is_function(Gen, 2) -> Gen(Type, proper:get_size(Type)) end; Gen -> if is_function(Gen, 0) -> Gen(); is_function(Gen, 1) -> Gen(proper:get_size(Type)) end end. %% @private -spec alt_gens(proper_types:type()) -> [imm_instance()]. alt_gens(Type) -> case proper_types:find_prop(alt_gens, Type) of {ok, AltGens} -> ?FORCE(AltGens); error -> [] end. %% @private -spec clean_instance(imm_instance()) -> instance(). clean_instance({'$used',_ImmParts,ImmInstance}) -> clean_instance(ImmInstance); clean_instance({'$to_part',ImmInstance}) -> clean_instance(ImmInstance); clean_instance(ImmInstance) -> if is_list(ImmInstance) -> %% CAUTION: this must handle improper lists proper_arith:safe_map(fun clean_instance/1, ImmInstance); is_tuple(ImmInstance) -> proper_arith:tuple_map(fun clean_instance/1, ImmInstance); true -> ImmInstance end. %%----------------------------------------------------------------------------- %% Basic type generators %%----------------------------------------------------------------------------- %% @private -spec integer_gen(size(), proper_types:extint(), proper_types:extint()) -> integer(). integer_gen(Size, inf, inf) -> proper_arith:rand_int(Size); integer_gen(Size, inf, High) -> High - proper_arith:rand_non_neg_int(Size); integer_gen(Size, Low, inf) -> Low + proper_arith:rand_non_neg_int(Size); integer_gen(Size, Low, High) -> proper_arith:smart_rand_int(Size, Low, High). %% @private -spec float_gen(size(), proper_types:extnum(), proper_types:extnum()) -> float(). float_gen(Size, inf, inf) -> proper_arith:rand_float(Size); float_gen(Size, inf, High) -> High - proper_arith:rand_non_neg_float(Size); float_gen(Size, Low, inf) -> Low + proper_arith:rand_non_neg_float(Size); float_gen(_Size, Low, High) -> proper_arith:rand_float(Low, High). %% @private -spec atom_gen(size()) -> proper_types:type(). %% We make sure we never clash with internal atoms by checking that the first %% character is not '$'. atom_gen(Size) -> ?LET(Str, ?SUCHTHAT(X, proper_types:resize(Size, proper_types:list(proper_types:byte())), X =:= [] orelse hd(X) =/= $$), list_to_atom(Str)). %% @private -spec atom_rev(atom()) -> imm_instance(). atom_rev(Atom) -> {'$used', atom_to_list(Atom), Atom}. %% @private -spec binary_gen(size()) -> proper_types:type(). binary_gen(Size) -> ?LET(Bytes, proper_types:resize(Size, proper_types:list(proper_types:byte())), list_to_binary(Bytes)). %% @private -spec binary_rev(binary()) -> imm_instance(). binary_rev(Binary) -> {'$used', binary_to_list(Binary), Binary}. %% @private -spec binary_len_gen(length()) -> proper_types:type(). binary_len_gen(Len) -> ?LET(Bytes, proper_types:vector(Len, proper_types:byte()), list_to_binary(Bytes)). %% @private -spec bitstring_gen(size()) -> proper_types:type(). bitstring_gen(Size) -> ?LET({BytesHead, NumBits, TailByte}, {proper_types:resize(Size,proper_types:binary()), proper_types:range(0,7), proper_types:range(0,127)}, <>). %% @private -spec bitstring_rev(bitstring()) -> imm_instance(). bitstring_rev(BitString) -> List = bitstring_to_list(BitString), {BytesList, BitsTail} = lists:splitwith(fun erlang:is_integer/1, List), {NumBits, TailByte} = case BitsTail of [] -> {0, 0}; [Bits] -> N = bit_size(Bits), <> = Bits, {N, Byte} end, {'$used', {{'$used',BytesList,list_to_binary(BytesList)}, NumBits, TailByte}, BitString}. %% @private -spec bitstring_len_gen(length()) -> proper_types:type(). bitstring_len_gen(Len) -> BytesLen = Len div 8, BitsLen = Len rem 8, ?LET({BytesHead, NumBits, TailByte}, {proper_types:binary(BytesLen), BitsLen, proper_types:range(0, 1 bsl BitsLen - 1)}, <>). %% @private -spec list_gen(size(), proper_types:type()) -> [imm_instance()]. list_gen(Size, ElemType) -> Len = proper_arith:rand_int(0, Size), vector_gen(Len, ElemType). %% @private -spec distlist_gen(size(), sized_generator(), boolean()) -> [imm_instance()]. distlist_gen(RawSize, Gen, NonEmpty) -> Len = case NonEmpty of true -> proper_arith:rand_int(1, erlang:max(1,RawSize)); false -> proper_arith:rand_int(0, RawSize) end, Size = case Len of 1 -> RawSize - 1; _ -> RawSize end, %% TODO: this produces a lot of types: maybe a simple 'div' is sufficient? Sizes = proper_arith:distribute(Size, Len), InnerTypes = [Gen(S) || S <- Sizes], fixed_list_gen(InnerTypes). %% @private -spec vector_gen(length(), proper_types:type()) -> [imm_instance()]. vector_gen(Len, ElemType) -> vector_gen_tr(Len, ElemType, []). -spec vector_gen_tr(length(), proper_types:type(), [imm_instance()]) -> [imm_instance()]. vector_gen_tr(0, _ElemType, AccList) -> AccList; vector_gen_tr(Left, ElemType, AccList) -> vector_gen_tr(Left - 1, ElemType, [generate(ElemType) | AccList]). %% @private -spec union_gen([proper_types:type(),...]) -> imm_instance(). union_gen(Choices) -> {_Choice,Type} = proper_arith:rand_choose(Choices), generate(Type). %% @private -spec weighted_union_gen([{frequency(),proper_types:type()},...]) -> imm_instance(). weighted_union_gen(FreqChoices) -> {_Choice,Type} = proper_arith:freq_choose(FreqChoices), generate(Type). %% @private -spec safe_union_gen([proper_types:type(),...]) -> imm_instance(). safe_union_gen(Choices) -> {Choice,Type} = proper_arith:rand_choose(Choices), try generate(Type) catch error:_ -> safe_union_gen(proper_arith:list_remove(Choice, Choices)) end. %% @private -spec safe_weighted_union_gen([{frequency(),proper_types:type()},...]) -> imm_instance(). safe_weighted_union_gen(FreqChoices) -> {Choice,Type} = proper_arith:freq_choose(FreqChoices), try generate(Type) catch error:_ -> safe_weighted_union_gen(proper_arith:list_remove(Choice, FreqChoices)) end. %% @private -spec tuple_gen([proper_types:type()]) -> tuple(). tuple_gen(Fields) -> list_to_tuple(fixed_list_gen(Fields)). %% @private -spec loose_tuple_gen(size(), proper_types:type()) -> proper_types:type(). loose_tuple_gen(Size, ElemType) -> ?LET(L, proper_types:resize(Size, proper_types:list(ElemType)), list_to_tuple(L)). %% @private -spec loose_tuple_rev(tuple(), proper_types:type()) -> imm_instance(). loose_tuple_rev(Tuple, ElemType) -> CleanList = tuple_to_list(Tuple), List = case proper_types:find_prop(reverse_gen, ElemType) of {ok,{typed, ReverseGen}} -> [ReverseGen(ElemType,X) || X <- CleanList]; {ok,ReverseGen} -> [ReverseGen(X) || X <- CleanList]; error -> CleanList end, {'$used', List, Tuple}. %% @private -spec exactly_gen(T) -> T. exactly_gen(X) -> X. %% @private -spec fixed_list_gen([proper_types:type()]) -> imm_instance() ; ({[proper_types:type()],proper_types:type()}) -> maybe_improper_list(imm_instance(), imm_instance() | []). fixed_list_gen({ProperHead,ImproperTail}) -> [generate(F) || F <- ProperHead] ++ generate(ImproperTail); fixed_list_gen(ProperFields) -> [generate(F) || F <- ProperFields]. %% @private -spec function_gen(arity(), proper_types:type()) -> function(). function_gen(Arity, RetType) -> FunSeed = {proper_arith:rand_int(0, ?SEED_RANGE - 1), proper_arith:rand_int(0, ?SEED_RANGE - 1)}, create_fun(Arity, RetType, FunSeed). %% @private -spec any_gen(size()) -> imm_instance(). any_gen(Size) -> case get('$any_type') of undefined -> real_any_gen(Size); {type,AnyType} -> generate(proper_types:resize(Size, AnyType)) end. -spec real_any_gen(size()) -> imm_instance(). real_any_gen(0) -> SimpleTypes = [proper_types:integer(), proper_types:float(), proper_types:atom()], union_gen(SimpleTypes); real_any_gen(Size) -> FreqChoices = [{?ANY_SIMPLE_PROB,simple}, {?ANY_BINARY_PROB,binary}, {?ANY_EXPAND_PROB,expand}], case proper_arith:freq_choose(FreqChoices) of {_,simple} -> real_any_gen(0); {_,binary} -> generate(proper_types:resize(Size, proper_types:bitstring())); {_,expand} -> %% TODO: statistics of produced terms? NumElems = proper_arith:rand_int(0, Size - 1), ElemSizes = proper_arith:distribute(Size - 1, NumElems), ElemTypes = [?LAZY(real_any_gen(S)) || S <- ElemSizes], case proper_arith:rand_int(1,2) of 1 -> fixed_list_gen(ElemTypes); 2 -> tuple_gen(ElemTypes) end end. %% @private -spec native_type_gen(mod_name(), string()) -> proper_types:type(). native_type_gen(Mod, TypeStr) -> case proper_typeserver:translate_type({Mod,TypeStr}) of {ok,Type} -> Type; {error,Reason} -> throw({'$typeserver',Reason}) end. %%------------------------------------------------------------------------------ %% Function-generation functions %%------------------------------------------------------------------------------ -spec create_fun(arity(), proper_types:type(), fun_seed()) -> function(). create_fun(Arity, RetType, FunSeed) -> Handler = fun(Args) -> function_body(Args, RetType, FunSeed) end, Err = fun() -> throw('$arity_limit') end, case Arity of 0 -> fun() -> Handler([]) end; _ -> Err() end. %% @private -spec get_ret_type(function()) -> proper_types:type(). get_ret_type(Fun) -> {arity,Arity} = erlang:fun_info(Fun, arity), put('$get_ret_type', true), RetType = apply(Fun, lists:duplicate(Arity,dummy)), erase('$get_ret_type'), RetType. -spec function_body([term()], proper_types:type(), fun_seed()) -> proper_types:type() | instance(). function_body(Args, RetType, {Seed1,Seed2}) -> case get('$get_ret_type') of true -> RetType; _ -> SavedSeed = get(?SEED_NAME), update_seed({Seed1,Seed2,erlang:phash2(Args,?SEED_RANGE)}), Ret = clean_instance(generate(RetType)), put(?SEED_NAME, SavedSeed), proper_symb:internal_eval(Ret) end. -ifdef(USE_SFMT). update_seed(Seed) -> sfmt:seed(Seed). -else. update_seed(Seed) -> put(random_seed, Seed). -endif.