1%%
2%% %CopyrightBegin%
3%%
4%% Copyright Ericsson AB 1999-2016. All Rights Reserved.
5%%
6%% Licensed under the Apache License, Version 2.0 (the "License");
7%% you may not use this file except in compliance with the License.
8%% You may obtain a copy of the License at
9%%
10%%     http://www.apache.org/licenses/LICENSE-2.0
11%%
12%% Unless required by applicable law or agreed to in writing, software
13%% distributed under the License is distributed on an "AS IS" BASIS,
14%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
15%% See the License for the specific language governing permissions and
16%% limitations under the License.
17%%
18%% %CopyrightEnd%
19%%
20
21-module(op_SUITE).
22
23-include_lib("common_test/include/ct.hrl").
24
25-export([all/0, suite/0,
26         bsl_bsr/1,logical/1,t_not/1,relop_simple/1,relop/1,complex_relop/1]).
27
28-export([]).
29-import(lists, [foldl/3,flatmap/2]).
30
31suite() ->
32    [{ct_hooks,[ts_install_cth]},
33     {timetrap, {minutes, 5}}].
34
35all() ->
36    [bsl_bsr, logical, t_not, relop_simple, relop,
37     complex_relop].
38
39%% Test the bsl and bsr operators.
40bsl_bsr(Config) when is_list(Config) ->
41    Vs = [unvalue(V) || V <- [-16#8000009-2,-1,0,1,2,73,16#8000000,bad,[]]],
42    %% Try to use less memory by splitting the cases
43
44    Cases1 = [{Op,X,Y} || Op <- ['bsl'], X <- Vs, Y <- Vs],
45    N1 = length(Cases1),
46    run_test_module(Cases1, false),
47
48    Cases2 = [{Op,X,Y} || Op <- ['bsr'], X <- Vs, Y <- Vs],
49    N2 = length(Cases2),
50    run_test_module(Cases2, false),
51    {comment,integer_to_list(N1 + N2) ++ " cases"}.
52
53%% Test the logical operators and internal BIFs.
54logical(Config) when is_list(Config) ->
55    Vs0 = [true,false,bad],
56    Vs = [unvalue(V) || V <- Vs0],
57    Cases = [{Op,X,Y} || Op <- ['and','or','xor'], X <- Vs, Y <- Vs],
58    run_test_module(Cases, false),
59    {comment,integer_to_list(length(Cases)) ++ " cases"}.
60
61%% Test the not operator and internal BIFs.
62t_not(Config) when is_list(Config) ->
63    Cases = [{'not',unvalue(V)} || V <- [true,false,42,bad]],
64    run_test_module(Cases, false),
65    {comment,integer_to_list(length(Cases)) ++ " cases"}.
66
67%% Test that simlpe relations between relation operators hold.
68relop_simple(Config) when is_list(Config) ->
69    Big1 = 19738924729729787487784874,
70    Big2 = 38374938373887374983978484,
71    F1 = float(Big1),
72    F2 = float(Big2),
73    T1 = erlang:make_tuple(3,87),
74    T2 = erlang:make_tuple(3,87),
75    Terms = [-F2,Big2,-F1,-Big1,-33,-33.0,0,0.0,42,42.0,Big1,F1,Big2,F2,a,b,
76             {T1,a},{T2,b},[T1,Big1],[T2,Big2]],
77
78    Combos = [{V1,V2} || V1 <- Terms, V2 <- Terms],
79
80    lists:foreach(fun({A,B}) -> relop_simple_do(A,B) end,
81                  Combos),
82
83    repeat(fun() ->
84                   Size = rand:uniform(100),
85                   Rnd1 = make_rand_term(Size),
86                   {Rnd2,0} = clone_and_mutate(Rnd1, rand:uniform(Size)),
87                   relop_simple_do(Rnd1,Rnd2)
88           end,
89           1000),
90    ok.
91
92relop_simple_do(V1,V2) ->
93    %%io:format("compare ~p\n   and  ~p\n",[V1,V2]),
94
95    L = V1 < V2,
96    L = not (V1 >= V2),
97    L = V2 > V1,
98    L = not (V2 =< V1),
99
100    G = V1 > V2,
101    G = not (V1 =< V2),
102    G = V2 < V1,
103    G = not (V2 >= V1),
104
105    ID = V1 =:= V2,
106    ID = V2 =:= V1,
107    ID = not (V1 =/= V2),
108    ID = not (V2 =/= V1),
109
110    EQ = V1 == V2,
111    EQ = V2 == V1,
112    EQ = not (V1 /= V2),
113    EQ = not (V2 /= V1),
114
115    case {L, EQ, ID, G, cmp_emu(V1,V2)} of
116        { true, false, false, false, -1} -> ok;
117        {false, true,  false, false,  0} -> ok;
118        {false, true,   true, false,  0} -> ok;
119        {false, false, false, true,  +1} -> ok
120    end.
121
122%% Emulate internal "cmp"
123cmp_emu(A,B) when is_tuple(A), is_tuple(B) ->
124    SA = size(A),
125    SB = size(B),
126    if SA =:= SB -> cmp_emu(tuple_to_list(A),tuple_to_list(B));
127       SA > SB -> +1;
128       SA < SB -> -1
129    end;
130cmp_emu([A|TA],[B|TB]) ->
131    case cmp_emu(A,B) of
132        0   -> cmp_emu(TA,TB);
133        CMP -> CMP
134    end;
135cmp_emu(A,B) ->
136    %% We cheat and use real "cmp" for the primitive types.
137    if A < B -> -1;
138       A > B -> +1;
139       true -> 0
140    end.
141
142make_rand_term(1) ->
143    make_rand_term_single();
144make_rand_term(Arity) ->
145    case rand:uniform(3) of
146        1 ->
147            make_rand_list(Arity);
148        2 ->
149            list_to_tuple(make_rand_list(Arity));
150        3 ->
151            {Car,Rest} = make_rand_term_rand_size(Arity),
152            [Car|make_rand_term(Rest)]
153    end.
154
155make_rand_term_single() ->
156    Range = 1 bsl rand:uniform(200),
157    case rand:uniform(12) of
158        1 -> random;
159        2 -> uniform;
160        3 -> rand:uniform(Range) - (Range div 2);
161        4 -> Range * (rand:uniform() - 0.5);
162        5 -> 0;
163        6 -> 0.0;
164        7 -> make_ref();
165        8 -> self();
166        9 -> term_to_binary(rand:uniform(Range));
167        10 -> fun(X) -> X*Range end;
168        11 -> fun(X) -> X/Range end;
169        12 -> []
170    end.
171
172make_rand_term_rand_size(1) ->
173    {make_rand_term(1), 0};
174make_rand_term_rand_size(MaxArity) ->
175    Arity = rand:uniform(MaxArity-1),
176    {make_rand_term(Arity), MaxArity-Arity}.
177
178make_rand_list(0) -> [];
179make_rand_list(Arity) ->
180    {Term, Rest} = make_rand_term_rand_size(Arity),
181    [Term | make_rand_list(Rest)].
182
183
184clone_and_mutate(Term, 0) ->
185    {clone(Term), 0};
186clone_and_mutate(_Term, 1) ->
187    {Mutation, _} = make_rand_term_rand_size(10), % MUTATE!
188    {Mutation, 0};
189clone_and_mutate(Term, Cnt) when is_tuple(Term) ->
190    {Clone,NewCnt} = clone_and_mutate(tuple_to_list(Term),Cnt),
191    {my_list_to_tuple(Clone), NewCnt};
192clone_and_mutate([Term|Tail], Cnt) ->
193    {Car,Cnt1} = clone_and_mutate(Term,Cnt),
194    {Cdr,Cnt2} = clone_and_mutate(Tail,Cnt1),
195    {[Car | Cdr], Cnt2};
196clone_and_mutate(Term, Cnt) ->
197    {clone(Term), Cnt-1}.
198
199clone(Term) ->
200    binary_to_term(term_to_binary(Term)).
201
202my_list_to_tuple(List) ->
203    try list_to_tuple(List)
204    catch
205        error:badarg ->
206            %%io:format("my_list_to_tuple got badarg exception.\n"),
207            list_to_tuple(purify_list(List))
208    end.
209
210purify_list(List) ->
211    lists:reverse(purify_list(List, [])).
212purify_list([], Acc) -> Acc;
213purify_list([H|T], Acc) -> purify_list(T, [H|Acc]);
214purify_list(Other, Acc) -> [Other|Acc].
215
216
217%% Test the relational operators and internal BIFs on literals.
218relop(Config) when is_list(Config) ->
219    Big1 = -38374938373887374983978484,
220    Big2 = 19738924729729787487784874,
221    F1 = float(Big1),
222    F2 = float(Big2),
223    Vs0 = [a,b,-33,-33.0,0,0.0,42,42.0,Big1,Big2,F1,F2],
224    Vs = [unvalue(V) || V <- Vs0],
225    Ops = ['==', '/=', '=:=', '=/=', '<', '=<', '>', '>='],
226    binop(Ops, Vs).
227
228%% Test the relational operators and internal BIFs on lists and tuples.
229complex_relop(Config) when is_list(Config) ->
230    Big = 99678557475484872464269855544643333,
231    Float = float(Big),
232    Vs0 = [an_atom,42.0,42,Big,Float],
233    Vs = flatmap(fun(X) -> [unvalue({X}),unvalue([X])] end, Vs0),
234    Ops = ['==', '/=', '=:=', '=/=', '<', '=<', '>', '>='],
235    binop(Ops, Vs).
236
237binop(Ops, Vs) ->
238    Run = fun(Op, N) -> Cases = [{Op,V1,V2} || V1 <- Vs, V2 <- Vs],
239                        run_test_module(Cases, true),
240                        N + length(Cases) end,
241    NumCases = foldl(Run, 0, Ops),
242    {comment,integer_to_list(NumCases) ++ " cases"}.
243
244run_test_module(Cases, GuardsOk) ->
245    Es = [expr(C) || C <- Cases],
246    Ok = unvalue(ok),
247    Gts = case GuardsOk of
248              true ->
249                  Ges = [guard_expr(C) || C <- Cases],
250                  lists:foldr(fun guard_test/2, [Ok], Ges);
251              false ->
252                  [Ok]
253          end,
254    Fun1 = make_function(guard_tests, Gts),
255    Bts = lists:foldr(fun body_test/2, [Ok], Es),
256    Fun2 = make_function(body_tests, Bts),
257    Bbts = lists:foldr(fun internal_bif/2, [Ok], Es),
258    Fun3 = make_function(bif_tests, Bbts),
259    Id = {function,1,id,1,[{clause,1,[{var,1,'I'}],[],[{var,1,'I'}]}]},
260    Module0 = make_module(op_tests, [Fun1,Fun2,Fun3,Id]),
261    Module = erl_parse:new_anno(Module0),
262    lists:foreach(fun(F) -> io:put_chars([erl_pp:form(F),"\n"]) end, Module),
263
264    %% Compile, load, and run the generated module.
265
266    Native = case test_server:is_native(?MODULE) of
267                 true -> [native];
268                 false -> []
269             end,
270    {ok,Mod,Code1} = compile:forms(Module, [time|Native]),
271    code:delete(Mod),
272    code:purge(Mod),
273    {module,Mod} = code:load_binary(Mod, Mod, Code1),
274    run_function(Mod, guard_tests),
275    run_function(Mod, body_tests),
276    run_function(Mod, bif_tests),
277
278    true = code:delete(Mod),
279    code:purge(Mod),
280
281    ok.
282
283expr({Op,X}) ->
284    E = {op,1,Op,{call,1,{atom,1,id},[X]}},
285    Res = eval([{op,1,Op,X}]),
286    {E,{Op,X},Res};
287expr({Op,X,Y}) ->
288    E = {op,1,Op,{call,1,{atom,1,id},[X]},Y},
289    Res = eval([{op,1,Op,X,Y}]),
290    {E,{Op,value(X),value(Y)},Res}.
291
292guard_expr({Op,X}) ->
293    E = {op,1,Op,X},
294    Res = eval([E]),
295    {E,{Op,X},Res};
296guard_expr({Op,X,Y}) ->
297    E = {op,1,Op,X,Y},
298    Res = eval([E]),
299    {E,{Op,value(X),value(Y)},Res}.
300
301run_function(Mod, Name) ->
302    case catch Mod:Name() of
303        {'EXIT',Reason} ->
304            io:format("~p", [get(last)]),
305            ct:fail({'EXIT',Reason});
306        _Other ->
307            ok
308    end.
309
310guard_test({E,Expr,Res}, Tail) ->
311    True = unvalue(true),
312    [save_term(Expr),
313     {match,1,unvalue(Res),
314      {'if',1,[{clause,1,[],[[E]],[True]},
315               {clause,1,[],[[True]],[unvalue(false)]}]}}|Tail].
316
317body_test({E,Expr,{'EXIT',_}}, Tail) ->
318    [save_term(Expr),
319     {match,1,{tuple,1,[unvalue('EXIT'), {var,1,'_'}]},
320      {'catch',1,E}}|Tail];
321body_test({E,Expr,Res}, Tail) ->
322    [save_term(Expr),
323     {match,1,unvalue(Res),E}|Tail].
324
325internal_bif({{op,_,Op,X},Expr,Res}, Tail) ->
326    internal_bif(Op, [X], Expr, Res, Tail);
327internal_bif({{op,_,Op,X,Y},Expr,Res}, Tail) ->
328    internal_bif(Op, [X,Y], Expr, Res, Tail).
329
330internal_bif(Op, Args, Expr, {'EXIT',_}, Tail) ->
331    [save_term(Expr),
332     {match,1,{tuple,1,[unvalue('EXIT'), {var,1,'_'}]},
333      {'catch',1,{call,1,{remote,1,{atom,1,erlang},unvalue(Op)},Args}}}|Tail];
334internal_bif(Op, Args, Expr, Res, Tail) ->
335    [save_term(Expr),
336     {match,1,unvalue(Res),
337      {call,1,{remote,1,{atom,1,erlang},unvalue(Op)},Args}}|Tail].
338
339save_term(Term) ->
340    {call,1,
341     {atom,1,put},
342     [{atom,1,last},unvalue(Term)]}.
343
344make_module(Name, Funcs) ->
345    [{attribute,1,module,Name},
346     {attribute,0,compile,export_all},
347     {attribute,0,compile,[{hipe,[{regalloc,linear_scan}]}]} |
348     Funcs ++ [{eof,0}]].
349
350make_function(Name, Body) ->
351    {function,1,Name,0,[{clause,1,[],[],Body}]}.
352
353eval(E0) ->
354    E = erl_parse:new_anno(E0),
355    case catch erl_eval:exprs(E, []) of
356        {'EXIT',Reason} -> {'EXIT',Reason};
357        {value,Val,_Bs} -> Val
358    end.
359
360unvalue(V) ->
361    Abstr = erl_parse:abstract(V),
362    erl_parse:anno_to_term(Abstr).
363
364value({nil,_}) -> [];
365value({integer,_,X}) -> X;
366value({string,_,X}) -> X;
367value({float,_,X})   -> X;
368value({atom,_,X})    -> X;
369value({tuple,_,Es}) ->
370    list_to_tuple(lists:map(fun(X) -> value(X) end, Es));
371value({cons,_,H,T}) ->
372    [value(H) | value(T)].
373
374repeat(_, 0) -> ok;
375repeat(Fun, N) ->
376    Fun(),
377    repeat(Fun, N-1).
378