Three more tests added

3 files changed, 230 insertions, 0 deletions

diff --git a/lib/hipe/test/basic_SUITE_data/basic_bugs_hipe.erl b/lib/hipe/test/basic_SUITE_data/basic_bugs_hipe.erl
index 01add52cb0..e70c25c905 100644
--- a/lib/hipe/test/basic_SUITE_data/basic_bugs_hipe.erl
+++ b/lib/hipe/test/basic_SUITE_data/basic_bugs_hipe.erl
@@ -10,6 +10,7 @@
 
 test() ->
   ok = test_ets_bifs(),
+  ok = test_szar_bug(),
   ok = test_bit_shift(),
   ok = test_match_big_list(),
   ok = test_unsafe_bsl(),
@@ -110,6 +111,86 @@ do_n_times(Fun, N) ->
   do_n_times(Fun, N - 1).
 
 %%-----------------------------------------------------------------------
+%% From: Jozsef Berces (PR/ECZ)
+%% Date: Feb 19, 2004
+%%
+%% Program which was added to the testsuite as a result of another bug
+%% report involving tuples as funs.  Thanks God, these are no longer
+%% supported, but the following is a good test for testing calling
+%% native code funs from BEAM code (lists:map, lists:filter, ...).
+%%-----------------------------------------------------------------------
+
+test_szar_bug() ->
+  ["A","B","C"] = smartconcat([], "H'A, H'B, H'C"),
+  ok.
+
+smartconcat(B, L) ->
+  LL = tokenize(L, $,),
+  NewlineDel = fun (X) -> killcontrol(X) end,
+  StripFun = fun (X) -> string:strip(X) end,
+  LL2 = lists:map(NewlineDel, lists:map(StripFun, LL)),
+  EmptyDel = fun(X) ->
+		 case string:len(X) of
+		   0 -> false;
+		   _ -> true
+		 end
+	     end,
+  LL3 = lists:filter(EmptyDel, LL2),
+  HexFormat = fun(X, Acc) ->
+		  case string:str(X, "H'") of
+		    1 ->
+		      case checkhex(string:substr(X, 3)) of
+			{ok, Y} ->
+			  {Y, Acc};
+			_ ->
+			  {X, Acc + 1}
+		      end;
+                    _ ->
+		      {X, Acc + 1}
+		  end
+	      end,
+  {LL4,_Ret} = lists:mapfoldl(HexFormat, 0, LL3),
+  lists:append(B, lists:sublist(LL4, lists:max([0, 25 - length(B)]))).
+
+checkhex(L) ->
+  checkhex(L, "").
+
+checkhex([H | T], N) when H >= $0, H =< $9 ->
+  checkhex(T, [H | N]);
+checkhex([H | T], N) when H >= $A, H =< $F ->
+  checkhex(T, [H | N]);
+checkhex([H | T], N) when H =< 32 ->
+  checkhex(T, N);
+checkhex([_ | _], _) ->
+  {error, ""};
+checkhex([], N) ->
+  {ok, lists:reverse(N)}.
+
+killcontrol([C | S]) when C < 32 ->
+  killcontrol(S);
+killcontrol([C | S]) ->
+  [C | killcontrol(S)];
+killcontrol([]) ->
+  [].
+
+tokenize(L, C) ->
+  tokenize(L, C, [], []).
+
+tokenize([C | T], C, A, B) ->
+  case A of
+   [] ->
+      tokenize(T, C, [], B);
+    _ ->
+      tokenize(T, C, [], [lists:reverse(A) | B])
+  end;
+tokenize([H | T], C, A, B) ->
+  tokenize(T, C, [H | A], B);
+tokenize(_, _, [], B) ->
+  lists:reverse(B);
+tokenize(_, _, A, B) ->
+  lists:reverse([lists:reverse(A) | B]).
+
+%%-----------------------------------------------------------------------
 %% From: Niclas Pehrsson
 %% Date: Apr 20, 2006
 %%
diff --git a/lib/hipe/test/basic_SUITE_data/basic_exceptions.erl b/lib/hipe/test/basic_SUITE_data/basic_exceptions.erl
index 082e805580..229a0516dc 100644
--- a/lib/hipe/test/basic_SUITE_data/basic_exceptions.erl
+++ b/lib/hipe/test/basic_SUITE_data/basic_exceptions.erl
@@ -21,6 +21,7 @@ test() ->
   ok = test_catches_merged(),
   ok = test_pending_errors(),
   ok = test_bad_fun_call(),
+  ok = test_guard_bif(),
   ok.
 
 %%--------------------------------------------------------------------
@@ -324,3 +325,141 @@ bad_call_fc(Fun) ->
       io:format("~p(~p) -> ~p\n", [Fun, Args, Res]),
       exit({bad_result, Other})
   end.
