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