1: %% 2: %% %CopyrightBegin% 3: %% 4: %% Copyright Ericsson AB 1997-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(guard_no_opt_SUITE). 21: 22: -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, 23: init_per_group/2,end_per_group/2, bad_arith/1, bad_tuple/1, 24: test_heap_guards/1, guard_bifs/1, 25: type_tests/1,guard_bif_binary_part/1]). 26: 27: -include_lib("test_server/include/test_server.hrl"). 28: 29: -export([init/3]). 30: -import(lists, [member/2]). 31: 32: suite() -> [{ct_hooks,[ts_install_cth]}]. 33: 34: all() -> 35: [bad_arith, bad_tuple, test_heap_guards, guard_bifs, 36: type_tests, guard_bif_binary_part]. 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: bad_arith(doc) -> "Test that a bad arithmetic operation in a guard works correctly."; 55: bad_arith(Config) when is_list(Config) -> 56: ?line 5 = bad_arith1(2, 3), 57: ?line 10 = bad_arith1(1, infinity), 58: ?line 10 = bad_arith1(infinity, 1), 59: ok. 60: 61: bad_arith1(T1, T2) when T1+T2 < 10 -> 62: T1+T2; 63: bad_arith1(_, _) -> 64: 10. 65: 66: bad_tuple(doc) -> "Test that bad arguments to element/2 are handled correctly."; 67: bad_tuple(Config) when is_list(Config) -> 68: ?line error = bad_tuple1(a), 69: ?line error = bad_tuple1({a, b}), 70: ?line x = bad_tuple1({x, b}), 71: ?line y = bad_tuple1({a, b, y}), 72: ok. 73: 74: bad_tuple1(T) when element(1, T) == x -> 75: x; 76: bad_tuple1(T) when element(3, T) == y -> 77: y; 78: bad_tuple1(_) -> 79: error. 80: 81: test_heap_guards(doc) -> ""; 82: test_heap_guards(Config) when is_list(Config) -> 83: ?line Dog = test_server:timetrap(test_server:minutes(2)), 84: 85: ?line process_flag(trap_exit, true), 86: ?line Tuple = {a, tuple, is, built, here, xxx}, 87: ?line List = [a, list, is, built, here], 88: 89: ?line 'try'(fun a_case/1, [Tuple], [Tuple]), 90: ?line 'try'(fun a_case/1, [List], [List, List]), 91: ?line 'try'(fun a_case/1, [a], [a]), 92: 93: ?line 'try'(fun an_if/1, [Tuple], [Tuple]), 94: ?line 'try'(fun an_if/1, [List], [List, List]), 95: ?line 'try'(fun an_if/1, [a], [a]), 96: 97: ?line 'try'(fun receive_test/1, [Tuple], [Tuple]), 98: ?line 'try'(fun receive_test/1, [List], [List, List]), 99: ?line 'try'(fun receive_test/1, [a], [a]), 100: ?line test_server:timetrap_cancel(Dog). 101: 102: a_case(V) -> 103: case V of 104: T when T == {a, tuple, is, built, here, xxx} -> 105: [T]; 106: L when L == [a, list, is, built, here] -> 107: [L, L]; 108: a -> 109: [a] 110: end. 111: 112: an_if(V) -> 113: if 114: V == {a, tuple, is, built, here, xxx} -> 115: [V]; 116: V == [a, list, is, built, here] -> 117: [V, V]; 118: V == a -> 119: [a] 120: end. 121: 122: receive_test(V) -> 123: self() ! V, 124: a_receive(). 125: 126: a_receive() -> 127: receive 128: T when T == {a, tuple, is, built, here, xxx} -> 129: [T]; 130: L when L == [a, list, is, built, here] -> 131: [L, L]; 132: a -> 133: [a] 134: end. 135: 136: 'try'(Fun, Args, Result) -> 137: 'try'(512, Fun, Args, Result, []). 138: 139: 'try'(0, _, _, _, _) -> 140: ok; 141: 'try'(Iter, Fun, Args, Result, Filler) -> 142: Pid = spawn_link(?MODULE, init, [Fun,Args,list_to_tuple(Filler)]), 143: receive 144: {'EXIT', Pid, {result, Result}} -> 145: ?line 'try'(Iter-1, Fun, Args, Result, [0|Filler]); 146: {result, Other} -> 147: ?line io:format("Expected ~p; got ~p~n", [Result, Other]), 148: ?line test_server:fail(); 149: Other -> 150: ?line test_server:fail({unexpected_message, Other}) 151: end. 152: 153: init(Fun, Args, Filler) -> 154: Result = {result,apply(Fun, Args)}, 155: dummy(Filler), 156: exit(Result). 157: 158: dummy(_) -> 159: ok. 160: 161: -define(MASK_ERROR(EXPR),mask_error((catch (EXPR)))). 162: mask_error({'EXIT',{Err,_}}) -> 163: Err; 164: mask_error(Else) -> 165: Else. 166: 167: guard_bif_binary_part(doc) -> 168: ["Test the binary_part/2,3 guard BIF's extensively"]; 169: guard_bif_binary_part(Config) when is_list(Config) -> 170: %% Overflow tests that need to be unoptimized 171: ?line badarg = 172: ?MASK_ERROR( 173: binary_part(<<1,2,3>>,{16#FFFFFFFFFFFFFFFF, 174: -16#7FFFFFFFFFFFFFFF-1})), 175: ?line badarg = 176: ?MASK_ERROR( 177: binary_part(<<1,2,3>>,{16#FFFFFFFFFFFFFFFF, 178: 16#7FFFFFFFFFFFFFFF})), 179: F = fun(X) -> 180: Master = self(), 181: {Pid,Ref} = spawn_monitor( fun() -> 182: A = lists:duplicate(X,a), 183: B = [do_binary_part_guard() | A], 184: Master ! {self(),hd(B)}, 185: ok 186: end), 187: receive 188: {Pid,ok} -> 189: erlang:demonitor(Ref,[flush]), 190: ok; 191: Error -> 192: Error 193: end 194: end, 195: [ ok = F(N) || N <- lists:seq(1,10000) ], 196: ok. 197: 198: 199: do_binary_part_guard() -> 200: ?line 1 = bptest(<<1,2,3>>), 201: ?line 2 = bptest(<<2,1,3>>), 202: ?line error = bptest(<<1>>), 203: ?line error = bptest(<<>>), 204: ?line error = bptest(apa), 205: ?line 3 = bptest(<<2,3,3>>), 206: % With one variable (pos) 207: ?line 1 = bptest(<<1,2,3>>,1), 208: ?line 2 = bptest(<<2,1,3>>,1), 209: ?line error = bptest(<<1>>,1), 210: ?line error = bptest(<<>>,1), 211: ?line error = bptest(apa,1), 212: ?line 3 = bptest(<<2,3,3>>,1), 213: % With one variable (length) 214: ?line 1 = bptesty(<<1,2,3>>,1), 215: ?line 2 = bptesty(<<2,1,3>>,1), 216: ?line error = bptesty(<<1>>,1), 217: ?line error = bptesty(<<>>,1), 218: ?line error = bptesty(apa,1), 219: ?line 3 = bptesty(<<2,3,3>>,2), 220: % With one variable (whole tuple) 221: ?line 1 = bptestx(<<1,2,3>>,{1,1}), 222: ?line 2 = bptestx(<<2,1,3>>,{1,1}), 223: ?line error = bptestx(<<1>>,{1,1}), 224: ?line error = bptestx(<<>>,{1,1}), 225: ?line error = bptestx(apa,{1,1}), 226: ?line 3 = bptestx(<<2,3,3>>,{1,2}), 227: % With two variables 228: ?line 1 = bptest(<<1,2,3>>,1,1), 229: ?line 2 = bptest(<<2,1,3>>,1,1), 230: ?line error = bptest(<<1>>,1,1), 231: ?line error = bptest(<<>>,1,1), 232: ?line error = bptest(apa,1,1), 233: ?line 3 = bptest(<<2,3,3>>,1,2), 234: % Direct (autoimported) call, these will be evaluated by the compiler... 235: ?line <<2>> = binary_part(<<1,2,3>>,1,1), 236: ?line <<1>> = binary_part(<<2,1,3>>,1,1), 237: % Compiler warnings due to constant evaluation expected (3) 238: ?line badarg = ?MASK_ERROR(binary_part(<<1>>,1,1)), 239: ?line badarg = ?MASK_ERROR(binary_part(<<>>,1,1)), 240: ?line badarg = ?MASK_ERROR(binary_part(apa,1,1)), 241: ?line <<3,3>> = binary_part(<<2,3,3>>,1,2), 242: % Direct call through apply 243: ?line <<2>> = apply(erlang,binary_part,[<<1,2,3>>,1,1]), 244: ?line <<1>> = apply(erlang,binary_part,[<<2,1,3>>,1,1]), 245: % Compiler warnings due to constant evaluation expected (3) 246: ?line badarg = ?MASK_ERROR(apply(erlang,binary_part,[<<1>>,1,1])), 247: ?line badarg = ?MASK_ERROR(apply(erlang,binary_part,[<<>>,1,1])), 248: ?line badarg = ?MASK_ERROR(apply(erlang,binary_part,[apa,1,1])), 249: ?line <<3,3>> = apply(erlang,binary_part,[<<2,3,3>>,1,2]), 250: % Constant propagation 251: ?line Bin = <<1,2,3>>, 252: ?line ok = if 253: binary_part(Bin,1,1) =:= <<2>> -> 254: ok; 255: %% Compiler warning, clause cannot match (expected) 256: true -> 257: error 258: end, 259: ?line ok = if 260: binary_part(Bin,{1,1}) =:= <<2>> -> 261: ok; 262: %% Compiler warning, clause cannot match (expected) 263: true -> 264: error 265: end, 266: ok. 267: 268: 269: bptest(B) when length(B) =:= 1337 -> 270: 1; 271: bptest(B) when binary_part(B,{1,1}) =:= <<2>> -> 272: 1; 273: bptest(B) when erlang:binary_part(B,1,1) =:= <<1>> -> 274: 2; 275: bptest(B) when erlang:binary_part(B,{1,2}) =:= <<3,3>> -> 276: 3; 277: bptest(_) -> 278: error. 279: 280: bptest(B,A) when length(B) =:= A -> 281: 1; 282: bptest(B,A) when binary_part(B,{A,1}) =:= <<2>> -> 283: 1; 284: bptest(B,A) when erlang:binary_part(B,A,1) =:= <<1>> -> 285: 2; 286: bptest(B,A) when erlang:binary_part(B,{A,2}) =:= <<3,3>> -> 287: 3; 288: bptest(_,_) -> 289: error. 290: 291: bptestx(B,A) when length(B) =:= A -> 292: 1; 293: bptestx(B,A) when binary_part(B,A) =:= <<2>> -> 294: 1; 295: bptestx(B,A) when erlang:binary_part(B,A) =:= <<1>> -> 296: 2; 297: bptestx(B,A) when erlang:binary_part(B,A) =:= <<3,3>> -> 298: 3; 299: bptestx(_,_) -> 300: error. 301: 302: bptesty(B,A) when length(B) =:= A -> 303: 1; 304: bptesty(B,A) when binary_part(B,{1,A}) =:= <<2>> -> 305: 1; 306: bptesty(B,A) when erlang:binary_part(B,1,A) =:= <<1>> -> 307: 2; 308: bptesty(B,A) when erlang:binary_part(B,{1,A}) =:= <<3,3>> -> 309: 3; 310: bptesty(_,_) -> 311: error. 312: 313: bptest(B,A,_C) when length(B) =:= A -> 314: 1; 315: bptest(B,A,C) when binary_part(B,{A,C}) =:= <<2>> -> 316: 1; 317: bptest(B,A,C) when erlang:binary_part(B,A,C) =:= <<1>> -> 318: 2; 319: bptest(B,A,C) when erlang:binary_part(B,{A,C}) =:= <<3,3>> -> 320: 3; 321: bptest(_,_,_) -> 322: error. 323: 324: 325: guard_bifs(doc) -> "Test all guard bifs with nasty (but legal arguments)."; 326: guard_bifs(Config) when is_list(Config) -> 327: ?line Big = -237849247829874297658726487367328971246284736473821617265433, 328: ?line Float = 387924.874, 329: 330: %% Succeding use of guard bifs. 331: 332: ?line try_gbif('abs/1', Big, -Big), 333: ?line try_gbif('float/1', Big, float(Big)), 334: ?line try_gbif('float/1', Big, float(id(Big))), 335: ?line try_gbif('trunc/1', Float, 387924.0), 336: ?line try_gbif('round/1', Float, 387925.0), 337: ?line try_gbif('length/1', [], 0), 338: 339: ?line try_gbif('length/1', [a], 1), 340: ?line try_gbif('length/1', [a, b], 2), 341: ?line try_gbif('length/1', lists:seq(0, 31), 32), 342: 343: ?line try_gbif('hd/1', [a], a), 344: ?line try_gbif('hd/1', [a, b], a), 345: 346: ?line try_gbif('tl/1', [a], []), 347: ?line try_gbif('tl/1', [a, b], [b]), 348: ?line try_gbif('tl/1', [a, b, c], [b, c]), 349: 350: ?line try_gbif('size/1', {}, 0), 351: ?line try_gbif('size/1', {a}, 1), 352: ?line try_gbif('size/1', {a, b}, 2), 353: ?line try_gbif('size/1', {a, b, c}, 3), 354: ?line try_gbif('size/1', list_to_binary([]), 0), 355: ?line try_gbif('size/1', list_to_binary([1]), 1), 356: ?line try_gbif('size/1', list_to_binary([1, 2]), 2), 357: ?line try_gbif('size/1', list_to_binary([1, 2, 3]), 3), 358: 359: ?line try_gbif('bit_size/1', <<0:7>>, 7), 360: 361: ?line try_gbif('element/2', {x}, {1, x}), 362: ?line try_gbif('element/2', {x, y}, {1, x}), 363: ?line try_gbif('element/2', {x, y}, {2, y}), 364: 365: ?line try_gbif('self/0', 0, self()), 366: ?line try_gbif('node/0', 0, node()), 367: ?line try_gbif('node/1', self(), node()), 368: 369: %% Failing use of guard bifs. 370: 371: ?line try_fail_gbif('abs/1', Big, 1), 372: ?line try_fail_gbif('abs/1', [], 1), 373: 374: ?line try_fail_gbif('float/1', Big, 42), 375: ?line try_fail_gbif('float/1', [], 42), 376: 377: ?line try_fail_gbif('trunc/1', Float, 0.0), 378: ?line try_fail_gbif('trunc/1', [], 0.0), 379: 380: ?line try_fail_gbif('round/1', Float, 1.0), 381: ?line try_fail_gbif('round/1', [], a), 382: 383: ?line try_fail_gbif('length/1', [], 1), 384: ?line try_fail_gbif('length/1', [a], 0), 385: ?line try_fail_gbif('length/1', a, 0), 386: ?line try_fail_gbif('length/1', {a}, 0), 387: 388: ?line try_fail_gbif('hd/1', [], 0), 389: ?line try_fail_gbif('hd/1', [a], x), 390: ?line try_fail_gbif('hd/1', x, x), 391: 392: ?line try_fail_gbif('tl/1', [], 0), 393: ?line try_fail_gbif('tl/1', [a], x), 394: ?line try_fail_gbif('tl/1', x, x), 395: 396: ?line try_fail_gbif('size/1', {}, 1), 397: ?line try_fail_gbif('size/1', [], 0), 398: ?line try_fail_gbif('size/1', [a], 1), 399: ?line try_fail_gbif('size/1', fun() -> 1 end, 0), 400: ?line try_fail_gbif('size/1', fun() -> 1 end, 1), 401: 402: ?line try_fail_gbif('element/2', {}, {1, x}), 403: ?line try_fail_gbif('element/2', {x}, {1, y}), 404: ?line try_fail_gbif('element/2', [], {1, z}), 405: 406: ?line try_fail_gbif('self/0', 0, list_to_pid("<0.0.0>")), 407: ?line try_fail_gbif('node/0', 0, xxxx), 408: ?line try_fail_gbif('node/1', self(), xxx), 409: ?line try_fail_gbif('node/1', yyy, xxx), 410: ok. 411: 412: try_gbif(Id, X, Y) -> 413: case guard_bif(Id, X, Y) of 414: {Id, X, Y} -> 415: io:format("guard_bif(~p, ~p, ~p) -- ok", [Id, X, Y]); 416: Other -> 417: ?line ok = io:format("guard_bif(~p, ~p, ~p) -- bad result: ~p\n", 418: [Id, X, Y, Other]), 419: ?line test_server:fail() 420: end. 421: 422: try_fail_gbif(Id, X, Y) -> 423: case catch guard_bif(Id, X, Y) of 424: {'EXIT',{function_clause,[{?MODULE,guard_bif,[Id,X,Y],_}|_]}} -> 425: io:format("guard_bif(~p, ~p, ~p) -- ok", [Id,X,Y]); 426: Other -> 427: ?line ok = io:format("guard_bif(~p, ~p, ~p) -- bad result: ~p\n", 428: [Id, X, Y, Other]), 429: ?line test_server:fail() 430: end. 431: 432: guard_bif('abs/1', X, Y) when abs(X) == Y -> 433: {'abs/1', X, Y}; 434: guard_bif('float/1', X, Y) when float(X) == Y -> 435: {'float/1', X, Y}; 436: guard_bif('trunc/1', X, Y) when trunc(X) == Y -> 437: {'trunc/1', X, Y}; 438: guard_bif('round/1', X, Y) when round(X) == Y -> 439: {'round/1', X, Y}; 440: guard_bif('length/1', X, Y) when length(X) == Y -> 441: {'length/1', X, Y}; 442: guard_bif('hd/1', X, Y) when hd(X) == Y -> 443: {'hd/1', X, Y}; 444: guard_bif('tl/1', X, Y) when tl(X) == Y -> 445: {'tl/1', X, Y}; 446: guard_bif('size/1', X, Y) when size(X) == Y -> 447: {'size/1', X, Y}; 448: guard_bif('bit_size/1', X, Y) when bit_size(X) == Y -> 449: {'bit_size/1', X, Y}; 450: guard_bif('element/2', X, {Pos, Expected}) when element(Pos, X) == Expected -> 451: {'element/2', X, {Pos, Expected}}; 452: guard_bif('self/0', X, Y) when self() == Y -> 453: {'self/0', X, Y}; 454: guard_bif('node/0', X, Y) when node() == Y -> 455: {'node/0', X, Y}; 456: guard_bif('node/1', X, Y) when node(X) == Y -> 457: {'node/1', X, Y}. 458: 459: type_tests(doc) -> "Test the type tests."; 460: type_tests(Config) when is_list(Config) -> 461: ?line Types = all_types(), 462: ?line Tests = type_test_desc(), 463: ?line put(errors, 0), 464: ?line put(violations, 0), 465: ?line type_tests(Tests, Types), 466: ?line case {get(errors), get(violations)} of 467: {0, 0} -> 468: ok; 469: {0, N} -> 470: {comment, integer_to_list(N) ++ " standard violation(s)"}; 471: {Errors, Violations} -> 472: io:format("~p sub test(s) failed, ~p violation(s)", 473: [Errors, Violations]), 474: ?line test_server:fail() 475: end. 476: 477: type_tests([{Test, AllowedTypes}| T], AllTypes) -> 478: type_tests(Test, AllTypes, AllowedTypes), 479: type_tests(T, AllTypes); 480: type_tests([], _) -> 481: ok. 482: 483: type_tests(Test, [Type|T], Allowed) -> 484: {TypeTag, Value} = Type, 485: case member(TypeTag, Allowed) of 486: true -> 487: case catch type_test(Test, Value) of 488: Test -> 489: ok; 490: _Other -> 491: io:format("Test ~p(~p) failed", [Test, Value]), 492: put(errors, get(errors) + 1) 493: end; 494: false -> 495: case catch type_test(Test, Value) of 496: {'EXIT',{function_clause, 497: [{?MODULE,type_test,[Test,Value],Loc}|_]}} 498: when is_list(Loc) -> 499: ok; 500: {'EXIT',Other} -> 501: ?line test_server:fail({unexpected_error_reason,Other}); 502: tuple when is_function(Value) -> 503: io:format("Standard violation: Test ~p(~p) should fail", 504: [Test, Value]), 505: put(violations, get(violations) + 1); 506: _Other -> 507: io:format("Test ~p(~p) succeeded (should fail)", [Test, Value]), 508: put(errors, get(errors) + 1) 509: end 510: end, 511: type_tests(Test, T, Allowed); 512: type_tests(_, [], _) -> 513: ok. 514: 515: all_types() -> 516: [{small, 42}, 517: {big, 392742928742947293873938792874019287447829874290742}, 518: {float, 3.14156}, 519: {nil, []}, 520: {cons, [a]}, 521: {tuple, {a, b}}, 522: {atom, xxxx}, 523: {ref, make_ref()}, 524: {pid, self()}, 525: {port, open_port({spawn, efile}, [])}, 526: {function, fun(_) -> "" end}, 527: {function, fun erlang:abs/1}, 528: {binary, list_to_binary([])}, 529: {bitstring, <<0:7>>}]. 530: 531: type_test_desc() -> 532: [{binary, [binary]}, 533: {bitstring, [binary, bitstring]}, 534: {integer, [small, big]}, 535: {float, [float]}, 536: {number, [small, big, float]}, 537: {atom, [atom]}, 538: {list, [cons, nil]}, 539: {nonempty_list, [cons]}, 540: {nil, [nil]}, 541: {tuple, [tuple]}, 542: {pid, [pid]}, 543: {port, [port]}, 544: {reference, [ref]}, 545: {function, [function]}]. 546: 547: type_test(integer, X) when is_integer(X) -> 548: integer; 549: type_test(float, X) when is_float(X) -> 550: float; 551: type_test(number, X) when is_number(X) -> 552: number; 553: type_test(atom, X) when is_atom(X) -> 554: atom; 555: type_test(list, X) when is_list(X) -> 556: list; 557: type_test(nonempty_list, [_]) -> 558: nonempty_list; 559: type_test(nil, []) -> 560: nil; 561: type_test(tuple, X) when is_tuple(X) -> 562: tuple; 563: type_test(pid, X) when is_pid(X) -> 564: pid; 565: type_test(reference, X) when is_reference(X) -> 566: reference; 567: type_test(port, X) when is_port(X) -> 568: port; 569: type_test(binary, X) when is_binary(X) -> 570: binary; 571: type_test(bitstring, X) when is_bitstring(X) -> 572: bitstring; 573: type_test(function, X) when is_function(X) -> 574: function. 575: 576: id(I) -> I.