+
+%%--------------------------------------------------------------------
+%% Taken from guard_SUITE.erl
+%%
+%% Tests correct handling of exceptions by calling guard BIFs with
+%% nasty (but legal arguments).
+%%--------------------------------------------------------------------
+
+test_guard_bif() ->
+  Big = -237849247829874297658726487367328971246284736473821617265433,
+  Float = 387924.874,
+
+  %% Succeding use of guard bifs.
+
+  try_gbif('abs/1', Big, -Big),
+  try_gbif('float/1', Big, float(Big)),
+  try_gbif('trunc/1', Float, 387924.0),
+  try_gbif('round/1', Float, 387925.0),
+  try_gbif('length/1', [], 0),
+
+  try_gbif('length/1', [a], 1),
+  try_gbif('length/1', [a, b], 2),
+  try_gbif('length/1', lists:seq(0, 31), 32),
+
+  try_gbif('hd/1', [a], a),
+  try_gbif('hd/1', [a, b], a),
+
+  try_gbif('tl/1', [a], []),
+  try_gbif('tl/1', [a, b], [b]),
+  try_gbif('tl/1', [a, b, c], [b, c]),
+
+  try_gbif('size/1', {}, 0),
+  try_gbif('size/1', {a}, 1),
+  try_gbif('size/1', {a, b}, 2),
+  try_gbif('size/1', {a, b, c}, 3),
+  try_gbif('size/1', list_to_binary([]), 0),
+  try_gbif('size/1', list_to_binary([1]), 1),
+  try_gbif('size/1', list_to_binary([1, 2]), 2),
+  try_gbif('size/1', list_to_binary([1, 2, 3]), 3),
+
+  try_gbif('element/2', {x}, {1, x}),
+  try_gbif('element/2', {x, y}, {1, x}),
+  try_gbif('element/2', {x, y}, {2, y}),
+
+  try_gbif('self/0', 0, self()),
+  try_gbif('node/0', 0, node()),
+  try_gbif('node/1', self(), node()),
+
+  %% Failing use of guard bifs.
+
+  try_fail_gbif('abs/1', Big, 1),
+  try_fail_gbif('abs/1', [], 1),
+
+  try_fail_gbif('float/1', Big, 42),
+  try_fail_gbif('float/1', [], 42),
+
+  try_fail_gbif('trunc/1', Float, 0.0),
+  try_fail_gbif('trunc/1', [], 0.0),
+
+  try_fail_gbif('round/1', Float, 1.0),
+  try_fail_gbif('round/1', [], a),
+
+  try_fail_gbif('length/1', [], 1),
+  try_fail_gbif('length/1', [a], 0),
+  try_fail_gbif('length/1', a, 0),
+  try_fail_gbif('length/1', {a}, 0),
+
+  try_fail_gbif('hd/1', [], 0),
+  try_fail_gbif('hd/1', [a], x),
+  try_fail_gbif('hd/1', x, x),
+
+  try_fail_gbif('tl/1', [], 0),
+  try_fail_gbif('tl/1', [a], x),
+  try_fail_gbif('tl/1', x, x),
+
+  try_fail_gbif('size/1', {}, 1),
+  try_fail_gbif('size/1', [], 0),
+  try_fail_gbif('size/1', [a], 1),
+  try_fail_gbif('size/1', fun() -> 1 end, 0),
+  try_fail_gbif('size/1', fun() -> 1 end, 1),
+
+  try_fail_gbif('element/2', {}, {1, x}),
+  try_fail_gbif('element/2', {x}, {1, y}),
+  try_fail_gbif('element/2', [], {1, z}),
+
+  try_fail_gbif('self/0', 0, list_to_pid("<0.0.0>")),
+  try_fail_gbif('node/0', 0, xxxx),
+  try_fail_gbif('node/1', self(), xxx),
+  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\n", [Id, X, Y]);
+      ok;
+    Other ->
+      ok = io:format("guard_bif(~p, ~p, ~p) -- bad result: ~p\n",
+		     [Id, X, Y, Other]),
+      exit({bad_result,try_gbif})
+  end.
+
+try_fail_gbif(Id, X, Y) ->
+  case catch guard_bif(Id, X, Y) of
+    %% {'EXIT', {function_clause,[{?MODULE,guard_bif,[Id,X,Y]}|_]}} ->
+    {'EXIT', {function_clause,_}} ->  % in HiPE, a trace is not generated
+      %% io:format("guard_bif(~p, ~p, ~p) -- ok\n", [Id,X,Y]);
+      ok;
+    Other ->
+      ok = io:format("guard_bif(~p, ~p, ~p) -- bad result: ~p\n",
+			   [Id, X, Y, Other]),
+      exit({bad_result,try_fail_gbif})
+  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('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}.
diff --git a/lib/hipe/test/basic_SUITE_data/basic_pattern_match.erl b/lib/hipe/test/basic_SUITE_data/basic_pattern_match.erl
index 9922b34415..93240354a7 100644
--- a/lib/hipe/test/basic_SUITE_data/basic_pattern_match.erl
+++ b/lib/hipe/test/basic_SUITE_data/basic_pattern_match.erl
@@ -11,6 +11,7 @@
 
 test() ->
   ok = test_hello_world(),
+  ok = test_list_plus_plus_match(),
   ok.
 
 %%--------------------------------------------------------------------
@@ -34,3 +35,12 @@ gimme(binary) ->
   <<"hello world">>.
 
 %%--------------------------------------------------------------------
+%% Makes sure that pattern matching expressions involving ++ work OK.
+%% The third expression caused a problem in the Erlang shell of R11B-5.
+%% It worked OK in both interpreted and compiled code.
+
+test_list_plus_plus_match() ->
+  ok = (fun("X" ++ _) -> ok end)("X"),
+  ok = (fun([$X | _]) -> ok end)("X"),
+  ok = (fun([$X] ++ _) -> ok end)("X"),
+  ok.