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