The R13B03 release.OTP_R13B03

1 files changed, 390 insertions, 0 deletions

diff --git a/erts/emulator/test/guard_SUITE.erl b/erts/emulator/test/guard_SUITE.erl
new file mode 100644
index 0000000000..23482a20d7
--- /dev/null
+++ b/erts/emulator/test/guard_SUITE.erl
@@ -0,0 +1,390 @@
+%%
+%% %CopyrightBegin%
+%% 
+%% Copyright Ericsson AB 1997-2009. All Rights Reserved.
+%% 
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%% 
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%% 
+%% %CopyrightEnd%
+%%
+
+-module(guard_SUITE).
+
+-export([all/1, bad_arith/1, bad_tuple/1, test_heap_guards/1, guard_bifs/1,
+	 type_tests/1]).
+
+-include("test_server.hrl").
+
+-export([init/3]).
+-import(lists, [member/2]).
+
+all(suite) -> [bad_arith, bad_tuple, test_heap_guards, guard_bifs, type_tests].
+
+bad_arith(doc) -> "Test that a bad arithmetic operation in a guard works correctly.";
+bad_arith(Config) when is_list(Config) ->
+    ?line 5 = bad_arith1(2, 3),
+    ?line 10 = bad_arith1(1, infinity),
+    ?line 10 = bad_arith1(infinity, 1),
+    ok.
+
+bad_arith1(T1, T2) when T1+T2 < 10 ->
+    T1+T2;
+bad_arith1(_, _) ->
+    10.
+
+bad_tuple(doc) -> "Test that bad arguments to element/2 are handled correctly.";
+bad_tuple(Config) when is_list(Config) ->
+    ?line error = bad_tuple1(a),
+    ?line error = bad_tuple1({a, b}),
+    ?line x = bad_tuple1({x, b}),
+    ?line y = bad_tuple1({a, b, y}),
+    ok.
+
+bad_tuple1(T) when element(1, T) == x ->
+    x;
+bad_tuple1(T) when element(3, T) == y ->
+    y;
+bad_tuple1(_) ->
+    error.
+
+test_heap_guards(doc) -> "";
+test_heap_guards(Config) when is_list(Config) ->
+    ?line Dog = test_server:timetrap(test_server:minutes(2)),
+    
+    ?line process_flag(trap_exit, true),
+    ?line Tuple = {a, tuple, is, built, here, xxx},
+    ?line List = [a, list, is, built, here],
+
+    ?line 'try'(fun a_case/1, [Tuple], [Tuple]),
+    ?line 'try'(fun a_case/1, [List], [List, List]),
+    ?line 'try'(fun a_case/1, [a], [a]),
+
+    ?line 'try'(fun an_if/1, [Tuple], [Tuple]),
+    ?line 'try'(fun an_if/1, [List], [List, List]),
+    ?line 'try'(fun an_if/1, [a], [a]),
+
+    ?line 'try'(fun receive_test/1, [Tuple], [Tuple]),
+    ?line 'try'(fun receive_test/1, [List], [List, List]),
+    ?line 'try'(fun receive_test/1, [a], [a]),
+    ?line test_server:timetrap_cancel(Dog).
+
+a_case(V) ->
+    case V of
+	T when T == {a, tuple, is, built, here, xxx} ->
+	    [T];
+	L when L == [a, list, is, built, here] ->
+	    [L, L];
+	a ->
+	    [a]
+    end.
+
+an_if(V) ->
+    if
+	V == {a, tuple, is, built, here, xxx} ->
+	    [V];
+	V == [a, list, is, built, here] ->
+	    [V, V];
+	V == a ->
+	    [a]
+    end.
+
+receive_test(V) ->
+    self() ! V,
+    a_receive().
+
+a_receive() ->
+    receive
+	T when T == {a, tuple, is, built, here, xxx} ->
+	    [T];
+	L when L == [a, list, is, built, here] ->
+	    [L, L];
+	a ->
+	    [a]
+    end.
+
+'try'(Fun, Args, Result) ->
+    'try'(512, Fun, Args, Result, []).
+
+'try'(0, _, _, _, _) ->
+    ok;
+'try'(Iter, Fun, Args, Result, Filler) ->
+    Pid = spawn_link(?MODULE, init, [Fun,Args,list_to_tuple(Filler)]),
+    receive
+	{'EXIT', Pid, {result, Result}} ->
+	    ?line 'try'(Iter-1, Fun, Args, Result, [0|Filler]);
+	{result, Other} ->
+	    ?line io:format("Expected ~p; got ~p~n", [Result, Other]),
+	    ?line test_server:fail();
+	Other ->
+	    ?line test_server:fail({unexpected_message, Other})
+    end.
+
+init(Fun, Args, Filler) ->
+    Result = {result,apply(Fun, Args)},
+    dummy(Filler),
+    exit(Result).
+
+dummy(_) ->
+    ok.
+
+guard_bifs(doc) -> "Test all guard bifs with nasty (but legal arguments).";
+guard_bifs(Config) when is_list(Config) ->
+    ?line Big = -237849247829874297658726487367328971246284736473821617265433,
+    ?line Float = 387924.874,
+
+    %% Succeding use of guard bifs.
+
+    ?line try_gbif('abs/1', Big, -Big),
+    ?line try_gbif('float/1', Big, float(Big)),
+    ?line try_gbif('float/1', Big, float(id(Big))),
+    ?line try_gbif('trunc/1', Float, 387924.0),
+    ?line try_gbif('round/1', Float, 387925.0),
+    ?line try_gbif('length/1', [], 0),
+
+    ?line try_gbif('length/1', [a], 1),
+    ?line try_gbif('length/1', [a, b], 2),
+    ?line try_gbif('length/1', lists:seq(0, 31), 32),
+
+    ?line try_gbif('hd/1', [a], a),
+    ?line try_gbif('hd/1', [a, b], a),
+
+    ?line try_gbif('tl/1', [a], []),
+    ?line try_gbif('tl/1', [a, b], [b]),
+    ?line try_gbif('tl/1', [a, b, c], [b, c]),
+
+    ?line try_gbif('size/1', {}, 0),
+    ?line try_gbif('size/1', {a}, 1),
+    ?line try_gbif('size/1', {a, b}, 2),
+    ?line try_gbif('size/1', {a, b, c}, 3),
+    ?line try_gbif('size/1', list_to_binary([]), 0),
+    ?line try_gbif('size/1', list_to_binary([1]), 1),
+    ?line try_gbif('size/1', list_to_binary([1, 2]), 2),
+    ?line try_gbif('size/1', list_to_binary([1, 2, 3]), 3),
+
+    ?line try_gbif('bit_size/1', <<0:7>>, 7),
+
+    ?line try_gbif('element/2', {x}, {1, x}),
+    ?line try_gbif('element/2', {x, y}, {1, x}),
+    ?line try_gbif('element/2', {x, y}, {2, y}),
+
+    ?line try_gbif('self/0', 0, self()),
+    ?line try_gbif('node/0', 0, node()),
+    ?line try_gbif('node/1', self(), node()),
+
+    %% Failing use of guard bifs.
+
+    ?line try_fail_gbif('abs/1', Big, 1),
+    ?line try_fail_gbif('abs/1', [], 1),
+
+    ?line try_fail_gbif('float/1', Big, 42),
+    ?line try_fail_gbif('float/1', [], 42),
+
+    ?line try_fail_gbif('trunc/1', Float, 0.0),
+    ?line try_fail_gbif('trunc/1', [], 0.0),
+
+    ?line try_fail_gbif('round/1', Float, 1.0),
+    ?line try_fail_gbif('round/1', [], a),
+
+    ?line try_fail_gbif('length/1', [], 1),
+    ?line try_fail_gbif('length/1', [a], 0),
+    ?line try_fail_gbif('length/1', a, 0),
+    ?line try_fail_gbif('length/1', {a}, 0),
+
+    ?line try_fail_gbif('hd/1', [], 0),
+    ?line try_fail_gbif('hd/1', [a], x),
+    ?line try_fail_gbif('hd/1', x, x),
+
+    ?line try_fail_gbif('tl/1', [], 0),
+    ?line try_fail_gbif('tl/1', [a], x),
+    ?line try_fail_gbif('tl/1', x, x),
+
+    ?line try_fail_gbif('size/1', {}, 1),
+    ?line try_fail_gbif('size/1', [], 0),
+    ?line try_fail_gbif('size/1', [a], 1),
+    ?line try_fail_gbif('size/1', fun() -> 1 end, 0),
+    ?line try_fail_gbif('size/1', fun() -> 1 end, 1),
+
+    ?line try_fail_gbif('element/2', {}, {1, x}),
+    ?line try_fail_gbif('element/2', {x}, {1, y}),
+    ?line try_fail_gbif('element/2', [], {1, z}),
+
+    ?line try_fail_gbif('self/0', 0, list_to_pid("<0.0.0>")),
+    ?line try_fail_gbif('node/0', 0, xxxx),
+    ?line try_fail_gbif('node/1', self(), xxx),
+    ?line try_fail_gbif('node/1', yyy, xxx),
+    ok.
+
+try_gbif(Id, X, Y) ->
+    case guard_bif(Id, X, Y) of
+	{Id, X, Y} ->
+	    io:format("guard_bif(~p, ~p, ~p) -- ok", [Id, X, Y]);
+	Other ->
+	    ?line ok = io:format("guard_bif(~p, ~p, ~p) -- bad result: ~p\n",
+				 [Id, X, Y, Other]),
+	    ?line test_server:fail()
+    end.
+
+try_fail_gbif(Id, X, Y) ->
+    case catch guard_bif(Id, X, Y) of
+	{'EXIT', {function_clause,[{?MODULE,guard_bif,[Id,X,Y]}|_]}} ->
+	    io:format("guard_bif(~p, ~p, ~p) -- ok", [Id,X,Y]);
+	Other ->
+	    ?line ok = io:format("guard_bif(~p, ~p, ~p) -- bad result: ~p\n",
+				 [Id, X, Y, Other]),
+	    ?line test_server:fail()
+    end.
+
+guard_bif('abs/1', X, Y) when abs(X) == Y ->
+    {'abs/1', X, Y};
+guard_bif('float/1', X, Y) when float(X) == Y ->
+    {'float/1', X, Y};
+guard_bif('trunc/1', X, Y) when trunc(X) == Y ->
+    {'trunc/1', X, Y};
+guard_bif('round/1', X, Y) when round(X) == Y ->
+    {'round/1', X, Y};
+guard_bif('length/1', X, Y) when length(X) == Y ->
+    {'length/1', X, Y};
+guard_bif('hd/1', X, Y) when hd(X) == Y ->
+    {'hd/1', X, Y};
+guard_bif('tl/1', X, Y) when tl(X) == Y ->
+    {'tl/1', X, Y};
+guard_bif('size/1', X, Y) when size(X) == Y ->
+    {'size/1', X, Y};
+guard_bif('bit_size/1', X, Y) when bit_size(X) == Y ->
+    {'bit_size/1', X, Y};
+guard_bif('element/2', X, {Pos, Expected}) when element(Pos, X) == Expected ->
+    {'element/2', X, {Pos, Expected}};
+guard_bif('self/0', X, Y) when self() == Y ->
+    {'self/0', X, Y};
+guard_bif('node/0', X, Y) when node() == Y ->
+    {'node/0', X, Y};
+guard_bif('node/1', X, Y) when node(X) == Y ->
+    {'node/1', X, Y}.
+
+type_tests(doc) -> "Test the type tests.";
+type_tests(Config) when is_list(Config) ->
+    ?line Types = all_types(),
+    ?line Tests = type_test_desc(),
+    ?line put(errors, 0),
+    ?line put(violations, 0),
+    ?line type_tests(Tests, Types),
+    ?line case {get(errors), get(violations)} of
+	      {0, 0} ->
+		  ok;
+	      {0, N} ->
+		  {comment, integer_to_list(N) ++ " standard violation(s)"};
+	      {Errors, Violations} ->
+		  io:format("~p sub test(s) failed, ~p violation(s)",
+			    [Errors, Violations]),
+		  ?line test_server:fail()
+	  end.
+
+type_tests([{Test, AllowedTypes}| T], AllTypes) ->
+    type_tests(Test, AllTypes, AllowedTypes),
+    type_tests(T, AllTypes);
+type_tests([], _) ->
+    ok.
+
+type_tests(Test, [Type|T], Allowed) ->
+    {TypeTag, Value} = Type,
+    case member(TypeTag, Allowed) of
+	true ->
+	    case catch type_test(Test, Value) of
+		Test ->
+		    ok;
+		_Other ->
+		    io:format("Test ~p(~p) failed", [Test, Value]),
+		    put(errors, get(errors) + 1)
+	    end;
+	false ->
+	    case catch type_test(Test, Value) of
+		{'EXIT', {function_clause, {?MODULE,type_test,[Test,Value]}}} ->
+		    ok;
+		{'EXIT', {function_clause,[{?MODULE,type_test,[Test,Value]}|_]}} ->
+		    ok;
+		{'EXIT',Other} ->
+		    ?line test_server:fail({unexpected_error_reason,Other});
+		tuple when is_function(Value) ->
+		    io:format("Standard violation: Test ~p(~p) should fail",
+			      [Test, Value]),
+		    put(violations, get(violations) + 1);
+		_Other ->
+		    io:format("Test ~p(~p) succeeded (should fail)", [Test, Value]),
+		    put(errors, get(errors) + 1)
+	    end
+    end,
+    type_tests(Test, T, Allowed);
+type_tests(_, [], _) ->
+    ok.
+
+all_types() ->
+    [{small, 42},
+     {big, 392742928742947293873938792874019287447829874290742},
+     {float, 3.14156},
+     {nil, []},
+     {cons, [a]},
+     {tuple, {a, b}},
+     {atom, xxxx},
+     {ref, make_ref()},
+     {pid, self()},
+     {port, open_port({spawn, efile}, [])},
+     {function, fun(_) -> "" end},
+     {function, fun erlang:abs/1},
+     {binary, list_to_binary([])},
+     {bitstring, <<0:7>>}].
+
+type_test_desc() ->
+    [{binary, [binary]},
+     {bitstring, [binary, bitstring]},
+     {integer, [small, big]},
+     {float, [float]},
+     {number, [small, big, float]},
+     {atom, [atom]},
+     {list, [cons, nil]},
+     {nonempty_list, [cons]},
+     {nil, [nil]},
+     {tuple, [tuple]},
+     {pid, [pid]},
+     {port, [port]},
+     {reference, [ref]},
+     {function, [function]}].
+
+type_test(integer, X) when is_integer(X) ->
+    integer;
+type_test(float, X) when is_float(X) ->
+    float;
+type_test(number, X) when is_number(X) ->
+    number;
+type_test(atom, X) when is_atom(X) ->
+    atom;
+type_test(list, X) when is_list(X) ->
+    list;
+type_test(nonempty_list, [_]) ->
+    nonempty_list;
+type_test(nil, []) ->
+    nil;
+type_test(tuple, X) when is_tuple(X) ->
+    tuple;
+type_test(pid, X) when is_pid(X) ->
+    pid;
+type_test(reference, X) when is_reference(X) ->
+    reference;
+type_test(port, X) when is_port(X) ->
+    port;
+type_test(binary, X) when is_binary(X) ->
+    binary;
+type_test(bitstring, X) when is_bitstring(X) ->
+    bitstring;
+type_test(function, X) when is_function(X) ->
+    function.
+
+id(I) -> I.