Google Git
Sign in
apache / couchdb-triq / ac18016567c31cb9994760a135c28efa5a42d0c6 / . / src / triq_dom.erl
blob: 6b128d6d095ea5f29794720d38d64d86193cbe7c [file] [log] [blame]
%% -*- erlang-indent-level: 4;indent-tabs-mode: nil -*-
%% ex: ts=4 sw=4 et
%%
%% This file is part of Triq - Trifork QuickCheck
%%
%% Copyright (c) 2010-2013 by Trifork
%% Copyright 2013-2018 Triq authors
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
%% You may obtain a copy of the License at
%%
%% http://www.apache.org/licenses/LICENSE-2.0
%%
%% Unless required by applicable law or agreed to in writing, software
%% distributed under the License is distributed on an "AS IS" BASIS,
%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
%% See the License for the specific language governing permissions and
%% limitations under the License.
-module(triq_dom).
-include_lib("eunit/include/eunit.hrl").
%% the name of te special record for domains
-define(DOM,'@').
-define(DEFAULT_PROP_PREFIX, "prop_").
%% must correspond to the definitions in triq.hrl, but we don't want to
%% include that file.
-define(DELAY(X), fun()->X end).
-define(SIZED(Size,Gen),
sized(fun(Size) -> Gen end)).
%% How many times we try to pick or shrink a value in order to satisfy a
%% ?SUCHTHAT property.
-define(SUCHTHAT_LOOPS,100).
%% how many times we try to shrink a value before we bail out
-define(SHRINK_LOOPS,100).
%% A number large enough to trigger the Erlang bignum implementation
-define(BIGNUM, trunc(math:pow(2, 65) * 2)).
%% @type pick_fun(T). Picks members of the `domain(T)'.
%% Return pair of `{domain(T),T}'; the "output domain" is what will
%% be used for shrinking the value.
-type pick_fun(T) :: fun( (domain(T),integer()) ->
{domain(T),T} | no_return() )
| undefined.
%% @type shrink_fun(T). Shrinks members of the `domain(T)'.
%% Return pair of `{domain(T),T}'; the "output domain" is what will
%% be used for further shrinking the value.
-type shrink_fun(T) :: fun( (domain(T),T) -> {domain(T),T} | no_return() ) | none | undefined.
-type domrec(T) :: {?DOM,
atom() | tuple(),
pick_fun(T),
shrink_fun(T),
boolean()}.
-define(BOX,'@box').
-record(?BOX, {dom :: domain(T), value :: T}).
%%--------------------------------------
%% @doc A box(T) contains a value of type T, along with
%% information needed to shrink T.
%%
%% For example, not all integers shrink the same. If the
%% integer was generated to produce only even numbers for
%% instance, then that knowledge needs to be kept with the
%% value.
%%
%% @end
%%--------------------------------------
-type box(T) :: #?BOX{dom:: domain(T), value :: T}.
%% @type domain(T). Domain of values of type T.
%%
-type domain(T) :: domrec(T) | T.
%% @type uchar(). Valid unicode code point.
-type uchar() :: 0..16#D7FF | 16#E000..16#10FFFF.
-type uchars() :: unicode:unicode_characters().
-record(?DOM,
{kind :: atom() | tuple(),
pick = fun error_pick/2 :: pick_fun(T),
shrink = fun error_shrink/2 :: shrink_fun(T) | none,
empty_ok = true :: boolean()
}).
-record(list, {elem}).
-record(tuple, {elem}).
-record(vector,{size, elem}).
-record(binary,{size}).
-record(bitstring,{size}).
-record(atom, {size}).
-record(oneof, {size, elems=[]}).
-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,shrinkto}).
-record(elements,{elems,size,picked=none}).
-record(seal,{dom,seed}).
-record(unicode_binary, {size, encoding = utf8}).
%% generators
-export([list/1,
tuple/1,
int/0,
int/1,
int/2,
largeint/0,
byte/0,
real/0,
float/0,
sized/1,
elements/1,
any/0,
atom/0,
atom/1,
choose/2,
oneof/1,
frequency/1,
bool/0,
char/0,
return/1,
vector/2,
binary/1,
binary/0,
bitstring/0,
bitstring/1,
non_empty/1,
resize/2,
noshrink/1,
non_neg_integer/0,
pos_integer/0]).
%% Unicode
-export([unicode_char/0,
unicode_string/0,
unicode_string/1,
unicode_binary/0,
unicode_binary/1,
unicode_binary/2,
unicode_characters/0,
unicode_characters/1]).
%% using a generator
-export([bind/2,
bindshrink/2,
is_shrinkable/1,
suchthat/2,
pick/2,
shrink/2,
sample/1,
sampleshrink/1,
seal/1,
open/1,
peek/1,
domain/3,
shrink_without_duplicates/1]).
%%
%% Default values for pic/shrink in ?DOM records
%%
error_pick(#?DOM{kind=Kind},_) -> erlang:error({pick,Kind}).
error_shrink(#?DOM{kind=Kind},_) -> erlang:error({shrink,Kind}).
%%
%% @doc The heart of the random structure generator; pick a value from the
%% domain.
%% Returns a pair of `{domain(T), T}' where the first component describes
%% the structure of the picked value.
%% @spec pick(domain(T), pos_integer()) -> {domain(T), T}
%%
-spec pick(domain(T), pos_integer()) -> {domain(T), T}.
pick(Dom=#?DOM{pick=PickFun}, SampleSize)
when SampleSize > 0, is_integer(SampleSize) ->
PickFun(Dom,SampleSize);
%%
%% A tuple is generated by generating each element
%%
pick({}=Empty, _) -> {Empty,Empty};
pick(T,SampleSize) when is_tuple(T), SampleSize > 0, is_integer(SampleSize) ->
{DomList,List} = pick(tuple_to_list(T), SampleSize),
{list_to_tuple(DomList), list_to_tuple(List)};
%%
%% For lists, we traverse down the list and generate each head
%%
pick([], _) -> {[],[]};
pick([H|T], SampleSize)
when SampleSize > 0, is_integer(SampleSize) ->
{HDom,HVal} = pick(H,SampleSize),
{TDom,TVal} = pick(T,SampleSize),
{[HDom|TDom], [HVal|TVal]};
%%
%% Lazy elements...
%%
pick(F,SampleSize) when erlang:is_function(F,0) ->
pick(F(),SampleSize);
%%
%% Simple values that generate themselves
%%
pick(V,_) ->
{V,V}.
pick_test() ->
case pick(int(), 10) of
{Dom, Val} when Val >= -5, Val =< 5 ->
Dom = int()
end.
pick_tuple_test() ->
case pick({int(),int()}, 10) of
{Dom, {Val1,Val2}} when is_integer(Val1), is_integer(Val2) ->
Dom = {int(), int()}
end.
pick_lazy_test() ->
case pick(?DELAY(int()), 10) of
{_, Val} when Val >= -5, Val =< 5 ->
ok
end.
pick_list_test() ->
case pick([int(),int()], 10) of
{Dom, [Val1,Val2]} when is_integer(Val1), is_integer(Val2) ->
Dom = [int(), int()]
end.
pick_pair_test() ->
repeat( fun() ->
case pick([choose(0,10), {choose(0,10)}], 10) of
{Dom, [Int1, {Int2}]=Val} when is_integer(Int1),
is_integer(Int2) ->
case shrink(Dom, Val) of
{_, [SInt1, {SInt2}]}
when SInt1<Int1; SInt2<Int2 -> ok;
{_, [_, {_}]} when Int1==0;Int2==0 -> ok
end
end
end,
20).
shrink({Domain,Value}) ->
shrink(Domain,Value).
%% @doc The shrinking step function used internally in Triq.
%%
%% Performs one single step of shrinking. If unsuccessful,
%% i.e. value cound not be shrunk, the output is equal to the input.
%%
%% Takes a `Domain' and a `Value' from said domain, and shrinks
%% the value within the constraints of the domain. The result is
%% a tuple of a (possibly smaller) output domain, and the
%% shrunken value.
%%
%% @spec shrink(Domain::domain(T),Value::T) -> {domain(T), T}
-spec shrink(domain(T),T) -> {domain(T), T}.
shrink(Dom=#?DOM{shrink=none}, Value) ->
{Dom, Value};
shrink(Domain=#?DOM{shrink=SFun}, Value) ->
SFun(Domain,Value);
shrink(TupDom,Tup) when is_tuple(TupDom),
is_tuple(Tup),
tuple_size(TupDom) =:= tuple_size(Tup) ->
shrink_tuple_samesize(TupDom, Tup, 10);
%%
%% well-formed lists are shrunk using this case.
%% the "length(X)>=0 tests if it is well-formed list"
%%
shrink(ListDom, List) when is_list(ListDom), is_list(List), length(List) >= 0 ->
?assert(length(ListDom) == length(List)),
shrink_list_samesize(ListDom, List, length(List), 10);
%%
%% other non-well-formed lists [cons pairs] use this clause
%%
shrink([_|_]=ListDom, [_|_]=List) ->
shrink_pair(ListDom,List, 10);
%% finally, if the generator is the value itself, it simplifies to itself
shrink(Any,Any) -> {Any,Any}.
%% @doc
%% Support functions for the generic shrinking
%% @private
%% @end
-spec shrink_pair([domain(H)|domain(T)], [H|T], non_neg_integer()) ->
{[domain(H)|domain(T)],[H|T]}.
shrink_pair(ListDom,List,0) ->
{ListDom,List};
shrink_pair([HDom|TDom]=ListDom, [H|T]=List, NAttempts) ->
%% choose if we shrink the head or the tail
ShrinkHead = (triq_rnd:uniform(2) =:= 1),
ShrinkTail = (triq_rnd:uniform(2) =:= 1),
%% then do it
case
%% shrink head and/or tail
{
case ShrinkHead of
true -> shrink(HDom,H);
false -> {HDom,H}
end
,
case ShrinkTail of
true -> shrink(TDom,T);
false -> {TDom,T}
end
}
of
%% it did not shrink
{{_,H}, {_,T}} ->
shrink_pair(ListDom,List,NAttempts-1);
%% either H or T changed
{{HSDom,HS}, {TSDom,TS}} ->
{[HSDom|TSDom], [HS|TS]}
end.
%%
%% We shrink tuples by turning it into a list and shrinking that...
%%
shrink_tuple_samesize(TupDom, Tup, NAttempts) ->
?assert(tuple_size(TupDom) =:= tuple_size(Tup)),
ListDom = tuple_to_list(TupDom),
List = tuple_to_list(Tup),
{SDom,SList} = shrink_list_samesize(ListDom, List, tuple_size(Tup),
NAttempts),
{ list_to_tuple(SDom), list_to_tuple(SList) }.
%%
%% Shrink a list by simplifying one or more of the elements.
%%
-spec shrink_list_samesize([domain(T)],[T],non_neg_integer(),
non_neg_integer()) -> {[domain(T)],[T]}.
shrink_list_samesize([],[],_,_) ->
{[],[]};
shrink_list_samesize(ListDom,List,_,0) ->
{ListDom,List};
shrink_list_samesize(ListDom,List,Length,NAttempts) when is_list(List) ->
?assert(length(ListDom) == length(List)),
HowManyToShrink = shrink_members(Length),
case shrink_list_members(ListDom, List, Length, HowManyToShrink) of
%% it did not shrink, try again
{_,List} ->
shrink_list_samesize(ListDom, List, Length, NAttempts-1);
%% else, we got a simpler list
{_,_}=Result ->
Result
end.
%%
%% Given a list, shrink HowMany of it's elements,
%% but don't reduce the list length.
%%
-spec shrink_list_members([domain(T)],[T],non_neg_integer(),
non_neg_integer()) -> {[domain(T)],[T]}.
shrink_list_members(ListDom, List, _, 0) -> {ListDom,List};
shrink_list_members(ListDom, List, Len, HowMany)
when is_list(List), is_list(ListDom) ->
?assert(Len == length(List)),
%%
%% replace element at RemIdx with simplified one
%%
RemIdx = triq_rnd:uniform(Len),
Elm = lists:nth(RemIdx, List),
ElmDom = lists:nth(RemIdx, ListDom),
{NextDom,NextList} =
case shrink(ElmDom,Elm) of
{_,Elm} -> {ListDom,List};
{SElmDom,SElm} ->
Dom2 = lists:sublist(ListDom,RemIdx-1) ++ [SElmDom]
++ lists:sublist(ListDom,RemIdx+1,Len),
List2 = lists:sublist(List,RemIdx-1) ++ [SElm]
++ lists:sublist(List,RemIdx+1,Len),
{Dom2, List2}
end,
shrink_list_members(NextDom, NextList, Len, HowMany-1).
%%-------------------------------------------------------------------
%%
%% Now, the specific domains
%%
%%-------------------------------------------------------------------
%%--------------------------------------------------------------------
%% @doc
%% Returns the domain of lists of the argument.
%% For example, `list(int())' yields the domain of lists of integers.
%%
%% @spec list( domain(T) ) -> domain([T])
%% @end
%%--------------------------------------------------------------------
-spec list(domain(T)) -> domrec([T]).
list(ElemDom) ->
#?DOM{kind=#list{elem=ElemDom}, pick=fun list_pick/2 }.
list_pick(#?DOM{kind=#list{elem=ElemDom},empty_ok=EmptyOK},
SampleSize) ->
OutLen = if EmptyOK =:= false ->
triq_rnd:uniform(SampleSize);
EmptyOK =:= true ->
triq_rnd:uniform(SampleSize)-1
end,
%%
%% TODO: if ElemDom is "simple" no need to build template
%%
%% generate template Domain and corresponding List
{ListDom,List} =
foldn(fun({Dom,T}) ->
{EDom,E} = pick(ElemDom,SampleSize),
{[EDom|Dom], [E|T]}
end,
{[],[]},
OutLen),
shrinkable_list(ListDom, List, OutLen, EmptyOK).
%% oops, if length==1 and EmptyOK=false; just return the fixed list
shrinkable_list(ListDom, List, 1, false) ->
{ListDom, List};
shrinkable_list(_, [], 0, _) ->
{[], []};
shrinkable_list(ListDom, List, Len, EmptyOK) ->
?assert(length(List) == length(ListDom)),
?assert(length(List) == Len),
SDom = #?DOM{kind={shrinkable_list, ListDom, Len},
shrink=fun list_shrink/2, empty_ok=EmptyOK},
{SDom,List}.
list_shrink(#?DOM{kind={shrinkable_list, ListDom, Len}, empty_ok=EmptyOK},
List) ->
?assert(length(List) == Len),
SmallerOK = ((EmptyOK and (Len>0)) or (Len>1)),
case SmallerOK and (triq_rnd:uniform(5) == 1) of
true ->
shorter_list(ListDom,List,Len,EmptyOK);
false ->
case shrink(ListDom,List) of
{_, List} when SmallerOK ->
shorter_list(ListDom,List,Len,EmptyOK);
{ShrunkenListDom,ShrunkenList} ->
shrinkable_list(ShrunkenListDom, ShrunkenList, Len, EmptyOK)
end
end.
shorter_list(ListDom,List,Len,EmptyOK) ->
{ShorterListDom, ShorterList, ShorterLen} =
case triq_rnd:uniform(3) of
1 -> %% Remove one element.
RemIdx = triq_rnd:uniform(Len),
{without(RemIdx, ListDom), without(RemIdx, List), Len-1};
2 -> %% Remove or keep a random sublist.
Idx1 = triq_rnd:uniform(Len),
Idx2 = triq_rnd:uniform(Len),
if Idx1 < Idx2 -> %% Remove the sublist [Idx1;Idx2]
{without(Idx1,Idx2, ListDom),
without(Idx1,Idx2, List),
Len-(Idx2-Idx1)};
true -> %% Remove all but the sublist [Idx2;Idx1]
ShorterLen1 = Idx1-Idx2+1,
{lists:sublist(ListDom, Idx2, ShorterLen1),
lists:sublist(List, Idx2, ShorterLen1),
ShorterLen1}
end;
3 -> %% Remove a random sublist.
Zipped = lists:zip(ListDom, List),
TrueTreshold = triq_rnd:uniform(),
FalseTreshold = triq_rnd:uniform(),
%% This may happen to be the original list again.
Pruned = markov_prune_list(Zipped, TrueTreshold, FalseTreshold,
false),
{ListDom2,List2} = lists:unzip(Pruned),
{ListDom2, List2, length(Pruned)}
end,
{NewListDom, NewList, NewLen} =
case {EmptyOK, ShorterLen} of
{false, 0} ->
{ListDom, List, Len};
_ ->
{ShorterListDom, ShorterList, ShorterLen}
end,
shrinkable_list(NewListDom, NewList, NewLen, EmptyOK).
markov_prune_list([], _,_,_) -> [];
markov_prune_list([H|T], TrueTreshold, FalseTreshold, Prev) ->
Rnd = triq_rnd:uniform(),
Threshold = if Prev -> TrueTreshold;
true -> FalseTreshold
end,
Include = Rnd > Threshold,
NewTail = markov_prune_list(T, TrueTreshold, FalseTreshold, Include),
if Include -> [H|NewTail];
true -> NewTail
end.
%%
%% Generator for tuples
%%
%% @spec tuple(domain(ElemType::any())) -> domain(tuple(ElemType))
-spec tuple(domain(any())) -> domrec(tuple()).
tuple(ElemDom) ->
#?DOM{kind=#tuple{elem=ElemDom}, pick=fun tuple_pick/2 }.
tuple_pick(#?DOM{kind=#tuple{elem=ElemDom},empty_ok=EmptyOK},
SampleSize) ->
OutLen = if EmptyOK =:= false ->
triq_rnd:uniform(SampleSize);
EmptyOK =:= true ->
triq_rnd:uniform(SampleSize)-1
end,
%%
%% TODO: if ElemDom is "simple" no need to build template
%%
%% generate template Domain and corresponding Tuple
{ListDom,List} =
foldn(fun({Dom,T}) ->
{EDom,E} = pick(ElemDom,SampleSize),
{[EDom|Dom], [E|T]}
end,
{[],[]},
OutLen),
shrinkable_tuple(list_to_tuple(ListDom), list_to_tuple(List), EmptyOK).
%% If length==1 and EmptyOK=false; just return the fixed tuple
shrinkable_tuple(TupleDom, Tuple, false) when tuple_size(Tuple) =:= 1 ->
{TupleDom, Tuple};
shrinkable_tuple(TupleDom, Tuple, EmptyOK) ->
?assert(tuple_size(Tuple) == tuple_size(TupleDom)),
SDom = #?DOM{kind={shrinkable_tuple, TupleDom},
shrink=fun tuple_shrink/2, empty_ok=EmptyOK},
{SDom,Tuple}.
tuple_shrink(#?DOM{kind={shrinkable_tuple, TupleDom}, empty_ok=EmptyOK},
Tuple) ->
AllowSmaller = allow_smaller(tuple_size(Tuple), any, EmptyOK),
case shrink(TupleDom,Tuple) of
{_, Tuple} when AllowSmaller ->
RemIdx = triq_rnd:uniform(tuple_size(Tuple)),
shrinkable_tuple(without(RemIdx, TupleDom),
without(RemIdx, Tuple),
EmptyOK);
Result -> Result
end.
%% @doc The domain of integers.
%% @spec int() -> domain(integer())
-spec int() -> domrec(integer()).
int() ->
#?DOM{kind=int,
shrink=fun(Dom,Val) when Val>0 -> {Dom,Val-1};
(Dom,Val) when Val<0 -> {Dom,Val+1};
(Dom,0) -> {Dom,0}
end,
pick=fun(Dom,SampleSize) ->
{Dom, triq_rnd:uniform(SampleSize) - (SampleSize div 2)}
end
}.
int(Max) ->
choose(0, Max).
int(Min, Max) ->
choose(Min, Max).
-spec byte() -> domrec(integer()).
byte() ->
int(0, 255).
%% @doc The domain of non-negative integers.
%% @spec non_neg_integer() -> domain(non_neg_integer())
-spec non_neg_integer() -> domrec(non_neg_integer()).
non_neg_integer() ->
#?DOM{
kind=int,
shrink=fun(Dom,Val) when Val>0 -> {Dom,Val-1};
(Dom,0) -> {Dom,0}
end,
pick=fun(Dom,SampleSize) ->
{Dom, triq_rnd:uniform(SampleSize) - 1}
end
}.
%% @doc The domain of positive integers.
%% @spec pos_integer() -> domain(pos_integer())
-spec pos_integer() -> domrec(pos_integer()).
pos_integer() ->
#?DOM{
kind=int,
shrink=fun(Dom,Val) when Val>1 -> {Dom,Val-1};
(Dom,1) -> {Dom,1}
end,
pick=fun(Dom,SampleSize) ->
{Dom, abs(triq_rnd:uniform(SampleSize)) + 1}
end
}.
%% @doc The domain of "big" integers.
%%
%% Note, this is sized to ensure it remains a big integer, even on 64
%% bit implementations.
%% @spec largeint() -> domrec(largeint())
largeint() ->
#?DOM{
kind=largeint,
shrink=fun(Dom,0) -> {Dom,0};
(Dom,Val) -> {Dom,Val div 10}
end,
pick=fun(Dom,SampleSize) ->
Val = trunc(?BIGNUM * SampleSize * triq_rnd:uniform()),
Sign = case triq_rnd:uniform(2) of
2 ->
-1;
1 ->
1
end,
{Dom, Sign * Val}
end
}.
-spec(float() ->domrec(float())).
float() ->
real().
%% @doc The domain of floats.
%% @spec real() -> domain(float())
-spec real() -> domrec(float()).
real() ->
#?DOM{
kind=real,
pick=fun(Dom,SampleSize) ->
{Dom, (triq_rnd:uniform()*SampleSize) - (SampleSize / 2)}
end,
shrink=fun(Dom,Val) -> {Dom, Val/2.0} end
}.
%% @doc The domain of booleans. Shrinks to false.
%% @spec bool() -> domain( true | false )
bool() ->
#?DOM{
kind=boolean,
pick=fun(Dom,_) -> {Dom, triq_rnd:uniform(2)==1} end,
shrink=fun(_,_) -> {false, false} end
}.
-spec char() -> domrec(32..126).
char() ->
#?DOM{
kind=char,
pick=fun(Dom,_) ->
{Dom, $a + triq_rnd:uniform($z - $a + 1)-1}
end,
shrink=fun(Dom,V) when V =< $c ->
{Dom,V};
(Dom,N) when N > $c, N =< $z ->
{Dom,N - triq_rnd:uniform(3)}
end
}.
-spec binary() -> domrec(binary()).
binary() ->
#?DOM{kind=#binary{size=any},
pick=fun binary_pick/2,
shrink=fun binary_shrink/2}.
-spec binary(Size::non_neg_integer()) -> domrec(binary()).
binary(Size) ->
#?DOM{kind=#binary{size=Size},
pick=fun binary_pick/2,
shrink=fun binary_shrink/2}.
binary_pick(#?DOM{kind=#binary{size=Size}, empty_ok=EmptyOK}=BinDom,
SampleSize) ->
Sz = case Size of
any ->
case EmptyOK of
true ->
triq_rnd:uniform(SampleSize)-1;
false ->
triq_rnd:uniform(SampleSize)
end;
Size ->
Size
end,
BinValue = list_to_binary(foldn(fun(T) -> [triq_rnd:uniform(256)-1 | T] end,
[],
Sz)),
{BinDom, BinValue}.
allow_smaller(Len,any,true) when Len>0 ->
true;
allow_smaller(Len,any,false) when Len>1 ->
true;
allow_smaller(_,_,_) ->
false.
binary_shrink(#?DOM{kind=#binary{size=Size}, empty_ok=EmptyOK}=BinDom,
BinValue) ->
List = binary_to_list(BinValue),
Length = byte_size(BinValue),
AllowSmaller = allow_smaller(Length,Size,EmptyOK) ,
case shrink_list_with_elemdom(int(), List, Length, AllowSmaller) of
List -> {BinDom, BinValue};
NewList -> {BinDom, list_to_binary(NewList)}
end.
%% @doc The domain of bitstrings
%% @spec bitstring() -> domain(bitstring())
-spec bitstring() -> domrec(bitstring()).
bitstring() ->
#?DOM{kind=#bitstring{size=any},
pick=fun bitstring_pick/2,
shrink=fun bitstring_shrink/2}.
-spec bitstring(Size::non_neg_integer()) -> domrec(bitstring()).
bitstring(Size) ->
#?DOM{kind=#bitstring{size=Size},
pick=fun bitstring_pick/2,
shrink=fun bitstring_shrink/2}.
bitstring_pick(#?DOM{kind=#bitstring{size=Size}, empty_ok=EmptyOK}=BinDom,
SampleSize) ->
Sz = case Size of
any ->
case EmptyOK of
true ->
triq_rnd:uniform(SampleSize)-1;
false ->
triq_rnd:uniform(SampleSize)
end;
Size ->
Size
end,
BinValue = list_to_bitstring(foldn(fun(T) ->
Int = triq_rnd:uniform(256) - 1,
Bit = triq_rnd:uniform(8),
[<<Int:Bit>> | T]
end, [], Sz)),
{BinDom, BinValue}.
bitstring_shrink(#?DOM{kind=#bitstring{size=Size}, empty_ok=EmptyOK}=BinDom,
BinValue) ->
List = bitstring_to_list(BinValue),
Length = byte_size(BinValue),
AllowSmaller = allow_smaller(Length,Size,EmptyOK),
case shrink_list_with_elemdom(int(), List, Length, AllowSmaller) of
List -> {BinDom, BinValue};
NewList -> {BinDom, list_to_bitstring(NewList)}
end.
%% @doc The domain of atoms
%% @spec atom() -> domain(integer())
-spec atom() -> domrec(atom()).
atom() ->
#?DOM{kind=#atom{size=any},
pick=fun atom_pick/2,
shrink=fun atom_shrink/2}.
-spec atom(non_neg_integer()) -> domrec(atom()).
atom(Size) ->
#?DOM{kind=#atom{size=Size},
pick=fun atom_pick/2,
shrink=fun atom_shrink/2}.
atom_pick(#?DOM{kind=#atom{size=Size}, empty_ok=EmptyOK}=AtomDom, SampleSize) ->
Sz = case Size of
any ->
case EmptyOK of
true ->
triq_rnd:uniform(xmin(SampleSize,256))-1;
false ->
triq_rnd:uniform(xmin(SampleSize,256))
end;
Size ->
Size
end,
CharDom = char(),
Fun=fun(T) -> {_,Char} = pick(CharDom,SampleSize), [Char | T] end,
AtomValue = list_to_atom(foldn(Fun, [], Sz)),
{AtomDom, AtomValue}.
xmin(A,B) when A<B -> A;
xmin(A,B) when B<A -> B;
xmin(A,B) when A==B -> A.
atom_shrink(#?DOM{kind=#atom{size=Size}, empty_ok=EmptyOK}=AtomDom,
AtomValue) ->
List = atom_to_list(AtomValue),
Length = length(List),
AllowSmaller = allow_smaller(Length,Size,EmptyOK) ,
case shrink_list_with_elemdom(char(), List, Length, AllowSmaller) of
List -> {AtomDom, AtomValue};
NewList -> {AtomDom, list_to_atom(NewList)}
end.
vector(Size,ElemDom) ->
#?DOM{kind=#vector{size=Size,elem=ElemDom},
pick=fun vector_pick/2}.
vector_pick(#?DOM{kind=#vector{size=Size,elem=ElemDom}}, SampleSize) ->
foldn(fun({TDom,T}) ->
{HDom,H} = pick(ElemDom, SampleSize),
{[HDom|TDom], [H|T]}
end,
{[], []},
Size).
%%
%% @doc Shrink `List' where all elements have the same domain `ElemDom'.
%% If parameter `AllowSmaller' is true, then we may also make the list
%% shorter.
%% @end
shrink_list_with_elemdom(_,List,0,_) -> List;
shrink_list_with_elemdom(ElemDom,List,Length,AllowSmaller) ->
%% 1/5 of the time, try shrinking by removing an elemet
case AllowSmaller andalso shrink_smaller(Length) of
true ->
RemoveIdx = triq_rnd:uniform(Length),
without(RemoveIdx, List);
false ->
HowManyToShrink = shrink_members(Length),
case shrink_list_members_generic(ElemDom, List, Length,
HowManyToShrink) of
%% can we remove an element?
List when AllowSmaller ->
RemIdx = triq_rnd:uniform(Length),
without(RemIdx, List);
%% it changed!
ShrunkenList ->
ShrunkenList
end
end.
%% decide if something of size `Length' should be shrunk by removing an element
shrink_smaller(_Length) ->
triq_rnd:uniform(5)==1.
%% decide how many of
shrink_members(0) -> 0;
shrink_members(Length) when Length>0 ->
case triq_rnd:uniform(5) of
1 -> triq_rnd:uniform(5);
_ -> 1
end.
%%
%% Same, but when component element is fixed
%% (also returns List, not {Dom,List})!
%%
-spec shrink_list_members_generic(domain(T), [T], non_neg_integer(),
integer()) -> [T].
shrink_list_members_generic(_, List, _, 0) -> List;
shrink_list_members_generic(#?DOM{}=ElemDom, List, Len, HowMany) ->
NextList = shrink_list_N(ElemDom,List,Len, ?SHRINK_LOOPS),
shrink_list_members_generic(ElemDom, NextList, Len, HowMany-1).
shrink_list_N(_, List, _, 0) -> List;
shrink_list_N(#?DOM{}=ElemDom, List, Len, N) ->
?assert(Len == length(List)),
%%
%% replace element at RemIdx with simplified one
%%
RemIdx = triq_rnd:uniform(Len),
Elm = lists:nth(RemIdx, List),
%% io:format("shrinking elem ~p (~p) of ~p~n", [RemIdx,Elm,List]),
case shrink(ElemDom,Elm) of
{_,Elm} ->
shrink_list_N(ElemDom, List, Len, N-1);
{_,SElm} ->
lists:sublist(List,RemIdx-1) ++ [SElm]
++ lists:sublist(List,RemIdx+1,Len)
end.
non_empty(#?DOM{}=Dom) ->
Dom#?DOM{empty_ok=false}.
%% @doc Tell whether the domain can possibly be shrinked.
%% @private
-spec is_shrinkable(domain(_)) -> boolean().
is_shrinkable(#?DOM{shrink=none}) ->
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)
-spec bind(domain(T::any()),
fun( (T::any()) -> domain(D) )) -> domain(D).
bind(Gen1,FG2) ->
#?DOM{kind=#bind{dom=Gen1,body=FG2},
pick = fun bind_pick/2
}.
-spec bind_pick(domain(T),pos_integer()) -> T.
bind_pick(#?DOM{kind=#bind{dom=Dom,body=Fun}}, SampleSize) ->
{Dom1,Val1} = pick(Dom, SampleSize),
{Dom2,Val2} = pick( Fun(Val1), SampleSize),
{ bound_domain(Dom1,Val1,Dom2,Fun, SampleSize), Val2 }.
bound_domain(Dom1,Val1,Dom2,Fun,SampleSize) ->
#?DOM{kind=#bound_domain{dom1=Dom1,val1=Val1,dom2=Dom2,fun2=Fun,
size=SampleSize},
shrink= fun bound_shrink/2
}.
bound_shrink(#?DOM{kind=#bound_domain{dom1=Dom1,val1=Val1,dom2=Dom2,fun2=Fun,
size=SampleSize}}, Val2) ->
case shrink(Dom1,Val1) of
%% it did not shrink val1
{_,Val1} ->
%% try to shrink the secondary domain
shrink(Dom2,Val2);
%% Val1 did shrink!
{SDom1,SVal1} ->
%% pick a new value from the secondary domain
{SDom2,SVal2} = pick( Fun(SVal1), SampleSize),
%% and return the new bound domain
{ bound_domain(SDom1,SVal1,SDom2,Fun, SampleSize), SVal2 }
end.
%% @doc support function for `?LETSHRINK([X,...],[domain(),...],domain())'
%% @private
bindshrink(Dom,_Fun) when not is_list(Dom) ->
error(argument_to_LETSHRINK_macro_must_be_lists);
bindshrink(Dom,Fun) when is_function(Fun,1) ->
domain(letshrink,
fun(_,SampleSize) ->
Box1 = {_,List1} = pick(Dom, SampleSize),
?assert(is_list(List1) and (length(List1)>0) ),
Box2 = {_,List2} = pick(Fun(List1), SampleSize),
{ bindshrink2(Box1,Box1,Box2,Fun,SampleSize), List2 }
end,
undefined).
bindshrink2(OrigBox1,Box1,Box2,Fun,SampleSize) ->
domain(letshrink2,
undefined,
fun(_,_) ->
{Dom2,Val2}=Box2,
case shrink(Dom2,Val2) of
{_,Val2} ->
case shrink({_,List1}=Box1) of
{_, List1} ->
{OrigDom1,OrigList1}=OrigBox1,
Index = triq_rnd:uniform(length(OrigList1)),
{ lists:nth(Index,OrigDom1),
lists:nth(Index,OrigList1) };
{_,NewList1}=NewBox1 ->
NewBox2 = pick(Fun(NewList1), SampleSize),
{_,NewVal2} = NewBox2,
{ bindshrink2(OrigBox1,
NewBox1,
NewBox2,
Fun,
SampleSize),
NewVal2 }
end;
{_, NewVal2}=NewBox2 ->
{ bindshrink2(OrigBox1,
Box1,
NewBox2,
Fun,
SampleSize),
NewVal2 }
end
end).
%% @doc Support function for the ?SUCHTHAT macro.
%% @private
%% @spec suchthat(domain(T),fun((T) -> boolean())) -> domain(T)
-spec suchthat(domain(T),fun((T) -> boolean())) -> domain(T).
suchthat(Dom,Predicate) ->
#?DOM{kind=#suchthat{dom=Dom,pred=Predicate},
pick=fun suchthat_pick/2,
shrink=fun suchthat_shrink/2}.
suchthat_pick(#?DOM{kind=#suchthat{dom=Dom,pred=Pred}},SampleSize) ->
suchthat_pick_loop(?SUCHTHAT_LOOPS,Dom,Pred,SampleSize).
suchthat_shrink(#?DOM{kind=#suchthat{dom=Dom,pred=Pred}},Val) ->
suchthat_shrink_loop(?SUCHTHAT_LOOPS, Dom, Pred, Val).
suchthat_pick_loop(0,_,_,_) ->
erlang:exit(suchthat_failed);
suchthat_pick_loop(N,Dom,Pred,SampleSize) ->
{ValDom,Val} = pick(Dom,SampleSize),
case Pred(Val) of
true -> {suchthat(ValDom, Pred), Val};
%% If we failed, we make another try with a higher sample size,
%% as there may be not enough variance within our current sample
%% size.
_ -> suchthat_pick_loop(N - 1, Dom, Pred, SampleSize + 2)
end.
suchthat_shrink_loop(0, Dom, Pred, Val) ->
{suchthat(Dom, Pred), Val};
suchthat_shrink_loop(N, Dom, Pred, Val) ->
case shrink(Dom, Val) of
{Dom, Val} ->
{suchthat(Dom, Pred), Val};
{ShrinkedDom, ShrinkedVal} ->
case Pred(ShrinkedVal) of
true -> {suchthat(ShrinkedDom, Pred), ShrinkedVal};
_ -> suchthat_shrink_loop(N - 1, Dom, Pred, Val)
end
end.
smaller(Domain) ->
?SIZED(SZ, resize(triq_rnd:uniform((SZ div 2)+1), Domain)).
-spec any() -> domain(any()).
any() ->
oneof([int(), real(), bool(), atom(),
[smaller(?DELAY(any())), smaller(?DELAY(any()))],
%% list(any()), but with a size in the range 1..GenSize
list(smaller(?DELAY(any()))),
tuple(smaller(?DELAY(any())))
]).
-spec oneof([domain(T)]) -> domain(T).
oneof(DomList) when is_list(DomList) ->
#?DOM{kind=#oneof{elems=DomList, size=length(DomList)},
pick=fun oneof_pick/2
}.
oneof_pick(#?DOM{kind=#oneof{elems=DomList, size=Length}}, SampleSize) ->
Dom = lists:nth(triq_rnd:uniform(Length), DomList),
pick(Dom, SampleSize).
%% --------------------------------------------------------------
%% @doc Choose domain from list [{Weight, Domain}, ...]
%% @end
%% --------------------------------------------------------------
frequency(GenList) when is_list(GenList) ->
Sum = lists:foldl(fun({Freq, _}, Acc) ->
Freq + Acc
end,
0,
GenList),
domain(frequency,
fun(_,SampleSize) ->
Limit = triq_rnd:uniform(Sum),
{ok,Gen} = lists:foldl(
fun (_, {ok, _}=Acc) ->
Acc;
({Freq,Generator}, {AccSum, none}) ->
NextAcc = AccSum+Freq,
if NextAcc >= Limit ->
{ok, Generator};
true ->
{NextAcc, none}
end
end,
{0, none},
GenList),
pick(Gen, SampleSize)
end,
undefined).
%% @doc Returns the domain containing exactly `Value'.
%% Triq uses internally records of type `@'; and so to avoid
%% interpretation of such values you can wrap it with this. This would
%% be the case if you have constants in your domains contain the atom `@'.
%% I.e., the following would break because Triq tries to interpret the `@':
%%<pre>?FORALL(X, [int(), {'@', 4}],
%% [IntVal, {'@', 4}] = X
%%)</pre>
%%To fix it, do like this:
%%<pre>?FORALL(X, [int(), return({'@', 4})],
%% [IntVal, {'@', 4}] = X
%%)</pre>
%% @spec return(Value::Type) -> domain(Type)
-spec return(Value::Type) -> domain(Type).
return(Val) ->
domain(return,
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)
-spec sized( fun((integer()) -> domain(T)) ) -> domain(T).
sized(Fun) ->
#?DOM{kind=#sized{body=Fun},
pick=fun(#?DOM{kind=#sized{body=F}},GS) -> pick(F(GS),GS) end
}.
resize(Sz,Dom) ->
#?DOM{kind=#resize{dom=Dom,size=Sz},
pick=fun(#?DOM{kind=#resize{dom=D,size=SampleSize}},_) ->
pick(D,SampleSize)
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,
shrink=none}.
-spec choose(M::integer(), N::integer()) -> domrec(integer()).
choose(M,N) when is_integer(M), is_integer(N), M=<N ->
ShrinkTo = case {M>=0, N>=0} of
{true, true} -> M;
{false, true} -> 0;
{false, false} -> N
end,
#?DOM{kind=#choose{min=M,max=N,shrinkto=ShrinkTo},
pick = fun choose_pick/2,
shrink = fun choose_shrink/2
}.
choose_pick(#?DOM{kind=#choose{min=M,max=N}}=Dom, _) ->
Value = triq_rnd:uniform(N-M+1) - 1 + M,
{Dom,Value}.
choose_shrink(#?DOM{kind=#choose{shrinkto=Value}}=Dom, Value) ->
{Dom, Value};
choose_shrink(#?DOM{kind=#choose{shrinkto=ShrinkTo}}=Dom, Value) ->
DecrementProb = 2 * math:exp(-0.1 * abs(Value - ShrinkTo)),
case triq_rnd:uniform() < DecrementProb of
true ->
{Dom, choose_shrink_by_decrement(Value, ShrinkTo)};
false ->
{Dom, choose_shrink_by_half(Value, ShrinkTo)}
end.
choose_shrink_by_half(Value, ShrinkTo) ->
Mid = (Value - ShrinkTo) div 2,
ShrinkTo + Mid.
choose_shrink_by_decrement(Value, ShrinkTo) when Value > ShrinkTo ->
Value - 1;
choose_shrink_by_decrement(Value, ShrinkTo) when Value < ShrinkTo ->
Value + 1;
choose_shrink_by_decrement(Value, Value) ->
Value.
%% @doc Generates a member of the list `L'. Shrinks towards the first element
%% of the list.
%% @spec elements([any()]) -> domain(any())
%% @end
-spec elements([T,...]) -> domain(T).
elements(L) when is_list(L), length(L)>0 ->
#?DOM{kind=#elements{elems=L,size=length(L)},
pick = fun elements_pick/2,
shrink = fun elements_shrink/2
}.
-spec elements_pick(domain(T), pos_integer()) -> {domain(T), T}.
elements_pick(#?DOM{kind=#elements{elems=Elems,size=Length}=Kind}=Dom, _) ->
Picked = triq_rnd:uniform(Length),
Value = lists:nth(Picked,Elems),
{ Dom#?DOM{kind=Kind#elements{picked=Picked}},
Value }.
elements_shrink(#?DOM{kind=#elements{elems=Elems,picked=Picked}=Kind}=Dom, _)
when Picked > 1 ->
Value = lists:nth(Picked-1,Elems),
{ Dom#?DOM{kind=Kind#elements{picked=Picked-1}},
Value };
elements_shrink(Dom,Value) ->
{ Dom, Value }.
shrink_without_duplicates(Dom) ->
domain(shrink_without_duplicates1,
fun(_,GS) ->
{Dom,Val} = pick(Dom,GS),
Tested = gb_sets:add(Val, gb_sets:new()),
{shrink_without_duplicates(Dom,Tested), Val}
end,
undefined).
shrink_without_duplicates(Dom,Tested) ->
domain(shrink_without_duplicates2,
undefined,
fun(_,Val) ->
shrink_without_duplicates_loop(Dom,Val,Tested,?SHRINK_LOOPS)
end).
shrink_without_duplicates_loop(_,Val,_,0) ->
Val;
shrink_without_duplicates_loop(Dom,Val,Tested,Tries) ->
{Dom2,Val2} = shrink(Dom,Val),
case gb_sets:is_member(Val2, Tested) of
true ->
shrink_without_duplicates_loop(Dom,Val,Tested,Tries-1);
false ->
{shrink_without_duplicates(Dom2, gb_sets:add(Val, Tested)),
Val2}
end.
%%--------------------------------------------------------------------
%% @doc Generate a sample of output values from a generator.
%% This should not be used except for REPL testing purposes; it will
%% only ever generate fairly small-valued samples.
%%
%% @spec sample( domain(T) ) -> [T]
%% @end
%%--------------------------------------------------------------------
sample(Dom) ->
foldn(fun(T) ->
{_,Val} = pick(Dom, 20 + triq_rnd:uniform(10) ),
[Val|T]
end,
[],
11).
%%-------------------------------------------------------------------
%% @doc Get the domain of boxes of T
%% @spec seal(domain(T)) -> domain(box(T))
%% @end
%%-------------------------------------------------------------------
-spec seal(Dom::domain(T)) -> domrec(box(T)).
seal(Dom) ->
Seed = triq_rnd:seed(),
triq_rnd:seed(Seed),
#?DOM{kind=#seal{dom=Dom,seed=Seed}, pick=fun seal_pick/2}.
seal_pick(#?DOM{kind=#seal{dom=Dom,seed=Seed}}, SampleSize) ->
OldSeed = triq_rnd:seed(Seed),
{BoxDom,BoxValue} = pick(Dom,SampleSize),
triq_rnd:seed(OldSeed),
#?BOX{dom=BoxDom,value=BoxValue}.
%%-------------------------------------------------------------------
%% @doc Open a box, yielding a domain which always generates the same value.
%% @spec open(box(T)) -> domain(T)
%% @end
%%-------------------------------------------------------------------
-spec open(Box::box(T)) -> domain(T).
open(#?BOX{}=Box) ->
#?DOM{kind=Box, pick=fun box_pick/2}.
box_pick(#?DOM{kind=#?BOX{dom=Dom,value=Value}}, _) ->
{Dom,Value}.
-spec peek(box(T)) -> T.
peek(#?BOX{value=Value}) ->
Value.
%%------------------------------------------------------------------
%% @doc Print a value generated by `Domain', followed by a sample of shrinkings.
%% For each line of successive output, it prints up to five samples of
%% shrinking. The first value on each like is used as the target for the next
%% round of shrinking.
%%
%% <pre> 1> sampleshrink(list(int())).
%%[-2,-8,2]
%%[[-1,-8,2],[0,-8,2],[-1,-7,2],[-2,-8,1],[-1,-8,1]]
%%[[0,-8,2],[0,-6,1],[-1,-7,2],[0,-7,2]]
%%[[0,-8,0],[0,-7,0],[0,-7,2],[0,-8,1],[0,-5,2],[0,-7,1]]
%%[[0,-7,0],[0,-5,0]]
%%[[0,-5,0],[0,-6,0]]
%%[[0,-4,0],[0,-3,0]]
%%[[0,-2,0],[0,-3,0],[0,-1,0]]
%%[[0,-1,0]]
%%[[0,0,0]]
%%[[0,0]]
%%[[0]]
%%[[]]
%%ok</pre>
%% @spec sampleshrink(domain(any())) -> ok
%% @end
%%------------------------------------------------------------------
-spec sampleshrink(domain(any())) -> ok.
sampleshrink(Domain) ->
{Dom2,Value} = pick(Domain, 20),
io:format("~p~n", [Value]),
sampleshrink_loop(Dom2,Value).
sampleshrink_loop(Dom,Val) ->
case shrink(Dom,Val) of
{_,Val} ->
ok;
{Dom2,Val2} ->
Samples = foldn(fun(T) -> {_,V} = shrink(Dom,Val),
case lists:member(V,T) of
true -> T;
false -> [V|T]
end
end,
[Val2],
5),
io:format("~p~n", [lists:reverse(Samples)]),
sampleshrink_loop(Dom2,Val2)
end.
%%------------------------------------------------------------------------
%% @doc Create custom domain.
%% This function allows you to create a custom domain with it's own
%% shrinking logic. For instance, the even numbers can be specified thus:
%%
%% <pre>even() ->
%% domain(even,
%% fun(Self,Size) ->
%% Value = (triq_rnd:uniform(Size) * 2) div 2,
%% {Self, Value}
%% end,
%% fun(Self,Value) when Value>0 ->
%% {Self, Value-2};
%% (Self,_,0) ->
%% {0, 0}
%% end).</pre>
%%
%% The domain itself (`Self' in the above code) is passed as the first argument
%% to each invocation of both the picking and the shrinking functions.
%%
%% Both the picking and the shrinking function must return a 2-tuple of
%% the domain of the resulting value, and the value itself.
%%
%% @spec domain(Name::any(),
%% PickFun :: pick_fun(T),
%% ShrinkFun :: shrink_fun(T)) -> domain(T)
%% @end
%%------------------------------------------------------------------------
-spec domain(Name::atom(),
PickFun::pick_fun(T),
ShrinkFun::shrink_fun(T)) -> domain(T).
domain(Name,PickFun,ShrinkFun) ->
#?DOM{kind=Name, pick=PickFun, shrink=ShrinkFun}.
%%
%% Utility functions
%%
foldn(_,Acc,0) -> Acc;
foldn(Fun,Acc,Count) when Count > 0 ->
foldn(Fun, Fun(Acc), Count-1).
%% remove the RemIdx'th element of List [1-indexed]
without(RemIdx,List) when is_list(List) ->
{First,Rest} = lists:split(RemIdx-1,List),
First ++ tl(Rest);
without(RemIdx,Tup) when is_tuple(Tup) ->
list_to_tuple(without(RemIdx, tuple_to_list(Tup))).
%% remove the RemIdx1 through RemIdx2-1'th element of List [1-indexed]
without(RemIdx1, RemIdx2, List) when is_list(List) ->
{First,Tail} = lists:split(RemIdx1-1,List),
{_Middle,Rest} = lists:split(RemIdx2-RemIdx1,Tail),
First ++ Rest.
repeat(_,0) ->
ok;
repeat(Fun,N) ->
Fun(),
repeat(Fun,N-1).
%% Code points in the range U+D800..U+DBFF (1,024 code points) are known as
%% high-surrogate code points, and code points in the range U+DC00..U+DFFF
%% (1,024 code points) are known as low-surrogate code points.
%% A high-surrogate code point (also known as a leading surrogate) followed
%% by a low-surrogate code point (also known as a trailing surrogate)
%% together form a surrogate pair used in UTF-16 to represent 1,048,576
%% code points outside BMP.
%% High and low surrogate code points are not valid by themselves. Thus the
%% range of code points that are available for use as characters is
%% U+0000..U+D7FF and U+E000..U+10FFFF (1,112,064 code points).
%% The value of these code points (i.e. excluding surrogates) is sometimes
%% referred to as the character's scalar value.
-define(UNICODE_CHAR_SHRINK_STEP, 3).
-spec unicode_char() -> domrec(uchar()).
unicode_char() ->
P = fun(Dom,_) ->
{Dom, random_unicode_char()}
end,
S = fun(Dom,V) ->
NewV = case (V - triq_rnd:uniform(?UNICODE_CHAR_SHRINK_STEP)) of
X when X < 0 -> V;
X when X >= 16#D800, X =< 16#DFFF ->
%% skip surrogates.
16#D799;
X when X =:= 16#FFFF; X =:= 16#FFFE ->
16#FFFD;
X -> X
end,
{Dom, NewV}
end,
#?DOM{
kind=unicode_char,
pick=P,
shrink=S}.
-spec random_unicode_char() -> uchar().
random_unicode_char() ->
case (triq_rnd:uniform(16#10FFFF + 1) - 1) of
C when C >= 16#D800 andalso C =< 16#DFFF ->
%% surrogates
random_unicode_char();
16#FFFF ->
random_unicode_char();
16#FFFE ->
random_unicode_char();
C -> C
end.
%% @doc Generate a list of unicode code points.
-spec unicode_string() -> domrec([uchar()]).
unicode_string() ->
list(unicode_char()).
%% @doc Generate a list of unicode code points of length `Size'.
-spec unicode_string(non_neg_integer()) -> domrec([uchar()]).
unicode_string(Size) ->
vector(Size, unicode_char()).
-spec unicode_binary() -> domrec(binary()).
unicode_binary() ->
unicode_binary(any, utf8).
%% @doc Generate an unicode binary binary.
-spec unicode_binary(Size | Encoding) -> domrec(binary()) when
Size :: non_neg_integer(),
Encoding :: unicode:encoding().
unicode_binary(Size) when is_integer(Size) ->
unicode_binary(Size, utf8);
unicode_binary(Encoding) ->
unicode_binary(any, Encoding).
%% @doc Generate an unicode binary.
-spec unicode_binary(Size, Encoding) -> domrec(binary()) when
Size :: non_neg_integer() | 'any',
Encoding :: unicode:encoding().
unicode_binary(Size, Encoding) ->
#?DOM{kind=#unicode_binary{size=Size, encoding=Encoding},
pick=fun unicode_binary_pick/2,
shrink=fun unicode_binary_shrink/2}.
unicode_binary_pick(#?DOM{kind=#unicode_binary{size=Size, encoding=Encoding},
empty_ok=EmptyOK}=BinDom, SampleSize)
when SampleSize > 1 ->
Sz = case Size of
any ->
case EmptyOK of
true ->
triq_rnd:uniform(SampleSize)-1;
false ->
triq_rnd:uniform(SampleSize)
end;
Size ->
Size
end,
CharList = foldn(fun(T) -> [random_unicode_char() | T] end, [], Sz),
BinValue = unicode:characters_to_binary(CharList, unicode, Encoding),
{BinDom, BinValue}.
unicode_binary_shrink(#?DOM{kind=#unicode_binary{size=Size, encoding=Encoding},
empty_ok=EmptyOK}=BinDom, BinValue) ->
List = unicode:characters_to_list_int(BinValue, utf8),
Length = strlen(List),
AllowSmaller = allow_smaller(Length,Size,EmptyOK),
case shrink_list_with_elemdom(unicode_char(), List, Length, AllowSmaller) of
List -> {BinDom, BinValue};
NewList ->
NewBin = unicode:characters_to_binary(NewList, unicode, Encoding),
{BinDom, NewBin}
end.
strlen(L) ->
case erlang:function_exported(string, length, 1) of
true -> string:length(L);
false -> apply(string, len, [L])
end.
-spec unicode_characters() -> domrec(uchars()).
unicode_characters() ->
unicode_characters(unicode).
%% `unicode_characters()' should not return a single `unicode_char()'.
-spec unicode_characters(Encoding) -> domrec(uchars()) when
Encoding :: unicode:encoding().
unicode_characters(Encoding) ->
?SIZED(Size,
frequency([{1, unicode_string()},
{1, unicode_binary(Encoding)},
{5, ?DELAY(resize(Size div 2,
unicode_characters1(Encoding)))}
])).
unicode_characters1(Encoding) ->
?SIZED(Size, unicode_characters1(Size, Encoding)).
unicode_characters1(0, _Encoding) ->
list(unicode_char());
unicode_characters1(Size, Encoding) ->
Chars = ?DELAY(resize(Size, unicode_characters(Encoding))),
%% TODO: Unicode characters can be of type `maybe_improper_list()'.
list(frequency([{10,unicode_char()}, {1, Chars}])).