aboutsummaryrefslogtreecommitdiffstats
path: root/lib/hipe
diff options
context:
space:
mode:
Diffstat (limited to 'lib/hipe')
-rw-r--r--lib/hipe/test/basic_SUITE_data/basic_arith.erl72
-rw-r--r--lib/hipe/test/basic_SUITE_data/basic_beam_instrs.erl90
-rw-r--r--lib/hipe/test/basic_SUITE_data/basic_bifs.erl41
-rw-r--r--lib/hipe/test/basic_SUITE_data/basic_bignums.erl124
-rw-r--r--lib/hipe/test/basic_SUITE_data/basic_boolean.erl47
-rw-r--r--lib/hipe/test/basic_SUITE_data/basic_bugs_beam.erl101
-rw-r--r--lib/hipe/test/basic_SUITE_data/basic_bugs_hipe.erl189
-rw-r--r--lib/hipe/test/basic_SUITE_data/basic_comparisons.erl157
-rw-r--r--lib/hipe/test/basic_SUITE_data/basic_exceptions.erl206
-rw-r--r--lib/hipe/test/basic_SUITE_data/basic_floats.erl156
-rw-r--r--lib/hipe/test/basic_SUITE_data/basic_fun.erl124
-rw-r--r--lib/hipe/test/basic_SUITE_data/basic_guards.erl58
-rw-r--r--lib/hipe/test/basic_SUITE_data/basic_issues_beam.erl325
-rw-r--r--lib/hipe/test/basic_SUITE_data/basic_issues_hipe.erl119
-rw-r--r--lib/hipe/test/basic_SUITE_data/basic_lists.erl41
-rw-r--r--lib/hipe/test/basic_SUITE_data/basic_module_info.erl32
-rw-r--r--lib/hipe/test/basic_SUITE_data/basic_pattern_match.erl36
-rw-r--r--lib/hipe/test/basic_SUITE_data/basic_receive.erl56
-rw-r--r--lib/hipe/test/basic_SUITE_data/basic_tuples.erl177
19 files changed, 2151 insertions, 0 deletions
diff --git a/lib/hipe/test/basic_SUITE_data/basic_arith.erl b/lib/hipe/test/basic_SUITE_data/basic_arith.erl
new file mode 100644
index 0000000000..3dddc265c8
--- /dev/null
+++ b/lib/hipe/test/basic_SUITE_data/basic_arith.erl
@@ -0,0 +1,72 @@
+%%% -*- erlang-indent-level: 2 -*-
+%%%---------------------------------------------------------------------
+%%% Author: Kostis Sagonas
+%%%
+%%% Contains tests cases for compilation of arithmetic.
+%%%---------------------------------------------------------------------
+-module(basic_arith).
+
+-export([test/0]).
+
+test() ->
+ ok = test_rem(),
+ ok = test_bit_ops(),
+ ok = test_uplus(),
+ ok = test_bsl_errors(),
+ ok.
+
+%%----------------------------------------------------------------------
+%% Tests the remainder operator.
+
+test_rem() ->
+ 2 = ret_rem(42, 20),
+ -2 = ret_rem(-42, 20),
+ -2 = ret_rem(-42, -20),
+ {'EXIT', {badarith, _}} = ret_rem(3.14, 2),
+ {'EXIT', {badarith, _}} = ret_rem(42, 3.14),
+ ok.
+
+ret_rem(X, Y) ->
+ catch X rem Y.
+
+%%----------------------------------------------------------------------
+%%
+
+test_bit_ops() ->
+ 2 = bbb(11, 2, 16#3ff),
+ ok.
+
+bbb(X, Y, Z) ->
+ ((1 bsl X) bor Y) band Z.
+
+%%----------------------------------------------------------------------
+%% Tests unary plus: it used to be the identity function but not anymore
+
+test_uplus() ->
+ badarith = try uplus(gazonk) catch error:E -> E end,
+ 42 = uplus(42),
+ ok.
+
+uplus(X) -> +(X).
+
+%%----------------------------------------------------------------------
+%% The first part of this test triggered a bug in the emulator as one
+%% of the arguments to bsl is not an integer.
+%%
+%% The second part triggered a compilation crash since an arithmetic
+%% expression resulting in a 'system_limit' exception was statically
+%% evaluated and an arithmetic result was expected.
+
+test_bsl_errors() ->
+ {'EXIT', {'badarith', _}} = (catch (t1(0, pad, 0))),
+ badarith = try t2(0, pad, 0) catch error:Err1 -> Err1 end,
+ system_limit = try (id(1) bsl 100000000) catch error:Err2 -> Err2 end,
+ ok.
+
+t1(_, X, _) ->
+ (1 bsl X) + 1.
+
+t2(_, X, _) ->
+ (X bsl 1) + 1.
+
+id(I) -> I.
diff --git a/lib/hipe/test/basic_SUITE_data/basic_beam_instrs.erl b/lib/hipe/test/basic_SUITE_data/basic_beam_instrs.erl
new file mode 100644
index 0000000000..50c2180cbd
--- /dev/null
+++ b/lib/hipe/test/basic_SUITE_data/basic_beam_instrs.erl
@@ -0,0 +1,90 @@
+%%% -*- erlang-indent-level: 2 -*-
+%%%-------------------------------------------------------------------
+%%% Author: Kostis Sagonas
+%%%
+%%% Tests for correct translation of various BEAM instructions.
+%%%-------------------------------------------------------------------
+-module(basic_beam_instrs).
+
+-export([test/0]).
+
+test() ->
+ ok = test_make_fun(),
+ ok = test_switch_val(),
+ ok = test_put_literal(),
+ ok = test_set_tuple_element(),
+ ok.
+
+%%--------------------------------------------------------------------
+%% Tests whether the translation of make_fun works.
+
+test_make_fun() ->
+ {F, G} = double_the_fun(),
+ ok = F(),
+ {ok, 42} = G(42),
+ FV1 = {ok, free_var1},
+ FV2 = {also, {free, var2}},
+ {FV1, {ok, [bv]}, FV2} = contains_fun(FV1, ignored, FV2),
+ ok.
+
+double_the_fun() ->
+ {fun () -> ok end, fun (V) -> {ok, V} end}.
+
+contains_fun(X, _IGNORED_ARG, Y) ->
+ calls_fun(fun(Term) -> {X, Term, Y} end).
+
+calls_fun(F) ->
+ F({ok, [bv]}).
+
+%%--------------------------------------------------------------------
+%% Tests whether the translation of switch_val works.
+
+test_switch_val() ->
+ 'A' = sv(a),
+ 'B' = sv(b),
+ 'C' = sv(c),
+ foo = sv(d),
+ ok.
+
+sv(a) -> 'A';
+sv(b) -> 'B';
+sv(c) -> 'C';
+sv(_) -> foo.
+
+%%--------------------------------------------------------------------
+%% Tests correct handling of literals (statically constant terms)
+
+-define(QUADRUPLE, {a,b,c,42}).
+-define(DEEP_LIST, [42,[42,[42]]]).
+
+test_put_literal() ->
+ ?QUADRUPLE = mk_literal_quadruple(),
+ ?DEEP_LIST = mk_literal_deep_list(),
+ ok.
+
+mk_literal_quadruple() ->
+ ?QUADRUPLE.
+
+mk_literal_deep_list() ->
+ ?DEEP_LIST.
+
+%%--------------------------------------------------------------------
+%% Tests whether the translation of set_tuple_element works.
+
+-record(rec, {f1, f2, f3, f4, f5}).
+
+test_set_tuple_element() ->
+ F2 = [a,b,c], F4 = {a,b},
+ State0 = init_rec(F2, F4),
+ State1 = simple_set(State0, 42),
+ #rec{f1 = foo, f2 = F2, f3 = 42, f4 = F4, f5 = 42.0} = odd_set(State1, 21),
+ ok.
+
+init_rec(F2, F4) ->
+ #rec{f1 = bar, f2 = F2, f3 = 10, f4 = F4, f5 = 3.14}.
+
+simple_set(State, Val) -> %% f3 = Val is the one used in set_element;
+ State#rec{f3 = Val, f5 = Val*2}. %% this checks the case of variable
+
+odd_set(State, Val) -> %% f3 = foo is the one used in set_element;
+ State#rec{f1 = foo, f5 = Val*2.0}. %% this checks the case of constant
diff --git a/lib/hipe/test/basic_SUITE_data/basic_bifs.erl b/lib/hipe/test/basic_SUITE_data/basic_bifs.erl
new file mode 100644
index 0000000000..d6f21ceb52
--- /dev/null
+++ b/lib/hipe/test/basic_SUITE_data/basic_bifs.erl
@@ -0,0 +1,41 @@
+%%% -*- erlang-indent-level: 2 -*-
+%%%-------------------------------------------------------------------
+%%% Author: Kostis Sagonas
+%%%
+%%% Contains tests for handling of BIFs in guards and body calls.
+%%%-------------------------------------------------------------------
+-module(basic_bifs).
+
+-export([test/0]).
+
+test() ->
+ ok = test_element(),
+ ok = test_binary_part().
+
+%%--------------------------------------------------------------------
+
+test_element() ->
+ true = elem({a, b}),
+ false = elem({a, c}),
+ other = elem(gazonk),
+ ok.
+
+elem(T) when element(1, T) == a -> element(2, T) == b;
+elem(_) -> other.
+
+%%--------------------------------------------------------------------
+%% Checks that 2-ary and 3-ary BIFs can be compiled to native code.
+
+test_binary_part() ->
+ Bin = <<1,2,3,4,5,6,7,8,9,10>>,
+ BinPart = bp3(Bin),
+ <<7,8>> = bp2(BinPart),
+ ok.
+
+bp2(Bin) ->
+ binary_part(Bin, {1, 2}).
+
+bp3(Bin) ->
+ binary_part(Bin, byte_size(Bin), -5).
+
+%%--------------------------------------------------------------------
diff --git a/lib/hipe/test/basic_SUITE_data/basic_bignums.erl b/lib/hipe/test/basic_SUITE_data/basic_bignums.erl
new file mode 100644
index 0000000000..c455bf318f
--- /dev/null
+++ b/lib/hipe/test/basic_SUITE_data/basic_bignums.erl
@@ -0,0 +1,124 @@
+%%% -*- erlang-indent-level: 2 -*-
+%%%-------------------------------------------------------------------
+%%% Author: Kostis Sagonas
+%%%
+%%% Contains code examples that test bignum arithmetic and matching.
+%%%-------------------------------------------------------------------
+-module(basic_bignums).
+
+-export([test/0, test_bsl/0]).
+
+test() ->
+ ok = test_ops(),
+ ok = test_big_fac(),
+ ok = test_int_overfl_32(),
+ ok = test_int_overfl_64(),
+ ok.
+
+%%--------------------------------------------------------------------
+%% Define some constants for the tests of arithmetic operators
+
+-define(X, 68719476736).
+-define(Y, 98765432101234).
+-define(Z, 4722366482869645213696).
+-define(W, 339254531512339254531512).
+
+-define(B1, 4398046511104).
+-define(B5, 1645504557321206042154969182557350504982735865633579863348609024).
+-define(B17, 86182066610968551542636378241108028056376767329454880514019834315878107616003372189510312530372009184902888961739623919010110377987011442493486117202360415845666384627768436296772219009176743399772868636439042064384).
+
+%%--------------------------------------------------------------------
+
+test_ops() ->
+ ok = test_mult(),
+ ok = test_div(),
+ ok = test_round(),
+ ok = test_trunc(),
+ ok = test_bsl(),
+ ok.
+
+test_mult() ->
+ ?Z = mult(?X, ?X),
+ ok.
+
+mult(X, Y) -> X * Y.
+
+test_div() ->
+ 4 = div_f(339254531512, ?X),
+ 0 = div_f(?Y, ?Y+1),
+ 64 = div_f(?B1, ?X),
+ ?X = div_f(?Z, ?X),
+ 1073741824 = div_f(?Z, ?B1),
+ ok.
+
+div_f(X, Y) -> X div Y.
+
+test_round() ->
+ 0 = round_f(?Z, ?W),
+ 1 = round_f(?Y, ?Y),
+ 71 = round_f(?W, ?Z),
+ 1437 = round_f(?Y, ?X),
+ 47813960 = round_f(?Z, ?Y),
+ 4936803183406 = round_f(?W, ?X),
+ ok.
+
+trunc_f(X, Y) -> round(X/Y).
+
+test_trunc() ->
+ 0 = trunc_f(?Z, ?W),
+ 1 = trunc_f(?Y, ?Y),
+ 72 = trunc_f(?W, ?Z),
+ 1437 = trunc_f(?Y, ?X),
+ 47813961 = trunc_f(?Z, ?Y),
+ 4936803183407 = trunc_f(?W, ?X),
+ ok.
+
+round_f(X, Y) -> trunc(X/Y).
+
+test_bsl() ->
+ ?B1 = bsl_f(1, 42),
+ ?B5 = n(5, fun erlang:'bsl'/2, 1, 42), % use the operator
+ ?B17 = n(17, fun bsl_f/2, 1, 42), % use the local function
+ ok.
+
+bsl_f(X, Y) -> X bsl Y.
+
+%% applies a binary function N times
+n(1, F, X, Y) -> F(X, Y);
+n(N, F, X, Y) when N > 1 -> n(N-1, F, F(X, Y), Y).
+
+%%--------------------------------------------------------------------
+
+-define(FAC42, 1405006117752879898543142606244511569936384000000000).
+
+test_big_fac() ->
+ ?FAC42 = fac(42),
+ ok.
+
+fac(0) -> 1;
+fac(N) -> N * fac(N-1).
+
+%%--------------------------------------------------------------------
+%% Tests for correct handling of integer overflow
+
+test_int_overfl_32() ->
+ 16#7FFFFFF = add(16#7FFFFFF, 0),
+ 16#8000000 = add(16#8000000, 0),
+ 16#8000001 = add(16#8000000, 1),
+ case add(16#7FFFFFF, 1) of
+ 16#8000000 -> ok;
+ -16#7FFFFFF -> error
+ end.
+
+test_int_overfl_64() ->
+ 16#7FFFFFFFFFFFFFF = add(16#7FFFFFFFFFFFFFF, 0),
+ 16#800000000000000 = add(16#800000000000000, 0),
+ 16#800000000000001 = add(16#800000000000000, 1),
+ case add(16#7FFFFFFFFFFFFFF, 1) of
+ 16#800000000000000 -> ok;
+ -16#7FFFFFFFFFFFFFF -> error
+ end.
+
+add(X, Y) -> X + Y.
+
+%%--------------------------------------------------------------------
diff --git a/lib/hipe/test/basic_SUITE_data/basic_boolean.erl b/lib/hipe/test/basic_SUITE_data/basic_boolean.erl
new file mode 100644
index 0000000000..e4a91ef5af
--- /dev/null
+++ b/lib/hipe/test/basic_SUITE_data/basic_boolean.erl
@@ -0,0 +1,47 @@
+%%% -*- erlang-indent-level: 2 -*-
+%%%-------------------------------------------------------------------
+%%% Author: Kostis Sagonas
+%%%
+%%% Tests for correct translation of booleans and their primitives.
+%%%-------------------------------------------------------------------
+-module(basic_boolean).
+
+-export([test/0]).
+
+test() ->
+ ok = test_boolean_ops(false, true),
+ ok = test_orelse_redundant(),
+ ok.
+
+%%--------------------------------------------------------------------
+
+test_boolean_ops(F, T) ->
+ true = T and T,
+ false = T and F,
+ false = F and T,
+ false = F and F,
+ true = T or T,
+ true = T or F,
+ true = F or T,
+ false = F or F,
+ true = T andalso T,
+ false = T andalso F,
+ false = F andalso T,
+ false = F andalso F,
+ true = T orelse T,
+ true = T orelse F,
+ true = F orelse T,
+ false = F orelse F,
+ ok.
+
+%%--------------------------------------------------------------------
+%% Redundant test in BEAM code will generate type warning.
+
+test_orelse_redundant() ->
+ true = test_orelse(true, true, true),
+ ok.
+
+test_orelse(A, B, C) ->
+ A andalso B orelse C.
+
+%%--------------------------------------------------------------------
diff --git a/lib/hipe/test/basic_SUITE_data/basic_bugs_beam.erl b/lib/hipe/test/basic_SUITE_data/basic_bugs_beam.erl
new file mode 100644
index 0000000000..0cf9a3cd4c
--- /dev/null
+++ b/lib/hipe/test/basic_SUITE_data/basic_bugs_beam.erl
@@ -0,0 +1,101 @@
+%%% -*- erlang-indent-level: 2 -*-
+%%%-------------------------------------------------------------------
+%%% Author: Kostis Sagonas
+%%%
+%%% Contains code examples that exhibited bugs in the BEAM compiler.
+%%%-------------------------------------------------------------------
+-module(basic_bugs_beam).
+
+-export([test/0]).
+
+%% the following are needed for the test_catch_bug
+-behaviour(gen_server).
+-export([start_link/1]).
+-export([init/1, handle_call/3, handle_cast/2, handle_info/2,
+ terminate/2, code_change/3]).
+
+test() ->
+ ok = test_fp_basic_blocks(),
+ ok = test_catch_bug(),
+ ok.
+
+%%--------------------------------------------------------------------
+%% Test which shows that BEAM's splitting of basic blocks should take
+%% into account that arithmetic operations implemented as BIFs can
+%% also cause exceptions and thus calls to BIFs should end basic blocks.
+%%
+%% Investigated and fixed in the beginning of April 2004.
+%%--------------------------------------------------------------------
+
+test_fp_basic_blocks() ->
+ ok = t1(),
+ ok = t2().
+
+t1() ->
+ X = (catch bad_arith1(2.0, 1.7)),
+ case X of
+ {'EXIT', {badarith, _}} ->
+ ok;
+ _ ->
+ error
+ end.
+
+bad_arith1(X, Y) when is_float(X) ->
+ X1 = X * 1.7e+308,
+ X2 = X1 + 1.0,
+ Y1 = Y * 2,
+ {X2, Y1}.
+
+%% Similarly, it is not kosher to have anything that can fail inside
+%% the fp block since it will throw the exception before the fp
+%% exception and we will get the same problems.
+
+t2() ->
+ case catch bad_arith2(2.0, []) of
+ {'EXIT', {badarith, _}} ->
+ ok;
+ _ ->
+ error
+ end.
+
+bad_arith2(X, Y) when is_float(X) ->
+ X1 = X * 1.7e+308,
+ Y1 = element(1, Y),
+ {X1 + 1.0, Y1}.
+
+%%--------------------------------------------------------------------
+%% This was posted on the Erlang mailing list as a question:
+%%
+%% Given the module below and the function call
+%% "catch_bug:start_link(foo)."
+%% from the Erlang shell, why does Erlang crash with "Catch not found"?
+%%
+%% The BEAM compiler was generating wrong code for this case;
+%% this was fixed in R9C-0. Native code generation was OK.
+%%--------------------------------------------------------------------
+
+test_catch_bug() ->
+ ignore = start_link(foo),
+ ok.
+
+start_link(Param) ->
+ gen_server:start_link(?MODULE, Param, []).
+
+init(Param) ->
+ process_flag(trap_exit, true),
+ (catch begin
+ dummy(Param),
+ (catch exit(bar))
+ end
+ ),
+ ignore.
+
+dummy(_) -> ok.
+
+%% gen_server callbacks below
+handle_call(_Call, _From, State) -> {noreply, State}.
+handle_cast(_Msg, State) -> {noreply, State}.
+handle_info(_Msg, State) -> {noreply, State}.
+terminate(_Reason, _State) -> ok.
+code_change(_OldVsn, State, _Extra) -> {ok, State}.
+
diff --git a/lib/hipe/test/basic_SUITE_data/basic_bugs_hipe.erl b/lib/hipe/test/basic_SUITE_data/basic_bugs_hipe.erl
new file mode 100644
index 0000000000..1948e4efa7
--- /dev/null
+++ b/lib/hipe/test/basic_SUITE_data/basic_bugs_hipe.erl
@@ -0,0 +1,189 @@
+%%% -*- erlang-indent-level: 2 -*-
+%%%-------------------------------------------------------------------
+%%% Author: Kostis Sagonas
+%%%
+%%% Contains code examples that exhibited bugs in the HiPE compiler.
+%%%-------------------------------------------------------------------
+-module(basic_bugs_hipe).
+
+-export([test/0]).
+
+test() ->
+ ok = test_ets_bifs(),
+ ok = test_bit_shift(),
+ ok = test_R12B5_seg_fault(),
+ ok.
+
+%%--------------------------------------------------------------------
+%% From: Bjorn Gustavsson
+%%
+%% This code, if HiPE compiled, crashed like this (on SPARC)
+%%
+%% (gdb) where
+%% #0 fullsweep_heap (p=0x2c60dc, new_sz=610, objv=0xffbee8b4, nobj=3)
+%% at beam/ggc.c:1060
+%% #1 0x7ff24 in erts_garbage_collect (p=0x2c60dc, need=2, objv=0x1128fc, ...)
+%% at beam/ggc.c:1648
+%% #2 0xab6fc in hipe_mode_switch (p=0x2c60dc, cmd=704512, reg=0x1128fc)
+%% at hipe/hipe_mode_switch.c:180
+%% #3 0x8e27c in process_main () at beam/beam_emu.c:3314
+%% #4 0x31338 in erl_start (argc=9, argv=0xffbeed5c) at beam/erl_init.c:936
+%% #5 0x2d9f4 in main (argc=9, argv=0xffbeed5c) at sys/unix/erl_main.c:28
+%%
+%% A guess at what could be the problem: From R8, many ets BIFs trap
+%% to other ets BIFs with a *different* arity (i.e. they have more or
+%% less arguments). I have probably forgotten to mention that subtle
+%% change.
+%%--------------------------------------------------------------------
+
+test_ets_bifs() ->
+ Seed = {1032, 15890, 22716},
+ put(random_seed, Seed),
+ do_random_test().
+
+do_random_test() ->
+ OrdSet = ets:new(xxx, [ordered_set]),
+ Set = ets:new(xxx, []),
+ do_n_times(fun() ->
+ Key = create_random_string(25),
+ Value = create_random_tuple(25),
+ ets:insert(OrdSet, {Key, Value}),
+ ets:insert(Set, {Key, Value})
+ end, 5000),
+ %% io:format("~nData inserted~n"),
+ do_n_times(fun() ->
+ I = random:uniform(25),
+ Key = create_random_string(I) ++ '_',
+ L1 = ets_match_object(OrdSet, {Key, '_'}),
+ L2 = lists:sort(ets_match_object(Set, {Key, '_'})),
+ case L1 == L2 of
+ false ->
+ %% io:format("~p != ~p~n", [L1, L2]),
+ exit({not_eq, L1, L2});
+ true ->
+ ok
+ end
+ end,
+ 2000),
+ %% io:format("~nData matched~n"),
+ ets:match_delete(OrdSet, '_'),
+ ets:match_delete(Set, '_'),
+ ok.
+
+create_random_string(0) ->
+ [];
+create_random_string(OfLength) ->
+ C = case random:uniform(2) of
+ 1 -> (random:uniform($Z - $A + 1) - 1) + $A;
+ _ -> (random:uniform($z - $a + 1) - 1) + $a
+ end,
+ [C | create_random_string(OfLength - 1)].
+
+create_random_tuple(OfLength) ->
+ list_to_tuple([list_to_atom([X]) || X <- create_random_string(OfLength)]).
+
+ets_match_object(Tab,Expr) ->
+ case random:uniform(2) of
+ 1 -> ets:match_object(Tab,Expr);
+ _ -> match_object_chunked(Tab,Expr)
+ end.
+
+match_object_chunked(Tab,Expr) ->
+ match_object_chunked_collect(ets:match_object(Tab, Expr,
+ random:uniform(1999) + 1)).
+
+match_object_chunked_collect('$end_of_table') ->
+ [];
+match_object_chunked_collect({Results, Continuation}) ->
+ Results ++ match_object_chunked_collect(ets:match_object(Continuation)).
+
+do_n_times(_, 0) ->
+ ok;
+do_n_times(Fun, N) ->
+ Fun(),
+ case N rem 1000 of
+ 0 -> ok; %% WAS: io:format(".");
+ _ -> ok
+ end,
+ do_n_times(Fun, N - 1).
+
+%%--------------------------------------------------------------------
+%% From: Niclas Pehrsson
+%% Date: Apr 20, 2006
+%%
+%% We found something weird with the bit shifting in HiPE. It seems
+%% that bsr in some cases shifts the bits in the wrong way...
+%%
+%% Fixed about 10 mins afterwards; was a bug in constant propagation.
+%%--------------------------------------------------------------------
+
+test_bit_shift() ->
+ 1 = plain_shift(), % 1
+ 6 = length_list_plus(), % 6
+ 0 = shift_length_list(), % 0
+ 1 = shift_length_list_plus(), % 1
+ 1 = shift_length_list_plus2(), % 1
+ 24 = shift_length_list_plus_bsl(), % 24
+ 1 = shift_fun(), % 1
+ %% {1, 6, 0, 1, 1, 24, 1} = {A, B, C, D, E, F, G},
+ ok.
+
+plain_shift() ->
+ 6 bsr 2.
+
+length_list() ->
+ length([0,0]).
+
+length_list_plus() ->
+ length([0,0]) + 4.
+
+shift_length_list() ->
+ length([0,0]) bsr 2.
+
+shift_length_list_plus() ->
+ (length([0,0]) + 4) bsr 2.
+
+shift_length_list_plus_bsl() ->
+ (length([0,0]) + 4) bsl 2.
+
+shift_length_list_plus2() ->
+ N = length([0,0]) + 4,
+ N bsr 2.
+
+shift_fun() ->
+ (length_list() + 4) bsr 2.
+
+%%-----------------------------------------------------------------------
+%% From: Sergey S, mid January 2009.
+%%
+%% While I was playing with +native option, I run into a bug in HiPE
+%% which leads to segmentation fault using +native and Erlang R12B-5.
+%%
+%% Eshell V5.6.5 (abort with ^G)
+%% 1> crash:test().
+%% # Some message to be printed here each loop iteration
+%% Segmentation fault
+%%
+%% Diagnozed and fixed by Mikael Petterson (22 Jan 2009):
+%%
+%% I've analysed the recently posted HiPE bug report on erlang-bugs
+%% <http://www.erlang.org/pipermail/erlang-bugs/2009-January/001162.html>.
+%% The segfault is caused by memory corruption, which in turn is caused
+%% by RTL removing an update of the HP (heap pointer) register due to
+%% what looks like broken liveness information.
+%%-----------------------------------------------------------------------
+
+test_R12B5_seg_fault() ->
+ _ = spawn(fun() -> init() end),
+ ok.
+
+init() ->
+ repeat(5, fun() -> void end),
+ receive after infinity -> ok end.
+
+repeat(0, _) ->
+ ok;
+repeat(N, Fun) ->
+ %% io:format("# Some message to be printed here each loop iteration\n"),
+ Fun(),
+ repeat(N - 1, Fun).
diff --git a/lib/hipe/test/basic_SUITE_data/basic_comparisons.erl b/lib/hipe/test/basic_SUITE_data/basic_comparisons.erl
new file mode 100644
index 0000000000..8dab2cab1f
--- /dev/null
+++ b/lib/hipe/test/basic_SUITE_data/basic_comparisons.erl
@@ -0,0 +1,157 @@
+%%% -*- erlang-indent-level: 2 -*-
+%%%-------------------------------------------------------------------
+%%% Author: Kostis Sagonas
+%%%
+%%% Contains tests for correct execution of comparison operators.
+%%%-------------------------------------------------------------------
+-module(basic_comparisons).
+
+-export([test/0]).
+
+test() ->
+ Ns = [0, 0.0, 42, 42.0, gazonk],
+ T1F4 = [true, false, false, false, false],
+ T2F3 = [true, true, false, false, false],
+ F1T4 = [false, true, true, true, true],
+ F2T3 = [false, false, true, true, true],
+ %% tests for calls
+ T1F4 = [eq_exact_call(0, N) || N <- Ns],
+ F1T4 = [ne_exact_call(0, N) || N <- Ns],
+ T2F3 = [eq_call(0, N) || N <- Ns],
+ F2T3 = [ne_call(0, N) || N <- Ns],
+ %% tests for guards
+ T1F4 = [eq_exact_guard(0, N) || N <- Ns],
+ F1T4 = [ne_exact_guard(0, N) || N <- Ns],
+ T2F3 = [eq_guard(0, N) || N <- Ns],
+ F2T3 = [ne_guard(0, N) || N <- Ns],
+ %% some more tests
+ ok = test_against_zero(),
+ ok = test_against_other_terms(),
+ ok = test_sofs_func(),
+ ok.
+
+test_against_zero() ->
+ Xs = [0, 1, 0.0],
+ [true, false, false] = [is_zero_int(X) || X <- Xs],
+ [true, false, true] = [is_zero_num(X) || X <- Xs],
+ [false, true, true] = [is_nonzero_int(X) || X <- Xs],
+ [false, true, false] = [is_nonzero_num(X) || X <- Xs],
+ ok.
+
+test_against_other_terms() ->
+ TTT = {true, true, true},
+ FFF = {false, false, false},
+ TTT = {is_foo_exact(foo), is_foo_term1(foo), is_foo_term2(foo)},
+ FFF = {is_foo_exact(bar), is_foo_term1(bar), is_foo_term2(bar)},
+ FFF = {is_nonfoo_exact(foo), is_nonfoo_term1(foo), is_nonfoo_term2(foo)},
+ TTT = {is_nonfoo_exact(bar), is_nonfoo_term1(bar), is_nonfoo_term2(bar)},
+ Tup = {a, {42}, [c]},
+ TTT = {is_tuple_skel(Tup), is_tuple_exact(Tup), is_tuple_term(Tup)},
+ BNi = <<42>>,
+ TTT = {is_bin_exact(BNi), is_bin_term1(BNi), is_bin_term2(BNi)},
+ BNf = <<42/float>>,
+ FFF = {is_bin_exact(BNf), is_bin_term1(BNf), is_bin_term2(BNf)},
+ ok.
+
+test_sofs_func() ->
+ L = [0, 0.0],
+ ok = sofs_func(L, L, L).
+
+%%--------------------------------------------------------------------
+%% Test for comparison operators used in body calls
+
+eq_exact_call(X, Y) -> X =:= Y.
+
+ne_exact_call(X, Y) -> X =/= Y.
+
+eq_call(X, Y) -> X == Y.
+
+ne_call(X, Y) -> X /= Y.
+
+%%--------------------------------------------------------------------
+%% Tests for comparison operators used as guards
+
+eq_exact_guard(X, Y) when X =:= Y -> true;
+eq_exact_guard(_, _) -> false.
+
+ne_exact_guard(X, Y) when X =/= Y -> true;
+ne_exact_guard(_, _) -> false.
+
+eq_guard(X, Y) when X == Y -> true;
+eq_guard(_, _) -> false.
+
+ne_guard(X, Y) when X /= Y -> true;
+ne_guard(_, _) -> false.
+
+%%--------------------------------------------------------------------
+
+is_zero_int(N) when N =:= 0 -> true;
+is_zero_int(_) -> false.
+
+is_nonzero_int(N) when N =/= 0 -> true;
+is_nonzero_int(_) -> false.
+
+is_zero_num(N) when N == 0 -> true;
+is_zero_num(_) -> false.
+
+is_nonzero_num(N) when N /= 0 -> true;
+is_nonzero_num(_) -> false.
+
+%%--------------------------------------------------------------------
+%% There should not really be any difference in the generated code
+%% for the following three functions.
+
+is_foo_exact(A) when A =:= foo -> true;
+is_foo_exact(_) -> false.
+
+is_foo_term1(A) when A == foo -> true;
+is_foo_term1(_) -> false.
+
+is_foo_term2(A) when foo == A -> true;
+is_foo_term2(_) -> false.
+
+%%--------------------------------------------------------------------
+%% Same for these cases
+
+is_nonfoo_exact(A) when A =/= foo -> true;
+is_nonfoo_exact(_) -> false.
+
+is_nonfoo_term1(A) when A /= foo -> true;
+is_nonfoo_term1(_) -> false.
+
+is_nonfoo_term2(A) when foo /= A -> true;
+is_nonfoo_term2(_) -> false.
+
+%%--------------------------------------------------------------------
+
+is_tuple_skel({A,{B},[C]}) when is_atom(A), is_integer(B), is_atom(C) -> true;
+is_tuple_skel(T) when is_tuple(T) -> false.
+
+is_tuple_exact(T) when T =:= {a,{42},[c]} -> true;
+is_tuple_exact(T) when is_tuple(T) -> false.
+
+is_tuple_term(T) when T == {a,{42.0},[c]} -> true;
+is_tuple_term(T) when is_tuple(T) -> false.
+
+%%--------------------------------------------------------------------
+%% But for binaries the treatment has to be different, due to the need
+%% for construction of the binary in the guard.
+
+is_bin_exact(B) when B =:= <<42>> -> true;
+is_bin_exact(_) -> false.
+
+is_bin_term1(B) when B == <<42>> -> true;
+is_bin_term1(_) -> false.
+
+is_bin_term2(B) when <<42>> == B -> true;
+is_bin_term2(_) -> false.
+
+%%--------------------------------------------------------------------
+%% a test from sofs.erl which failed at some point
+
+sofs_func([X | Ts], X0, L) when X /= X0 ->
+ sofs_func(Ts, X, L);
+sofs_func([X | _Ts], X0, _L) when X == X0 ->
+ ok;
+sofs_func([], _X0, L) ->
+ L.
diff --git a/lib/hipe/test/basic_SUITE_data/basic_exceptions.erl b/lib/hipe/test/basic_SUITE_data/basic_exceptions.erl
new file mode 100644
index 0000000000..cf11e8b2a0
--- /dev/null
+++ b/lib/hipe/test/basic_SUITE_data/basic_exceptions.erl
@@ -0,0 +1,206 @@
+%%% -*- erlang-indent-level: 2 -*-
+%%%-------------------------------------------------------------------
+%%% Author: Kostis Sagonas
+%%%
+%%% Contains tests that raise exceptions and catch them.
+%%%-------------------------------------------------------------------
+-module(basic_exceptions).
+
+-export([test/0]).
+
+%% functions used as arguments to spawn/3
+-export([bad_guy/2]).
+
+test() ->
+ ok = test_catch_exit(42),
+ ok = test_catch_throw(42),
+ ok = test_catch_element(),
+ ok = test_catch_merge(),
+ ok = test_pending_errors(),
+ ok = test_bad_fun_call(),
+ ok.
+
+%%--------------------------------------------------------------------
+
+test_catch_exit(N) ->
+ {'EXIT', N} = (catch exit(N)),
+ {'EXIT', 42} = (catch exit(42)),
+ 42 = try exit(N) catch exit:R1 -> R1 end,
+ 42 = try exit(42) catch exit:R2 -> R2 end,
+ ok.
+
+%%--------------------------------------------------------------------
+
+test_catch_throw(N) ->
+ N = (catch throw(N)),
+ 42 = (catch throw(42)),
+ 42 = try throw(N) catch throw:R1 -> R1 end,
+ 42 = try throw(42) catch throw:R2 -> R2 end,
+ ok.
+
+%%--------------------------------------------------------------------
+
+test_catch_element() ->
+ 'EXIT' = test_catch_element([]),
+ 'EXIT' = test_catch_element(42),
+ ok.
+
+test_catch_element(N) ->
+ element(1, catch element(N, {1,2,3,4,5,6,7,8,9,10,11})).
+
+%%--------------------------------------------------------------------
+%% Test that shows how BEAM can merge catch-end blocks that belong to
+%% different catch-start instructions. Written by Richard Carlsson.
+%%--------------------------------------------------------------------
+
+test_catch_merge() ->
+ merge(get(whatever)).
+
+merge(foo=X) ->
+ catch f(X),
+ catch g(X);
+merge(X) ->
+ catch f(X),
+ catch g(X).
+
+f(_) -> ok.
+
+g(_) -> ok.
+
+%%--------------------------------------------------------------------
+%% Taken from exception_SUITE.erl
+%%--------------------------------------------------------------------
+
+test_pending_errors() ->
+ error_logger:tty(false), % disable printouts of error reports
+ pending_errors().
+
+%% Test various exceptions, in the presence of a previous error
+%% suppressed in a guard.
+pending_errors() ->
+ pending(e_badmatch, {badmatch, b}),
+ pending(x, function_clause),
+ pending(e_case, {case_clause, xxx}),
+ pending(e_if, if_clause),
+ %% pending(e_badarith, badarith),
+ %% pending(e_undef, undef),
+ pending(e_timeoutval, timeout_value),
+ %% pending(e_badarg, badarg),
+ %% pending(e_badarg_spawn, badarg),
+ ok.
+
+bad_guy(pe_badarith, Other) when Other+1 =:= 0 -> % badarith (suppressed)
+ ok;
+bad_guy(pe_badarg, Other) when length(Other) > 0 -> % badarg (suppressed)
+ ok;
+bad_guy(_, e_case) ->
+ case xxx() of
+ ok -> ok
+ end; % case_clause
+bad_guy(_, e_if) ->
+ B = b(),
+ if
+ a == B -> ok
+ end; % if_clause
+%% bad_guy(_, e_badarith) ->
+%% 1+b; % badarith
+bad_guy(_, e_undef) ->
+ non_existing_module:foo(); % undef
+bad_guy(_, e_timeoutval) ->
+ receive
+ after gazonk -> ok % timeout_value
+ end;
+bad_guy(_, e_badarg) ->
+ node(xxx); % badarg
+bad_guy(_, e_badarg_spawn) ->
+ spawn({}, {}, {}); % badarg
+bad_guy(_, e_badmatch) ->
+ a = b(). % badmatch
+
+xxx() -> xxx.
+
+b() -> b.
+
+pending(Arg, Expected) ->
+ pending(pe_badarith, Arg, Expected),
+ pending(pe_badarg, Arg, Expected).
+
+pending(First, Second, Expected) ->
+ pending_catched(First, Second, Expected),
+ pending_exit_message([First, Second], Expected).
+
+pending_catched(First, Second, Expected) ->
+ %% ok = io:format("Catching bad_guy(~p, ~p)\n", [First, Second]),
+ case catch bad_guy(First, Second) of
+ {'EXIT', Reason} ->
+ pending(Reason, bad_guy, [First, Second], Expected);
+ Other ->
+ exit({not_exit, Other})
+ end.
+
+pending_exit_message(Args, Expected) ->
+ %% ok = io:format("Trapping exits from spawn_link(~p, ~p, ~p)\n",
+ %% [?MODULE, bad_guy, Args]),
+ process_flag(trap_exit, true),
+ Pid = spawn_link(?MODULE, bad_guy, Args),
+ receive
+ {'EXIT', Pid, Reason} ->
+ pending(Reason, bad_guy, Args, Expected);
+ Other ->
+ exit({unexpected_message, Other})
+ after 10000 ->
+ exit(timeout)
+ end,
+ process_flag(trap_exit, false).
+
+%% pending({badarg, [{erlang,Bif,BifArgs},{?MODULE,Func,Arity}|_]},
+%% Func, Args, _Code)
+%% when atom(Bif), list(BifArgs), length(Args) =:= Arity ->
+%% ok;
+pending({badarg,Trace}, _, _, _) when is_list(Trace) ->
+ ok;
+%% pending({undef,[{non_existing_module,foo,[]}|_]}, _, _, _) ->
+%% ok;
+pending({undef,Trace}, _, _, _) when is_list(Trace) ->
+ ok;
+%% pending({function_clause,[{?MODULE,Func,Args}|_]}, Func, Args, _Code) ->
+%% ok;
+pending({function_clause,Trace}, _, _, _) when is_list(Trace) ->
+ ok;
+%% pending({Code,[{?MODULE,Func,Arity}|_]}, Func, Args, Code)
+%% when length(Args) =:= Arity ->
+%% ok;
+pending({Code,Trace}, _, _, Code) when is_list(Trace) ->
+ ok;
+pending(Reason, _Function, _Args, _Code) ->
+ exit({bad_exit_reason, Reason}).
+
+%%--------------------------------------------------------------------
+%% Taken from fun_SUITE.erl
+%%
+%% Checks correct exception throwing when calling a bad fun.
+%%--------------------------------------------------------------------
+
+test_bad_fun_call() ->
+ ok = bad_call_fc(42),
+ ok = bad_call_fc(xx),
+ ok = bad_call_fc({}),
+ ok = bad_call_fc({1}),
+ ok = bad_call_fc({1,2,3}),
+ ok = bad_call_fc({1,2,3}),
+ ok = bad_call_fc({1,2,3,4}),
+ ok = bad_call_fc({1,2,3,4,5,6}),
+ ok = bad_call_fc({1,2,3,4,5}),
+ ok = bad_call_fc({1,2}),
+ ok.
+
+bad_call_fc(Fun) ->
+ Args = [some, stupid, args],
+ Res = (catch Fun(Fun(Args))),
+ case Res of
+ {'EXIT', {{badfun, Fun} ,_Where}} ->
+ ok; %% = io:format("~p(~p) -> ~p\n", [Fun, Args, Res]);
+ Other ->
+ io:format("~p(~p) -> ~p\n", [Fun, Args, Res]),
+ exit({bad_result, Other})
+ end.
diff --git a/lib/hipe/test/basic_SUITE_data/basic_floats.erl b/lib/hipe/test/basic_SUITE_data/basic_floats.erl
new file mode 100644
index 0000000000..a3df73b928
--- /dev/null
+++ b/lib/hipe/test/basic_SUITE_data/basic_floats.erl
@@ -0,0 +1,156 @@
+%%% -*- erlang-indent-level: 2 -*-
+%%%-------------------------------------------------------------------
+%%% Author: Kostis Sagonas
+%%%
+%%% Contains tests that manipulate floating point numbers.
+%%%-------------------------------------------------------------------
+-module(basic_floats).
+
+-export([test/0]).
+
+test() ->
+ ok = test_arith_ops(),
+ ok = test_fp_ebb(),
+ ok = test_fp_phi(),
+ ok = test_big_bad_float(),
+ ok = test_catch_bad_fp_arith(),
+ ok = test_catch_fp_conv(),
+ ok = test_fp_with_fp_exceptions(),
+ ok.
+
+%%--------------------------------------------------------------------
+
+test_arith_ops() ->
+ E = 2.5617,
+ 5.703200000000001 = add(E),
+ 0.5798000000000001 = sub(E),
+ 8.047580550000001 = mult(E),
+ -6.023e23 = negate(6.023e23),
+ ok.
+
+add(X) ->
+ 3.1415 + X.
+
+sub(X) ->
+ 3.1415 - X.
+
+mult(X) ->
+ 3.1415 * X.
+
+%% tests the translation of the fnegate BEAM instruction.
+negate(X) ->
+ - (X + 0.0).
+
+%%--------------------------------------------------------------------
+%% Test the construction of overlapping extended basic blocks where
+%% BEAM has constructed one and hipe_icode_fp constructs the other.
+%%--------------------------------------------------------------------
+
+test_fp_ebb() ->
+ 1.0 = foo(2*math:pi()),
+ 1.0 = bar(2*math:pi()),
+ ok.
+
+foo(X) ->
+ X / (2 * math:pi()).
+
+bar(X) ->
+ F = float_two(),
+ case F < 3.0 of
+ true -> (X * F) / ((2 * F) * math:pi());
+ false -> weird
+ end.
+
+float_two() ->
+ 2.0.
+
+%%--------------------------------------------------------------------
+
+test_fp_phi() ->
+ 10 = fp_phi(10, 100),
+ undefined = fp_phi(1.1e302, 0.000000001),
+ ok.
+
+fp_phi(A, B) ->
+ case catch A / B of
+ {'EXIT', _Reason} -> undefined;
+ _ -> round(100 * (A / B))
+ end.
+
+%%--------------------------------------------------------------------
+
+-define(BS, "93904329458954829589425849258998492384932849328493284932849328493284932389248329432932483294832949245827588578423578435783475834758375837580745807304258924584295924588459834958349589348589345934859384958349583945893458934859438593485995348594385943859438593458934589345938594385934859483958348934589435894859485943859438594594385938459438595034950439504395043950495043593485943758.0").
+
+test_big_bad_float() ->
+ ok = try f2l(?BS) catch error:badarg -> ok end,
+ ok = case catch f2l(?BS) of {'EXIT', {badarg, _}} -> ok end,
+ ok.
+
+f2l(F) ->
+ float_to_list(list_to_float(F)).
+
+%%--------------------------------------------------------------------
+%% Tests catching of floating point bad arithmetic.
+
+test_catch_bad_fp_arith() ->
+ 5.7 = f(2.56),
+ {'EXIT', {badarith, _}} = bad_arith(9.9),
+ ok.
+
+f(F) when is_float(F) -> F + 3.14.
+
+bad_arith(F) when is_float(F) ->
+ catch F * 1.70000e+308.
+
+%%--------------------------------------------------------------------
+%% Tests proper catching of exceptions due to illegal convertion of
+%% bignums to floating point numbers.
+
+test_catch_fp_conv() ->
+ F = 1.7e308, %% F is a number very close to a maximum float.
+ ok = big_arith(F),
+ ok = big_const_float(F),
+ ok.
+
+big_arith(F) ->
+ I = trunc(F),
+ {'EXIT', {badarith, _}} = big_int_arith(I),
+ ok.
+
+big_int_arith(I) when is_integer(I) ->
+ catch(3.0 + 2*I).
+
+big_const_float(F) ->
+ I = trunc(F),
+ badarith = try (1/(2*I)) catch error:Err -> Err end,
+ _Ignore = 2/I,
+ {'EXIT', _} = (catch 4/(2*I)),
+ ok.
+
+%%--------------------------------------------------------------------
+%% Forces floating point exceptions and tests that subsequent, legal,
+%% operations are calculated correctly.
+
+test_fp_with_fp_exceptions() ->
+ 0.0 = math:log(1.0),
+ badarith = try math:log(minus_one_float()) catch error:E1 -> E1 end,
+ 0.0 = math:log(1.0),
+ badarith = try math:log(zero_float()) catch error:E2 -> E2 end,
+ 0.0 = math:log(1.0),
+ %% An old-fashioned exception here just so as to test this case also
+ {'EXIT',_} = (catch fp_mult(3.23e133, 3.57e257)),
+ 0.0 = math:log(1.0),
+ badarith = try fp_div(5.0,0.0) catch error:E3 -> E3 end,
+ 0.0 = math:log(1.0),
+ ok.
+
+fp_mult(X, Y) -> X * Y.
+
+fp_div(X, Y) -> X / Y.
+
+%% The following two function definitions appear here just to shut
+%% off 'expression will fail with a badarg' warnings from the compiler
+
+zero_float() -> 0.0.
+
+minus_one_float() -> -1.0.
diff --git a/lib/hipe/test/basic_SUITE_data/basic_fun.erl b/lib/hipe/test/basic_SUITE_data/basic_fun.erl
new file mode 100644
index 0000000000..18ba7fdb3f
--- /dev/null
+++ b/lib/hipe/test/basic_SUITE_data/basic_fun.erl
@@ -0,0 +1,124 @@
+%%% -*- erlang-indent-level: 2 -*-
+%%%-------------------------------------------------------------------
+%%% Author: Kostis Sagonas
+%%%
+%%% Tests for correct handling of funs.
+%%%-------------------------------------------------------------------
+-module(basic_fun).
+
+-export([test/0]).
+
+-export([dummy_foo/4, add1/1, test_fun03/0]).
+
+test() ->
+ ok = test_calls(),
+ ok = test_is_function(),
+ ok = test_is_function2(),
+ ok.
+
+%%--------------------------------------------------------------------
+%% Tests function and fun calls.
+
+test_calls() ->
+ ok = test_apply_call(?MODULE, dummy_foo),
+ ok = test_fun_call(fun dummy_foo/4),
+ ok = test_fun_call(fun ?MODULE:dummy_foo/4),
+ ok.
+
+test_apply_call(M, F) ->
+ M:F(bar, 42, foo, 17).
+
+test_fun_call(Fun) ->
+ Fun(bar, 42, foo, 17).
+
+dummy_foo(_, _, foo, _) -> ok.
+
+%%--------------------------------------------------------------------
+%% Tests handling of funs out of exported functions and 2-tuple funs.
+
+test_fun03() ->
+ MFPair = add1_as_2tuple(),
+ 4712 = do_call(add1_as_export(), 4711),
+ {badfun, MFPair} = try do_call(MFPair, 88) catch error:Err -> Err end,
+ true = do_guard(add1_as_export()),
+ false = do_guard(MFPair), % 2-tuples do not satisfy is_function/1
+ ok.
+
+do_call(F, X) -> F(X).
+
+do_guard(F) when is_function(F) -> true;
+do_guard(_) -> false.
+
+add1_as_export() -> fun ?MODULE:add1/1.
+
+add1_as_2tuple() -> {?MODULE, add1}.
+
+add1(X) -> X+1.
+
+%%--------------------------------------------------------------------
+%% Tests the is_function guard and BIF.
+
+test_is_function() ->
+ Fun = fun (X, foo) -> dummy_foo(X, mnesia_lib, foo, [X]) end,
+ ok = test_when_guard(Fun),
+ ok = test_if_guard(Fun),
+ ok.
+
+test_when_guard(X) when is_function(X) -> ok.
+
+test_if_guard(X) ->
+ if is_function(X) -> ok;
+ true -> weird
+ end.
+
+%%--------------------------------------------------------------------
+%% Tests the is_function2 guard and BIF.
+
+test_is_function2() ->
+ ok = test_guard(),
+ ok = test_guard2(),
+ ok = test_call(),
+ ok.
+
+test_guard() ->
+ zero_fun = test_f2(fun () -> ok end),
+ unary_fun = test_f2(fun(X) -> X end),
+ binary_fun = test_f2(fun (X, Y) -> {X, Y} end),
+ no_fun = test_f2(gazonk),
+ ok.
+
+test_f2(Fun) when is_function(Fun, 0) ->
+ zero_fun;
+test_f2(Fun) when is_function(Fun, 1) ->
+ unary_fun;
+test_f2(Fun) when is_function(Fun, 2) ->
+ binary_fun;
+test_f2(_) ->
+ no_fun.
+
+test_guard2() ->
+ zero_fun = test_f2_n(fun () -> ok end, 0),
+ unary_fun = test_f2_n(fun (X) -> X end, 1),
+ binary_fun = test_f2_n(fun (X, Y) -> {X, Y} end, 2),
+ no_fun = test_f2_n(gazonk, 0),
+ ok.
+
+test_f2_n(F, N) when is_function(F, N) ->
+ case N of
+ 0 -> zero_fun;
+ 1 -> unary_fun;
+ 2 -> binary_fun
+ end;
+test_f2_n(_, _) ->
+ no_fun.
+
+test_call() ->
+ true = test_fn2(fun (X, Y) -> {X,Y} end, 2),
+ false = test_fn2(fun (X, Y) -> {X,Y} end, 3),
+ false = test_fn2(gazonk, 2),
+ {'EXIT', {badarg, _TR1}} = (catch test_fn2(gazonk, gazonk)),
+ {'EXIT', {badarg, _TR2}} = (catch test_fn2(fun (X, Y) -> {X, Y} end, gazonk)),
+ ok.
+
+test_fn2(F, N) ->
+ is_function(F, N).
diff --git a/lib/hipe/test/basic_SUITE_data/basic_guards.erl b/lib/hipe/test/basic_SUITE_data/basic_guards.erl
new file mode 100644
index 0000000000..50c0ddd972
--- /dev/null
+++ b/lib/hipe/test/basic_SUITE_data/basic_guards.erl
@@ -0,0 +1,58 @@
+%%% -*- erlang-indent-level: 2 -*-
+%%%-------------------------------------------------------------------
+%%% Author: Kostis Sagonas
+%%%
+%%% Contains tests for correct handling of guards and guard BIFs.
+%%%-------------------------------------------------------------------
+-module(basic_guards).
+
+-export([test/0]).
+
+test() ->
+ ok = guard0(4.2),
+ ok = guard1([foo]),
+ ok = test_guard2(),
+ ok = test_guard3(),
+ ok.
+
+%%--------------------------------------------------------------------
+
+guard0(X) when X /= 0, is_float(X) ->
+ ok.
+
+guard1(X) when is_atom(X) orelse is_float(X) ->
+ error1;
+guard1(X) when is_reference(hd(X)) ->
+ error2;
+guard1(X) when is_integer(hd(X)) ->
+ error3;
+guard1(X) when hd(X) == foo ->
+ ok.
+
+%%--------------------------------------------------------------------
+
+test_guard2() ->
+ ok1 = guard2(true),
+ not_boolean = guard2(42),
+ ok2 = guard2(false),
+ ok.
+
+guard2(X) when X -> % gets transformed to: is_boolean(X), X =:= true
+ ok1;
+guard2(X) when X =:= false ->
+ ok2;
+guard2(_) ->
+ not_boolean.
+
+%%--------------------------------------------------------------------
+
+-define(is_foo(X), (is_atom(X) or (is_tuple(X) and (element(1, X) =:= 'foo')))).
+
+test_guard3() ->
+ no = f('foo'),
+ yes = f({'foo', 42}),
+ no = f(42),
+ ok.
+
+f(X) when ?is_foo(X) -> yes;
+f(_) -> no.
diff --git a/lib/hipe/test/basic_SUITE_data/basic_issues_beam.erl b/lib/hipe/test/basic_SUITE_data/basic_issues_beam.erl
new file mode 100644
index 0000000000..47306b2502
--- /dev/null
+++ b/lib/hipe/test/basic_SUITE_data/basic_issues_beam.erl
@@ -0,0 +1,325 @@
+%%% -*- erlang-indent-level: 2 -*-
+%%%-------------------------------------------------------------------
+%%% Author: Kostis Sagonas
+%%%
+%%% Contains code examples, mostly taken from the mailing list, that
+%%% crashed the BEAM compiler or gave an internal error at some point.
+%%%-------------------------------------------------------------------
+-module(basic_issues_beam).
+
+-export([test/0]).
+
+test() ->
+ ok = test_crash_R10_hinde(),
+ ok = test_error_R10_mander(),
+ ok = test_error_R11_bjorklund(),
+ ok = test_error_R11_rath(),
+ ok = test_error_R12_empty_bin_rec(),
+ ok = test_bug_R12_cornish(),
+ ok = test_crash_R12_morris(),
+ ok = test_error_R13_almeida(),
+ ok = test_error_R13B01_fisher(),
+ ok = test_error_R13B01_sawatari(),
+ ok = test_error_R13B01_whongo(),
+ ok = test_error_R16B03_norell(),
+ ok = test_error_try_wings(),
+ ok.
+
+%%--------------------------------------------------------------------
+%% Fisher R10 compiler crash
+%%--------------------------------------------------------------------
+
+-record(r, {a, b, c}).
+
+test_crash_R10_hinde() ->
+ rec_R10_hinde(#r{}).
+
+rec_R10_hinde(As) ->
+ case As of
+ A when A#r.b == ""; A#r.b == undefined -> ok;
+ _ -> error
+ end.
+
+%%--------------------------------------------------------------------
+%% From: Peter-Henry Mander
+%% Date: 27 Jan, 2005
+%%
+%% I managed to isolate a non-critical BEAM compilation error
+%% (internal error in v3_codegen) when compiling the following code:
+%%--------------------------------------------------------------------
+
+test_error_R10_mander() ->
+ try just_compile_me_R10() catch _:_ -> ok end.
+
+just_compile_me_R10() ->
+ URI_Before =
+ {absoluteURI,
+ {scheme, fun() -> nil end},
+ {hier_part,
+ {net_path,
+ {srvr,
+ {userinfo, nil},
+ fun() -> nil end},
+ nil},
+ {port, nil}}},
+ {absoluteURI,
+ {scheme, _},
+ {hier_part,
+ {net_path,
+ {srvr,
+ {userinfo, nil},
+ _HostportBefore},
+ nil},
+ {port, nil}}} = URI_Before,
+ %% ... some funky code ommitted, not relevant ...
+ {absoluteURI,
+ {scheme, _},
+ {hier_part,
+ {net_path,
+ {srvr,
+ {userinfo, nil},
+ HostportAfter},
+ nil},
+ {port, nil}}} = URI_Before,
+ %% NOTE: I intended to write URI_After instead of URI_Before
+ %% but the accident revealed that when you add the line below,
+ %% it causes internal error in v3_codegen on compilation
+ {hostport, {hostname, "HostName"}, {port, nil}} = HostportAfter,
+ ok.
+
+%%--------------------------------------------------------------------
+%% From: Martin Bjorklund
+%% Date: Aug 16, 2006
+%%
+%% I found this compiler bug in R10B-10 and R11B-0.
+%%
+%% Function -just_compile_me/0-fun-2-/1 refers to undefined label 18
+%% ./bjorklund_R11compiler_bug.erl:none: internal error in beam_clean;
+%% crash reason: {{case_clause,{'EXIT',{undefined_label,18}}},
+%% [{compile,'-select_passes/2-anonymous-2-',2},
+%% {compile,'-internal_comp/4-anonymous-1-',2},
+%% {compile,fold_comp,3},
+%% {compile,internal_comp,4},
+%% {compile,internal,3}]}
+%%--------------------------------------------------------------------
+
+test_error_R11_bjorklund() ->
+ just_compile_me_R11_bjorklund().
+
+just_compile_me_R11_bjorklund() ->
+ G = fun() -> ok end,
+ try
+ G() %% fun() -> ok end
+ after
+ fun({A, B}) -> A + B end
+ end.
+
+%%--------------------------------------------------------------------
+%% From: Tim Rath
+%% Date: Sep 13, 2006
+%% Subject: Compiler bug not quite fixed
+%%
+%% I saw a compiler bug posted to the list by Martin Bjorklund that
+%% appeared to be exactly the problem I'm seeing, and then noticed
+%% that this was fixed in R11B-1. Unfortunately, though R11B-1 appears
+%% to fix the code submitted by Martin, it does not fix my case.
+%%
+%% Function -just_compile_me/0-fun-2-/1 refers to undefined label 13
+%% ./rath_R11compiler_bug.erl:none: internal error in beam_clean;
+%% crash reason: {{case_clause,{'EXIT',{undefined_label,13}}},
+%% [{compile,'-select_passes/2-anonymous-2-',2},
+%% {compile,'-internal_comp/4-anonymous-1-',2},
+%% {compile,fold_comp,3},
+%% {compile,internal_comp,4},
+%% {compile,internal,3}]}
+%%--------------------------------------------------------------------
+
+test_error_R11_rath() ->
+ just_compile_me_R11_rath().
+
+just_compile_me_R11_rath() ->
+ A = {6},
+ try
+ io:fwrite("")
+ after
+ fun () ->
+ fun () -> {_} = A end
+ end
+ end.
+
+%%----------------------------------------------------------------------
+%% Program that crashed the R12B-0 compiler: internal error in v3_codegen
+%%----------------------------------------------------------------------
+
+-record(rec, {a = <<>> :: binary(), b = 42 :: integer()}).
+
+test_error_R12_empty_bin_rec() ->
+ 42 = test_empty_bin_rec(#rec{}),
+ ok.
+
+test_empty_bin_rec(R) ->
+ #rec{a = <<>>} = R,
+ R#rec.b.
+
+%%----------------------------------------------------------------------
+%% From: Simon Cornish
+%% Date: Jan 13, 2008
+%%
+%% The attached Erlang code demonstrates an R12B-0 bug with funs.
+%% Compile and evaluate the two die/1 calls for two different failure modes.
+%% It seems to me that the live register check for call_fun is off by one.
+%%----------------------------------------------------------------------
+
+-record(b, {c}).
+
+test_bug_R12_cornish() ->
+ {a2, a} = die(a),
+ {a2, {b, c}} = die({b, c}),
+ ok.
+
+die(A) ->
+ F = fun() -> {ok, A} end,
+ if A#b.c =:= [] -> one;
+ true ->
+ case F() of
+ {ok, A2} -> {a2, A2};
+ _ -> three
+ end
+ end.
+
+%%----------------------------------------------------------------------
+%% From: Hunter Morris
+%% Date: Nov 20, 2008
+%%
+%% The following code (tested with R12B-4 or R12B-5, vanilla compiler
+%% options) produces a compiler crash. It's nonsensical, and I realise
+%% that andalso can be quite evil, but it's a crash nonetheless.
+%%----------------------------------------------------------------------
+
+test_crash_R12_morris() ->
+ foo(42).
+
+foo(Bar) when (is_integer(Bar) andalso Bar =:= 0) ; Bar =:= 42 ->
+ ok.
+
+%%--------------------------------------------------------------------
+%% From: Paulo Sergio Almeida
+%% Date: May 20, 2009
+%%
+%% The following code when compiled under R13B gives a compiler error.
+%% Function loop/1 refers to undefined label 6
+%% ./almeida_R13compiler_bug.erl:none: internal error in beam_peep;
+%% crash reason: {{case_clause,{'EXIT',{undefined_label,6}}},
+%% [{compile,'-select_passes/2-anonymous-2-',2},
+%% {compile,'-internal_comp/4-anonymous-1-',2},
+%%--------------------------------------------------------------------
+
+test_error_R13_almeida() ->
+ self() ! {backup, 42, false},
+ loop([]).
+
+loop(Tids) ->
+ receive
+ {backup, Tid, Dumping} ->
+ case Dumping of
+ false -> ok;
+ _ -> receive {logged, Tab, Tid} -> put({log, Tab}, Tid) end
+ end,
+ collect(Tid, Tids, [])
+ end.
+
+collect(_, _, _) -> ok.
+
+%%--------------------------------------------------------------------
+%% Fisher R13B01 compiler error
+%%--------------------------------------------------------------------
+
+test_error_R13B01_fisher() ->
+ perform_select({foo, "42"}).
+
+perform_select({Type, Keyval}) ->
+ try
+ if is_atom(Type) andalso length(Keyval) > 0 -> ok;
+ true -> ok
+ end
+ catch
+ _:_ -> fail
+ end.
+
+%%--------------------------------------------------------------------
+%% From: Mikage Sawatari
+%% Date: Jun 12, 2009
+%%
+%% I have the following compilation problem on Erlang R13B01.
+%% Compiler reports "Internal consistency check failed".
+%%--------------------------------------------------------------------
+
+test_error_R13B01_sawatari() ->
+ test_sawatari([1, null, 3], <<1, 2, 3>>).
+
+test_sawatari([], _Bin) -> ok;
+test_sawatari([H|T], Bin) ->
+ _ = case H of
+ null -> <<Bin/binary>>;
+ _ -> ok
+ end,
+ test_sawatari(T, Bin).
+
+%%--------------------------------------------------------------------
+
+test_error_R13B01_whongo() ->
+ S = "gazonk",
+ S = orgno_alphanum(S),
+ ok.
+
+orgno_alphanum(Cs) ->
+ [C || C <- Cs, ((C >= $0) andalso (C =< $9))
+ orelse ((C >= $a) andalso (C =< $z))
+ orelse ((C >= $A) andalso (C =< $Z))].
+
+%%--------------------------------------------------------------------
+%% I'm getting an Internal Consistency Check error when attempting to
+%% build Wings3D on Mac OS X 10.4.2 (Erlang OTP R10B-6):
+%%
+%% erlc -pa /ebin +warn_unused_vars -I/include -I ../e3d -W +debug_info
+%% '-Dwings_version="0.98.31"' -pa ../ebin -o../ebin wings_color.erl
+%% wings_color: function internal_rgb_to_hsv/3+97:
+%% Internal consistency check failed - please report this bug.
+%% Instruction: {test,is_eq_exact,{f,80},[{x,0},{atom,error}]}
+%% Error: {unsafe_instruction,{float_error_state,cleared}}:
+%%
+%% The problem is the interaction of the 'try' construct with the
+%% handling of FP exceptions.
+%%--------------------------------------------------------------------
+
+test_error_try_wings() ->
+ %% a call with a possible FP exception
+ {199.99999999999997, 0.045454545454545456, 44} = rgb_to_hsv(42, 43, 44),
+ ok.
+
+rgb_to_hsv(R, G, B) ->
+ Max = lists:max([R, G, B]),
+ Min = lists:min([R, G, B]),
+ V = Max,
+ {Hue, Sat} = try
+ {if Min == B -> (G-Min)/(R+G-2.0*Min);
+ Min == R -> (1.0+(B-Min)/(B+G-2.0*Min));
+ Min == G -> (2.0+(R-Min)/(B+R-2.0*Min))
+ end * 120, (Max-Min)/Max}
+ catch
+ error:badarith -> {undefined, 0.0}
+ end,
+ {Hue, Sat, V}.
+
+%%--------------------------------------------------------------------
+%% From: Ulf Norell
+%% Date: Feb 28, 2014
+%%
+%% This caused an internal error in v3_codegen
+%%--------------------------------------------------------------------
+
+test_error_R16B03_norell() ->
+ test_error_R16B03_norell(#r{}, gazonk).
+
+test_error_R16B03_norell(Rec, Tag) ->
+ ok. %% is_record(Rec, Tag, 3) orelse ok.
diff --git a/lib/hipe/test/basic_SUITE_data/basic_issues_hipe.erl b/lib/hipe/test/basic_SUITE_data/basic_issues_hipe.erl
new file mode 100644
index 0000000000..e3618c0e72
--- /dev/null
+++ b/lib/hipe/test/basic_SUITE_data/basic_issues_hipe.erl
@@ -0,0 +1,119 @@
+%%% -*- erlang-indent-level: 2 -*-
+%%%-------------------------------------------------------------------
+%%% Author: Kostis Sagonas
+%%%
+%%% Contains code examples that exhibited crashes in the HiPE compiler.
+%%%-------------------------------------------------------------------
+-module(basic_issues_hipe).
+
+-export([test/0]).
+
+%% functions that need to be exported so that they are retained.
+-export([auth/4]).
+
+test() ->
+ ok = test_bif_fails(),
+ ok = test_var_pair(),
+ ok = test_find_catches(),
+ ok = test_heap_allocate_trim(),
+ ok.
+
+%%--------------------------------------------------------------------
+%% This is taken from a file sent to us by Martin Bjorklund @ Nortel
+%% on 14th November 2004. The problem was in the SSA unconvert pass.
+%%
+%% No tests here; we simply check that the HiPE compiler does not go
+%% into an infinite loop when compiling strange functions like this.
+%% --------------------------------------------------------------------
+
+auth(_, A, B, C) ->
+ auth(A, B, C, []).
+
+%%--------------------------------------------------------------------
+%% Checks that the HiPE compiler does not get confused by constant
+%% data structures similar to the internal compiler data structures.
+%%--------------------------------------------------------------------
+
+test_var_pair() ->
+ ok = var_pair([gazonk]).
+
+var_pair([_|_]) ->
+ var_pair({var, some_atom});
+var_pair(_) ->
+ ok.
+
+%%--------------------------------------------------------------------
+%% This module was causing the HiPE compiler to crash in January 2007.
+%% The culprit was an "optimization" of the BEAM compiler: postponing
+%% the save of x variables when BIFs cannot fail. This was fixed on
+%% February 1st, by making the HiPE compiler use the same functions
+%% as the BEAM compiler for deciding whether a BIF fails.
+%%--------------------------------------------------------------------
+
+test_bif_fails() ->
+ [42] = bif_fails_in_catch([42]),
+ true = bif_fails_in_try([42]),
+ ok.
+
+bif_fails_in_catch(X) ->
+ case catch get(gazonk) of
+ _ -> X
+ end.
+
+bif_fails_in_try(X) ->
+ try
+ true = X =/= []
+ catch
+ _ -> nil(X)
+ end.
+
+nil(_) -> [].
+
+%%--------------------------------------------------------------------
+%% Test that resulted in a native code compiler crash in the code of
+%% hipe_icode_exceptions:find_catches/1 when compiling find_catches/2.
+%%--------------------------------------------------------------------
+
+test_find_catches() ->
+ 42 = find_catches(a, false),
+ ok.
+
+find_catches(X, Y) ->
+ case X of
+ a when Y =:= true ->
+ catch id(X),
+ X;
+ b when Y =:= true ->
+ catch id(X),
+ X;
+ a ->
+ catch id(X),
+ 42;
+ b ->
+ catch id(X),
+ 42
+ end.
+
+id(X) -> X.
+
+%%--------------------------------------------------------------------
+%% Date: Dec 28, 2007
+%%
+%% This is a test adapted from the file sent to the Erlang mailing
+%% list by Eranga Udesh. The file did not compile because of problems
+%% with the heap_allocate instruction and stack trimming.
+%%--------------------------------------------------------------------
+
+test_heap_allocate_trim() ->
+ {abandon, 42} = get_next_retry(a, 42),
+ ok.
+
+get_next_retry(Error, Count) ->
+ case catch pair(retry_scheme, {Error, Count}) of
+ _ ->
+ case pair(Error, Count) of
+ _ -> {abandon, Count}
+ end
+ end.
+
+pair(A, B) -> {A, B}.
diff --git a/lib/hipe/test/basic_SUITE_data/basic_lists.erl b/lib/hipe/test/basic_SUITE_data/basic_lists.erl
new file mode 100644
index 0000000000..d229467b84
--- /dev/null
+++ b/lib/hipe/test/basic_SUITE_data/basic_lists.erl
@@ -0,0 +1,41 @@
+%%% -*- erlang-indent-level: 2 -*-
+%%%-------------------------------------------------------------------
+%%% Author: Kostis Sagonas
+%%%
+%%% Contains tests that manipulate and pattern match against lists.
+%%%-------------------------------------------------------------------
+-module(basic_lists).
+
+-export([test/0]).
+
+test() ->
+ ok = test_length(),
+ ok = test_lists_and_strings(),
+ ok.
+
+%%--------------------------------------------------------------------
+
+test_length() ->
+ Len = 42,
+ Lst = mklist(Len, []),
+ Len = iterate(100, Lst),
+ ok.
+
+mklist(0, L) -> L;
+mklist(X, L) -> mklist(X-1, [X|L]).
+
+iterate(0, L) -> len(L, 0);
+iterate(X, L) -> len(L, 0), iterate(X-1, L).
+
+len([_|X], L) -> len(X, L+1);
+len([], L) -> L.
+
+%%--------------------------------------------------------------------
+
+test_lists_and_strings() ->
+ LL = ["H'A", " H'B", " H'C"],
+ LL2 = lists:map(fun string:strip/1, LL),
+ HexFormat = fun(X, Acc) -> {string:substr(X, 3), Acc} end,
+ {LL3,_Ret} = lists:mapfoldl(HexFormat, 0, LL2),
+ ["A", "B", "C"] = lists:sublist(LL3, 42),
+ ok.
diff --git a/lib/hipe/test/basic_SUITE_data/basic_module_info.erl b/lib/hipe/test/basic_SUITE_data/basic_module_info.erl
new file mode 100644
index 0000000000..cab48b10ba
--- /dev/null
+++ b/lib/hipe/test/basic_SUITE_data/basic_module_info.erl
@@ -0,0 +1,32 @@
+%%% -*- erlang-indent-level: 2 -*-
+%%%-------------------------------------------------------------------
+%%% Author: Kostis Sagonas
+%%% Date: Oct 25, 2003
+%%%
+%%% Tests whether calling module_info from the same module works.
+%%% This seems trivial, but the problem is that the module_info/[0,1]
+%%% functions that the BEAM file contains used to be dummy functions
+%%% containing crap. So, these functions could not be used for
+%%% compilation to native code and the functions that the BEAM loader
+%%% generates should have been used instead. This was a HiPE bug
+%%% reported by Dan Wallin.
+%%%-------------------------------------------------------------------
+-module(basic_module_info).
+
+-export([test/0]).
+
+test() ->
+ L = test_local_mi0_call(),
+ E = test_remote_mi1_call(),
+ {3, 3} = {L, E},
+ ok.
+
+test_local_mi0_call() ->
+ ModInfo = module_info(),
+ %% io:format("ok, ModInfo=~w\n", [ModInfo]),
+ {exports, FunList} = lists:keyfind(exports, 1, ModInfo),
+ length(FunList).
+
+test_remote_mi1_call() ->
+ FunList = ?MODULE:module_info(exports),
+ length(FunList).
diff --git a/lib/hipe/test/basic_SUITE_data/basic_pattern_match.erl b/lib/hipe/test/basic_SUITE_data/basic_pattern_match.erl
new file mode 100644
index 0000000000..9922b34415
--- /dev/null
+++ b/lib/hipe/test/basic_SUITE_data/basic_pattern_match.erl
@@ -0,0 +1,36 @@
+%%% -*- erlang-indent-level: 2 -*-
+%%%-------------------------------------------------------------------
+%%% Author: Kostis Sagonas
+%%%
+%%% Contains code examples that test pattern matching against terms of
+%%% various types.
+%%%-------------------------------------------------------------------
+-module(basic_pattern_match).
+
+-export([test/0]).
+
+test() ->
+ ok = test_hello_world(),
+ ok.
+
+%%--------------------------------------------------------------------
+%% Trivial test to test pattern matching compilation with atoms, the
+%% correct handling of all sorts of alphanumeric types in Erlang, and
+%% conversions between them.
+
+test_hello_world() ->
+ String = gimme(string),
+ String = atom_to_list(gimme(atom)),
+ String = binary_to_list(gimme(binary)),
+ true = (list_to_atom(String) =:= gimme(atom)),
+ true = (list_to_binary(String) =:= gimme(binary)),
+ ok.
+
+gimme(string) ->
+ "hello world";
+gimme(atom) ->
+ 'hello world';
+gimme(binary) ->
+ <<"hello world">>.
+
+%%--------------------------------------------------------------------
diff --git a/lib/hipe/test/basic_SUITE_data/basic_receive.erl b/lib/hipe/test/basic_SUITE_data/basic_receive.erl
new file mode 100644
index 0000000000..5f865d7b7a
--- /dev/null
+++ b/lib/hipe/test/basic_SUITE_data/basic_receive.erl
@@ -0,0 +1,56 @@
+%%% -*- erlang-indent-level: 2 -*-
+%%%-------------------------------------------------------------------
+%%% Author: Kostis Sagonas
+%%%
+%%% Contains code examples that test correct handling of receives.
+%%%-------------------------------------------------------------------
+-module(basic_receive).
+
+-export([test/0]).
+
+test() ->
+ ok = test_wait_timeout(),
+ ok = test_double_timeout(),
+ ok = test_reschedule(),
+ ok.
+
+%%--------------------------------------------------------------------
+
+test_wait_timeout() ->
+ receive after 42 -> ok end.
+
+%%--------------------------------------------------------------------
+
+test_double_timeout() ->
+ self() ! foo,
+ self() ! another_foo,
+ receive
+ non_existent -> weird
+ after 0 -> timeout
+ end,
+ receive
+ foo -> ok
+ after 1000 -> timeout
+ end.
+
+%%--------------------------------------------------------------------
+%% Check that RESCHEDULE returns from BIFs work.
+
+test_reschedule() ->
+ erts_debug:set_internal_state(available_internal_state, true),
+ First = self(),
+ Second = spawn(fun() -> doit(First) end),
+ receive
+ Second -> ok
+ end,
+ receive
+ after 42 -> ok
+ end,
+ erts_debug:set_internal_state(hipe_test_reschedule_resume, Second),
+ ok.
+
+doit(First) ->
+ First ! self(),
+ erts_debug:set_internal_state(hipe_test_reschedule_suspend, 1).
+
+%%--------------------------------------------------------------------
diff --git a/lib/hipe/test/basic_SUITE_data/basic_tuples.erl b/lib/hipe/test/basic_SUITE_data/basic_tuples.erl
new file mode 100644
index 0000000000..94c187e364
--- /dev/null
+++ b/lib/hipe/test/basic_SUITE_data/basic_tuples.erl
@@ -0,0 +1,177 @@
+%%% -*- erlang-indent-level: 2 -*-
+%%%-------------------------------------------------------------------
+%%% Author: Kostis Sagonas
+%%%
+%%% Contains tests that manipulate and pattern match against tuples.
+%%%-------------------------------------------------------------------
+-module(basic_tuples).
+
+-export([test/0]).
+
+test() ->
+ Num = 4711,
+ ok = test_match({}, {1}, {1,2}, {1,2,3}, {1,2,3,4}, {1,2,3,4,5},
+ {1,2,3,4,5,6}, {1,2,3,4,5,6,7}, {1,2,3,4,5,6,7,8}),
+ ok = test_size({}, {a}, {{a},{b}}, {a,{b},c}),
+ ok = test_element({}, {a}, {a,b}, Num),
+ ok = test_setelement({}, {1}, {1,2}, 3, [1,2]),
+ ok = test_tuple_to_list({}, {a}, {a,b}, {a,b,c}, {a,b,c,d}, Num),
+ ok = test_list_to_tuple([], [a], [a,b], [a,b,c], [a,b,c,d], Num),
+ ok = test_tuple_with_case(),
+ ok = test_tuple_in_guard({a, b}, {a, b, c}),
+ ok.
+
+%%--------------------------------------------------------------------
+%% Tests matching of tuples
+
+test_match(T0, T1, T2, T3, T4, T5, T6, T7, T8) ->
+ {} = T0,
+ {1} = T1,
+ {1, 2} = T2,
+ {1, 2, 3} = T3,
+ {1, 2, 3, 4} = T4,
+ {1, 2, 3, 4, 5} = T5,
+ {1, 2, 3, 4, 5, 6} = T6,
+ T6 = {1, 2, 3, 4, 5, 6},
+ T7 = {1, 2, 3, 4, 5, 6, 7},
+ {1, 2, 3, 4, 5, 6, 7, 8} = T8,
+ ok.
+
+%%--------------------------------------------------------------------
+%% Tests the size/1 and tuple_size/1 BIFs.
+
+test_size(T0, T1, T2, T3) ->
+ [0, 1, 2, 3] = [size(T) || T <- [T0, T1, T2, T3]],
+ [0, 1, 2, 3] = [tuple_size(T) || T <- [T0, T1, T2, T3]],
+ ok.
+
+%%--------------------------------------------------------------------
+%% Tests element/2.
+
+test_element(T0, T1, T2, N) ->
+ a = element(1, T1),
+ a = element(1, T2),
+ %% indirect calls to element/2
+ List = lists:seq(1, N),
+ Tuple = list_to_tuple(List),
+ ok = get_elements(List, Tuple, 1),
+ %% some cases that throw exceptions
+ {'EXIT', _} = (catch my_element(0, T2)),
+ {'EXIT', _} = (catch my_element(3, T2)),
+ {'EXIT', _} = (catch my_element(1, T0)),
+ {'EXIT', _} = (catch my_element(1, List)),
+ {'EXIT', _} = (catch my_element(1, N)),
+ {'EXIT', _} = (catch my_element(1.5, T2)),
+ ok.
+
+my_element(Pos, Term) ->
+ element(Pos, Term).
+
+get_elements([Element|Rest], Tuple, Pos) ->
+ Element = element(Pos, Tuple),
+ get_elements(Rest, Tuple, Pos + 1);
+get_elements([], _Tuple, _Pos) ->
+ ok.
+
+%%--------------------------------------------------------------------
+%% Tests set_element/3.
+
+test_setelement(T0, T1, Pair, Three, L) ->
+ {x} = setelement(1, T1, x),
+ {x, 2} = setelement(1, Pair, x),
+ {1, x} = setelement(2, Pair, x),
+ %% indirect calls to setelement/3
+ Tuple = list_to_tuple(lists:duplicate(2048, x)),
+ NewTuple = set_all_elements(Tuple, 1),
+ NewTuple = list_to_tuple(lists:seq(1+7, 2048+7)),
+ %% the following cases were rewritten to use the Three
+ %% variable in this weird way so as to silence the compiler
+ {'EXIT', _} = (catch setelement(Three - Three, Pair, x)),
+ {'EXIT', _} = (catch setelement(Three, Pair, x)),
+ {'EXIT', _} = (catch setelement(Three div Three, T0, x)),
+ {'EXIT', _} = (catch setelement(Three div Three, L, x)),
+ {'EXIT', _} = (catch setelement(Three / 2, Pair, x)),
+ ok.
+
+set_all_elements(Tuple, Pos) when Pos =< tuple_size(Tuple) ->
+ set_all_elements(setelement(Pos, Tuple, Pos+7), Pos+1);
+set_all_elements(Tuple, Pos) when Pos > tuple_size(Tuple) ->
+ Tuple.
+
+%%--------------------------------------------------------------------
+%% Tests tuple_to_list/1.
+
+test_tuple_to_list(T0, T1, T2, T3, T4, Size) ->
+ [] = tuple_to_list(T0),
+ [a] = tuple_to_list(T1),
+ [a, b] = tuple_to_list(T2),
+ [a, b, c] = tuple_to_list(T3),
+ [a, b, c, d] = tuple_to_list(T4),
+ [a, b, c, d] = tuple_to_list(T4),
+ %% test a big tuple
+ List = lists:seq(1, Size),
+ Tuple = list_to_tuple(List),
+ Size = tuple_size(Tuple),
+ List = tuple_to_list(Tuple),
+ %% some cases that should result in errors
+ {'EXIT', _} = (catch my_tuple_to_list(element(2, T3))),
+ {'EXIT', _} = (catch my_tuple_to_list(Size)),
+ ok.
+
+my_tuple_to_list(X) ->
+ tuple_to_list(X).
+
+%%--------------------------------------------------------------------
+%% Tests list_to_tuple/1.
+
+test_list_to_tuple(L0, L1, L2, L3, L4, Size) ->
+ {} = list_to_tuple(L0),
+ {a} = list_to_tuple(L1),
+ {a, b} = list_to_tuple(L2),
+ {a, b, c} = list_to_tuple(L3),
+ {a, b, c, d} = list_to_tuple(L4),
+ {a, b, c, d, e} = list_to_tuple(L4++[e]),
+ %% test list_to_tuple with a big list
+ Tuple = list_to_tuple(lists:seq(1, Size)),
+ Size = tuple_size(Tuple),
+ %% some cases that should result in errors
+ {'EXIT', _} = (catch my_list_to_tuple({a,b})),
+ {'EXIT', _} = (catch my_list_to_tuple([hd(L1)|hd(L2)])),
+ ok.
+
+my_list_to_tuple(X) ->
+ list_to_tuple(X).
+
+%%--------------------------------------------------------------------
+%% Tests that a case nested inside a tuple is ok.
+%% (This was known to crash earlier versions of BEAM.)
+
+test_tuple_with_case() ->
+ {reply, true} = tuple_with_case(),
+ ok.
+
+tuple_with_case() ->
+ %% The following comments apply to the BEAM compiler.
+ void(), % Reset var count.
+ {reply, % Compiler will choose {x,1} for tuple.
+ case void() of % Call will reset var count.
+ {'EXIT', Reason} -> % Case will return in {x,1} (first free),
+ {error, Reason}; % but the tuple will be build in {x,1},
+ _ -> % so case value is lost and a circular
+ true % data element is built.
+ end}.
+
+void() -> ok.
+
+%%--------------------------------------------------------------------
+%% Test to build a tuple in a guard.
+
+test_tuple_in_guard(T2, T3) ->
+ %% T2 = {a, b}; T3 = {a, b, c}
+ ok = if T2 == {element(1, T3), element(2, T3)} -> ok;
+ true -> other
+ end,
+ ok = if T3 == {element(1, T3), element(2, T3), element(3, T3)} -> ok;
+ true -> other
+ end,
+ ok.