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).