aboutsummaryrefslogtreecommitdiffstats
path: root/lib/hipe/test
diff options
context:
space:
mode:
authorKostis Sagonas <[email protected]>2014-03-04 14:05:49 +0100
committerKostis Sagonas <[email protected]>2015-12-16 22:08:32 +0100
commit6a645e07a02f9adda9b9534214e699ad8f30a15f (patch)
tree204668b974388eeb551ec14a4e52c7ee535acb92 /lib/hipe/test
parent9fd2f21c38944c8a605020d6662bb5935c5bbee2 (diff)
downloadotp-6a645e07a02f9adda9b9534214e699ad8f30a15f.tar.gz
otp-6a645e07a02f9adda9b9534214e699ad8f30a15f.tar.bz2
otp-6a645e07a02f9adda9b9534214e699ad8f30a15f.zip
More basic tests
and some tests that the HiPE compiler is not causing trouble
Diffstat (limited to 'lib/hipe/test')
-rw-r--r--lib/hipe/test/basic_SUITE_data/basic_arith.erl2
-rw-r--r--lib/hipe/test/basic_SUITE_data/basic_beam_instrs.erl12
-rw-r--r--lib/hipe/test/basic_SUITE_data/basic_bignums.erl19
-rw-r--r--lib/hipe/test/basic_SUITE_data/basic_bugs_beam.erl37
-rw-r--r--lib/hipe/test/basic_SUITE_data/basic_bugs_hipe.erl111
-rw-r--r--lib/hipe/test/basic_SUITE_data/basic_exceptions.erl122
-rw-r--r--lib/hipe/test/basic_SUITE_data/basic_guards.erl17
-rw-r--r--lib/hipe/test/basic_SUITE_data/basic_issues_hipe.erl38
-rw-r--r--lib/hipe/test/basic_SUITE_data/basic_lists.erl22
-rw-r--r--lib/hipe/test/basic_SUITE_data/basic_random.erl238
-rw-r--r--lib/hipe/test/basic_SUITE_data/basic_records.erl28
-rw-r--r--lib/hipe/test/sanity_SUITE_data/sanity_comp_timeout.erl26
-rw-r--r--lib/hipe/test/sanity_SUITE_data/sanity_no_zombies.erl19
13 files changed, 677 insertions, 14 deletions
diff --git a/lib/hipe/test/basic_SUITE_data/basic_arith.erl b/lib/hipe/test/basic_SUITE_data/basic_arith.erl
index 3dddc265c8..0277ad852b 100644
--- a/lib/hipe/test/basic_SUITE_data/basic_arith.erl
+++ b/lib/hipe/test/basic_SUITE_data/basic_arith.erl
@@ -43,7 +43,7 @@ bbb(X, Y, 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,
+ badarith = try uplus(gazonk) catch error:Err -> Err end,
42 = uplus(42),
ok.
diff --git a/lib/hipe/test/basic_SUITE_data/basic_beam_instrs.erl b/lib/hipe/test/basic_SUITE_data/basic_beam_instrs.erl
index 50c2180cbd..6fafea3b09 100644
--- a/lib/hipe/test/basic_SUITE_data/basic_beam_instrs.erl
+++ b/lib/hipe/test/basic_SUITE_data/basic_beam_instrs.erl
@@ -13,6 +13,7 @@ test() ->
ok = test_switch_val(),
ok = test_put_literal(),
ok = test_set_tuple_element(),
+ ok = test_unguarded_unsafe_element(),
ok.
%%--------------------------------------------------------------------
@@ -88,3 +89,14 @@ simple_set(State, Val) -> %% f3 = Val is the one used in set_element;
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
+
+%%--------------------------------------------------------------------
+%% Tests the handling of unguarded unsafe_element operations that BEAM
+%% can sometimes construct on records (when it has enough context).
+
+test_unguarded_unsafe_element() ->
+ {badrecord, rec} = try unguarded_unsafe_element(42) catch error:E -> E end,
+ ok.
+
+unguarded_unsafe_element(X) ->
+ X#rec{f1 = X#rec.f3}.
diff --git a/lib/hipe/test/basic_SUITE_data/basic_bignums.erl b/lib/hipe/test/basic_SUITE_data/basic_bignums.erl
index c455bf318f..79f62e3229 100644
--- a/lib/hipe/test/basic_SUITE_data/basic_bignums.erl
+++ b/lib/hipe/test/basic_SUITE_data/basic_bignums.erl
@@ -13,6 +13,8 @@ test() ->
ok = test_big_fac(),
ok = test_int_overfl_32(),
ok = test_int_overfl_64(),
+ ok = test_int_overfl_32_guard(),
+ ok = test_int_overfl_64_guard(),
ok.
%%--------------------------------------------------------------------
@@ -122,3 +124,20 @@ test_int_overfl_64() ->
add(X, Y) -> X + Y.
%%--------------------------------------------------------------------
+%% Tests for correct handling of integer overflow in guards
+
+test_int_overfl_32_guard() ->
+ ok = overfl_in_guard(16#7ffffff, 0),
+ ok = overfl_in_guard(16#7ffffff, 16#7ffffff),
+ ok.
+
+test_int_overfl_64_guard() ->
+ ok = overfl_in_guard(16#7ffffffffffffff, 0),
+ ok = overfl_in_guard(16#7ffffffffffffff, 16#7ffffffffffffff),
+ ok.
+
+overfl_in_guard(X, Y) ->
+ case ok of
+ V when X+Y > 12 -> V;
+ _ -> bad
+ end.
diff --git a/lib/hipe/test/basic_SUITE_data/basic_bugs_beam.erl b/lib/hipe/test/basic_SUITE_data/basic_bugs_beam.erl
index 0cf9a3cd4c..964b0f423a 100644
--- a/lib/hipe/test/basic_SUITE_data/basic_bugs_beam.erl
+++ b/lib/hipe/test/basic_SUITE_data/basic_bugs_beam.erl
@@ -8,6 +8,8 @@
-export([test/0]).
+%% the following is needed for the test_weird_message
+-export([loop/1]).
%% the following are needed for the test_catch_bug
-behaviour(gen_server).
-export([start_link/1]).
@@ -16,6 +18,7 @@
test() ->
ok = test_fp_basic_blocks(),
+ ok = test_weird_message(),
ok = test_catch_bug(),
ok.
@@ -64,6 +67,40 @@ bad_arith2(X, Y) when is_float(X) ->
{X1 + 1.0, Y1}.
%%--------------------------------------------------------------------
+%% Sending 'test' to this process should return 'ok'. But:
+%%
+%% 1> MOD:test().
+%% Weird: received true
+%% timeout
+%%
+%% Surprisingly, the message has been bound to the value of 'ena'
+%% in the record! The problem was visible in the .S file.
+%%--------------------------------------------------------------------
+
+-record(state, {ena = true}).
+
+test_weird_message() ->
+ P = spawn_link(?MODULE, loop, [#state{}]),
+ P ! {msg, self()},
+ receive
+ What -> What
+ after 42 -> timeout
+ end.
+
+loop(S) ->
+ receive
+ _ when S#state.ena == false ->
+ io:format("Weird: ena is false\n");
+ % loop(S);
+ {msg, Pid} ->
+ Pid ! ok;
+ % loop(S);
+ Other ->
+ io:format("Weird: received ~p\n", [Other])
+ % loop(S)
+ end.
+
+%%--------------------------------------------------------------------
%% This was posted on the Erlang mailing list as a question:
%%
%% Given the module below and the function call
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 1948e4efa7..01add52cb0 100644
--- a/lib/hipe/test/basic_SUITE_data/basic_bugs_hipe.erl
+++ b/lib/hipe/test/basic_SUITE_data/basic_bugs_hipe.erl
@@ -1,9 +1,9 @@
%%% -*- erlang-indent-level: 2 -*-
-%%%-------------------------------------------------------------------
+%%%----------------------------------------------------------------------
%%% Author: Kostis Sagonas
%%%
%%% Contains code examples that exhibited bugs in the HiPE compiler.
-%%%-------------------------------------------------------------------
+%%%----------------------------------------------------------------------
-module(basic_bugs_hipe).
-export([test/0]).
@@ -11,10 +11,13 @@
test() ->
ok = test_ets_bifs(),
ok = test_bit_shift(),
+ ok = test_match_big_list(),
+ ok = test_unsafe_bsl(),
+ ok = test_unsafe_bsr(),
ok = test_R12B5_seg_fault(),
ok.
-%%--------------------------------------------------------------------
+%%-----------------------------------------------------------------------
%% From: Bjorn Gustavsson
%%
%% This code, if HiPE compiled, crashed like this (on SPARC)
@@ -34,7 +37,7 @@ test() ->
%% 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},
@@ -63,8 +66,7 @@ do_random_test() ->
true ->
ok
end
- end,
- 2000),
+ end, 2000),
%% io:format("~nData matched~n"),
ets:match_delete(OrdSet, '_'),
ets:match_delete(Set, '_'),
@@ -107,7 +109,7 @@ do_n_times(Fun, N) ->
end,
do_n_times(Fun, N - 1).
-%%--------------------------------------------------------------------
+%%-----------------------------------------------------------------------
%% From: Niclas Pehrsson
%% Date: Apr 20, 2006
%%
@@ -115,7 +117,7 @@ do_n_times(Fun, N) ->
%% 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
@@ -154,12 +156,103 @@ shift_fun() ->
(length_list() + 4) bsr 2.
%%-----------------------------------------------------------------------
+%% From: Igor Goryachev
+%% Date: June 15, 2006
+%%
+%% I have experienced a different behaviour and possibly a weird result
+%% while playing with matching a big list on x86 and x86_64 machines.
+%%-----------------------------------------------------------------------
+
+-define(BIG_LIST,
+ ["uid", "nickname", "n_family", "n_given", "email_pref",
+ "tel_home_number", "tel_cellular_number", "adr_home_country",
+ "adr_home_locality", "adr_home_region", "url", "gender", "bday",
+ "constitution", "height", "weight", "hair", "routine", "smoke",
+ "maritalstatus", "children", "independence", "school_number",
+ "school_locality", "school_title", "school_period", "org_orgname",
+ "title", "adr_work_locality", "photo_type", "photo_binval"]).
+
+test_match_big_list() ->
+ case create_tuple_with_big_const_list() of
+ {selected, ?BIG_LIST, _} -> ok;
+ _ -> weird
+ end.
+
+create_tuple_with_big_const_list() ->
+ {selected, ?BIG_LIST, [{"test"}]}.
+
+%%-----------------------------------------------------------------------
+%% In October 2006 the HiPE compiler acquired more type-driven
+%% optimisations of arithmetic operations. One of these, the
+%% transformation of bsl to a pure fixnum bsl fixnum -> fixnum version
+%% (unsafe_bsl), was incorrectly performed even when the result
+%% wouldn't be a fixnum. The error occurred for all backends, but the
+%% only place known to break was hipe_arm:imm_to_am1/2. Some
+%% immediates got broken on ARM, causing segmentation faults in
+%% compiler_tests when HiPE recompiled itself.
+%%-----------------------------------------------------------------------
+
+test_unsafe_bsl() ->
+ ok = bsl_check(bsl_test_cases()).
+
+bsl_test_cases() ->
+ [{16#FF, {16#FF, 0}},
+ {16#F000000F, {16#FF, 2}}].
+
+bsl_check([]) -> ok;
+bsl_check([{X, Y}|Rest]) ->
+ case imm_to_am1(X) of
+ Y -> bsl_check(Rest);
+ _ -> 'hipe_broke_bsl'
+ end.
+
+imm_to_am1(Imm) ->
+ imm_to_am1(Imm band 16#FFFFFFFF, 16).
+imm_to_am1(Imm, RotCnt) ->
+ if Imm >= 0, Imm =< 255 -> {Imm, RotCnt band 15};
+ true ->
+ NewRotCnt = RotCnt - 1,
+ if NewRotCnt =:= 0 -> []; % full circle, no joy
+ true ->
+ NewImm = (Imm bsr 2) bor ((Imm band 3) bsl 30),
+ imm_to_am1(NewImm, NewRotCnt)
+ end
+ end.
+
+%%-----------------------------------------------------------------------
+%% Another transformation, namely that of bsr to a pure fixnum bsr
+%% fixnum -> fixnum version (unsafe_bsr), failed to check for shifts
+%% larger than the number of bits in fixnums. Such shifts should
+%% return zero, but instead they became plain machine-level shift
+%% instructions. Machines often only consider the low-order bits of
+%% the shift count, so machine-level shifts larger than the word size
+%% do not match the Erlang semantics.
+%%-----------------------------------------------------------------------
+
+test_unsafe_bsr() ->
+ ok = bsr_check(bsr_test_cases()).
+
+bsr_test_cases() ->
+ [{16#FF, 4, 16#0F},
+ {16#FF, 64, 0}].
+
+bsr_check([]) -> ok;
+bsr_check([{X, Y, Z}|Rest]) ->
+ case do_bsr(X, Y) of
+ Z -> bsr_check(Rest);
+ _ -> 'hipe_broke_bsr'
+ end.
+
+do_bsr(X, Y) ->
+ (X band 16#FFFF) bsr (Y band 16#FFFF).
+
+%%-----------------------------------------------------------------------
%% 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)
+%% Eshell V5.6.5
%% 1> crash:test().
%% # Some message to be printed here each loop iteration
%% Segmentation fault
diff --git a/lib/hipe/test/basic_SUITE_data/basic_exceptions.erl b/lib/hipe/test/basic_SUITE_data/basic_exceptions.erl
index cf11e8b2a0..082e805580 100644
--- a/lib/hipe/test/basic_SUITE_data/basic_exceptions.erl
+++ b/lib/hipe/test/basic_SUITE_data/basic_exceptions.erl
@@ -6,7 +6,7 @@
%%%-------------------------------------------------------------------
-module(basic_exceptions).
--export([test/0]).
+-export([test/0, test_catches/0]).
%% functions used as arguments to spawn/3
-export([bad_guy/2]).
@@ -15,12 +15,64 @@ test() ->
ok = test_catch_exit(42),
ok = test_catch_throw(42),
ok = test_catch_element(),
+ ok = test_catch_crash(),
+ ok = test_catch_empty(),
ok = test_catch_merge(),
+ ok = test_catches_merged(),
ok = test_pending_errors(),
ok = test_bad_fun_call(),
ok.
%%--------------------------------------------------------------------
+%% Written in 2001 by Erik Johansson.
+
+test_catches() ->
+ ExitBar = {'EXIT', bar},
+ L1 = [ExitBar, ok, ExitBar, {ok, ExitBar}],
+ L1 = [t1(), t2(), t3(), t4()],
+ badarith = (catch element(1, element(2, t5(a, b)))),
+ L2 = [42, ExitBar, ExitBar, {no_exception, ok}],
+ L2 = [t5(21, 21), t6(), t7(), t8()],
+ ok.
+
+t1() ->
+ catch foo().
+
+t2() ->
+ V = (catch ok()),
+ s(),
+ V.
+
+t3() ->
+ V = (catch foo()),
+ V.
+
+t4() ->
+ V1 = ok(),
+ V2 = (catch foo()),
+ {V1, V2}.
+
+t5(A, B) ->
+ catch A + B.
+
+t6() ->
+ catch {no_exception, ok(), foo()}.
+
+t7() ->
+ catch {no_exception, foo(), ok()}.
+
+t8() ->
+ catch {no_exception, ok()}.
+
+foo() ->
+ s(),
+ exit(bar).
+
+ok() -> s(), ok.
+
+s() -> nada.
+
+%%--------------------------------------------------------------------
test_catch_exit(N) ->
{'EXIT', N} = (catch exit(N)),
@@ -49,6 +101,52 @@ test_catch_element(N) ->
element(1, catch element(N, {1,2,3,4,5,6,7,8,9,10,11})).
%%--------------------------------------------------------------------
+
+-define(try_match(E),
+ catch ?MODULE:non_existing(),
+ {'EXIT', {{badmatch, nomatch}, _}} = (catch E = no_match())).
+
+test_catch_crash() ->
+ ?try_match(a),
+ ?try_match(42),
+ ?try_match({a, b, c}),
+ ?try_match([]),
+ ?try_match(1.0),
+ ok.
+
+no_match() -> nomatch.
+
+%% small_test() ->
+%% catch ?MODULE:non_existing(),
+%% io:format("Before\n",[]),
+%% hipe_bifs:show_nstack(self()),
+%% io:format("After\n",[]),
+%% garbage_collect().
+
+%%--------------------------------------------------------------------
+%% Tests whether the HiPE compiler optimizes catches in a way that
+%% does not result in an infinite loop.
+%%--------------------------------------------------------------------
+
+test_catch_empty() ->
+ badmatch().
+
+badmatch() ->
+ Big = ret_big(),
+ Float = ret_float(),
+ catch a = Big,
+ catch b = Float,
+ ok = case Big of Big -> ok end,
+ ok = case Float of Float -> ok end,
+ ok.
+
+ret_big() ->
+ 329847987298478924982978248748729829487298292982972978239874.
+
+ret_float() ->
+ 3.1415927.
+
+%%--------------------------------------------------------------------
%% Test that shows how BEAM can merge catch-end blocks that belong to
%% different catch-start instructions. Written by Richard Carlsson.
%%--------------------------------------------------------------------
@@ -68,6 +166,28 @@ f(_) -> ok.
g(_) -> ok.
%%--------------------------------------------------------------------
+%% Written by Tobias Lindahl.
+
+test_catches_merged() ->
+ {'EXIT', _} = merged_catches(foo),
+ {'EXIT', {badarith, _}} = merged_catches(bar),
+ {'EXIT', _} = merged_catches(baz),
+ ok.
+
+merged_catches(X) ->
+ case X of
+ foo -> catch fail1(0);
+ bar -> catch {catch(1 = X), fail2(0)};
+ baz -> catch fail3(0)
+ end.
+
+fail1(X) -> 1/X.
+
+fail2(X) -> 1/X.
+
+fail3(X) -> 1/X.
+
+%%--------------------------------------------------------------------
%% Taken from exception_SUITE.erl
%%--------------------------------------------------------------------
diff --git a/lib/hipe/test/basic_SUITE_data/basic_guards.erl b/lib/hipe/test/basic_SUITE_data/basic_guards.erl
index 50c0ddd972..a519944916 100644
--- a/lib/hipe/test/basic_SUITE_data/basic_guards.erl
+++ b/lib/hipe/test/basic_SUITE_data/basic_guards.erl
@@ -13,6 +13,7 @@ test() ->
ok = guard1([foo]),
ok = test_guard2(),
ok = test_guard3(),
+ ok = test_guard4(),
ok.
%%--------------------------------------------------------------------
@@ -56,3 +57,19 @@ test_guard3() ->
f(X) when ?is_foo(X) -> yes;
f(_) -> no.
+
+%%--------------------------------------------------------------------
+
+-define(EXT_REF, <<131,114,0,3,100,0,19,114,101,102,95,116,101,115,116,95,98,117,103,64,103,111,114,98,97,103,2,0,0,0,125,0,0,0,0,0,0,0,0>>).
+
+test_guard4() ->
+ yes = is_ref(make_ref()),
+ no = is_ref(gazonk),
+ yes = is_ref(an_external_ref(?EXT_REF)),
+ ok.
+
+is_ref(Ref) when is_reference(Ref) -> yes;
+is_ref(_Ref) -> no.
+
+an_external_ref(Bin) ->
+ binary_to_term(Bin).
diff --git a/lib/hipe/test/basic_SUITE_data/basic_issues_hipe.erl b/lib/hipe/test/basic_SUITE_data/basic_issues_hipe.erl
index e3618c0e72..e71045bfe2 100644
--- a/lib/hipe/test/basic_SUITE_data/basic_issues_hipe.erl
+++ b/lib/hipe/test/basic_SUITE_data/basic_issues_hipe.erl
@@ -12,8 +12,10 @@
-export([auth/4]).
test() ->
- ok = test_bif_fails(),
+ ok = test_dominance_trees(),
+ ok = test_merged_const(),
ok = test_var_pair(),
+ ok = test_bif_fails(),
ok = test_find_catches(),
ok = test_heap_allocate_trim(),
ok.
@@ -24,12 +26,44 @@ test() ->
%%
%% 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, []).
%%--------------------------------------------------------------------
+%% Exposed a crash in the generation of dominance trees used in SSA.
+%%--------------------------------------------------------------------
+
+-record(state, {f}).
+
+test_dominance_trees() ->
+ {ok, true} = doit(true, #state{f = true}),
+ ok.
+
+doit(Foo, S) ->
+ Fee = case Foo of
+ Bar when Bar == S#state.f; Bar == [] -> true;
+ _ -> false
+ end,
+ {ok, Fee}.
+
+%%--------------------------------------------------------------------
+%% Checks that the merging of constants in the constant table uses the
+%% appropriate comparison function for this.
+%%--------------------------------------------------------------------
+
+test_merged_const() ->
+ Const1 = {'', 1.0000},
+ Const2 = {'', 1},
+ match(Const1, Const2).
+
+match(A, A) ->
+ error;
+match(_A, _B) ->
+ ok.
+
+%%--------------------------------------------------------------------
%% Checks that the HiPE compiler does not get confused by constant
%% data structures similar to the internal compiler data structures.
%%--------------------------------------------------------------------
diff --git a/lib/hipe/test/basic_SUITE_data/basic_lists.erl b/lib/hipe/test/basic_SUITE_data/basic_lists.erl
index d229467b84..264a7f86f6 100644
--- a/lib/hipe/test/basic_SUITE_data/basic_lists.erl
+++ b/lib/hipe/test/basic_SUITE_data/basic_lists.erl
@@ -2,7 +2,8 @@
%%%-------------------------------------------------------------------
%%% Author: Kostis Sagonas
%%%
-%%% Contains tests that manipulate and pattern match against lists.
+%%% Contains tests that manipulate and pattern match against lists
+%%% (perhaps by calling functions from the 'lists' module).
%%%-------------------------------------------------------------------
-module(basic_lists).
@@ -10,6 +11,7 @@
test() ->
ok = test_length(),
+ ok = test_lists_key(),
ok = test_lists_and_strings(),
ok.
@@ -32,6 +34,24 @@ len([], L) -> L.
%%--------------------------------------------------------------------
+test_lists_key() ->
+ First = {x, 42.0},
+ Second = {y, -77},
+ Third = {z, [a, b, c], {5.0}},
+ List = [First, Second, Third],
+ {value, First} = key_search_find(42, 2, List),
+ ok.
+
+key_search_find(Key, Pos, List) ->
+ case lists:keyfind(Key, Pos, List) of
+ false ->
+ false = lists:keysearch(Key, Pos, List);
+ Tuple when is_tuple(Tuple) ->
+ {value, Tuple} = lists:keysearch(Key, Pos, List)
+ end.
+
+%%--------------------------------------------------------------------
+
test_lists_and_strings() ->
LL = ["H'A", " H'B", " H'C"],
LL2 = lists:map(fun string:strip/1, LL),
diff --git a/lib/hipe/test/basic_SUITE_data/basic_random.erl b/lib/hipe/test/basic_SUITE_data/basic_random.erl
new file mode 100644
index 0000000000..8866218318
--- /dev/null
+++ b/lib/hipe/test/basic_SUITE_data/basic_random.erl
@@ -0,0 +1,238 @@
+%%% -*- erlang-indent-level: 2 -*-
+%%%-------------------------------------------------------------------
+%%% Author: Kostis Sagonas
+%%%
+%%% A test for list handling created using the 'random' module.
+%%%-------------------------------------------------------------------
+-module(basic_random).
+
+-export([test/0]).
+
+%% It can be used as a benchmark by playing with the following defines
+-define(N, 1000).
+-define(Iter, 500).
+
+test() ->
+ ok = random(?N).
+
+random(N) ->
+ random(N, ?Iter).
+
+random(N, Iter) ->
+ random:seed(1, 2, 3),
+ t(ranlist(N, [], N*100), Iter).
+
+ranlist(0, L, _N) -> L;
+ranlist(N, L, N0) -> ranlist(N-1, [random:uniform(N0)+300 | L], N0).
+
+t(_, 0) -> ok;
+t(L, Iter) ->
+ %% io:format("Sort starting~n"),
+ sort(L),
+ t(L, Iter-1).
+
+sort([X, Y | L]) when X =< Y ->
+ split_1(X, Y, L, [], []);
+sort([X, Y | L]) ->
+ split_2(X, Y, L, [], []);
+sort(L) ->
+ L.
+
+%% Ascending.
+split_1(X, Y, [Z | L], R, Rs) when Z >= Y ->
+ split_1(Y, Z, L, [X | R], Rs);
+split_1(X, Y, [Z | L], R, Rs) when Z >= X ->
+ split_1(Z, Y, L, [X | R], Rs);
+split_1(X, Y, [Z | L], [], Rs) ->
+ split_1(X, Y, L, [Z], Rs);
+split_1(X, Y, [Z | L], R, Rs) ->
+ split_1_1(X, Y, L, R, Rs, Z);
+split_1(X, Y, [], R, Rs) ->
+ rmergel([[Y, X | R] | Rs], []).
+
+%% One out-of-order element, S.
+split_1_1(X, Y, [Z | L], R, Rs, S) when Z >= Y ->
+ split_1_1(Y, Z, L, [X | R], Rs, S);
+split_1_1(X, Y, [Z | L], R, Rs, S) when Z >= X ->
+ split_1_1(Z, Y, L, [X | R], Rs, S);
+split_1_1(X, Y, [Z | L], R, Rs, S) when S =< Z ->
+ split_1(S, Z, L, [], [[Y, X | R] | Rs]);
+split_1_1(X, Y, [Z | L], R, Rs, S) ->
+ split_1(Z, S, L, [], [[Y, X | R] | Rs]);
+split_1_1(X, Y, [], R, Rs, S) ->
+ rmergel([[S], [Y, X | R] | Rs], []).
+
+%% Descending.
+split_2(X, Y, [Z | L], R, Rs) when Z =< Y ->
+ split_2(Y, Z, L, [X | R], Rs);
+split_2(X, Y, [Z | L], R, Rs) when Z =< X ->
+ split_2(Z, Y, L, [X | R], Rs);
+split_2(X, Y, [Z | L], [], Rs) ->
+ split_2(X, Y, L, [Z], Rs);
+split_2(X, Y, [Z | L], R, Rs) ->
+ split_2_1(X, Y, L, R, Rs, Z);
+split_2(X, Y, [], R, Rs) ->
+ mergel([[Y, X | R] | Rs], []).
+
+split_2_1(X, Y, [Z | L], R, Rs, S) when Z =< Y ->
+ split_2_1(Y, Z, L, [X | R], Rs, S);
+split_2_1(X, Y, [Z | L], R, Rs, S) when Z =< X ->
+ split_2_1(Z, Y, L, [X | R], Rs, S);
+split_2_1(X, Y, [Z | L], R, Rs, S) when S > Z ->
+ split_2(S, Z, L, [], [[Y, X | R] | Rs]);
+split_2_1(X, Y, [Z | L], R, Rs, S) ->
+ split_2(Z, S, L, [], [[Y, X | R] | Rs]);
+split_2_1(X, Y, [], R, Rs, S) ->
+ mergel([[S], [Y, X | R] | Rs], []).
+
+mergel([[] | L], Acc) ->
+ mergel(L, Acc);
+mergel([A, [H2 | T2], [H3 | T3] | L], Acc) ->
+ mergel(L, [merge3_1(A, [], H2, T2, H3, T3) | Acc]);
+mergel([A, [H | T]], Acc) ->
+ rmergel([merge2_1(A, H, T, []) | Acc], []);
+mergel([L], []) ->
+ L;
+mergel([L], Acc) ->
+ rmergel([lists:reverse(L, []) | Acc], []);
+mergel([], []) ->
+ [];
+mergel([], Acc) ->
+ rmergel(Acc, []);
+mergel([A, [] | L], Acc) ->
+ mergel([A | L], Acc);
+mergel([A, B, [] | L], Acc) ->
+ mergel([A, B | L], Acc).
+
+rmergel([A, [H2 | T2], [H3 | T3] | L], Acc) ->
+ rmergel(L, [rmerge3_1(A, [], H2, T2, H3, T3) | Acc]);
+rmergel([A, [H | T]], Acc) ->
+ mergel([rmerge2_1(A, H, T, []) | Acc], []);
+rmergel([L], Acc) ->
+ mergel([lists:reverse(L, []) | Acc], []);
+rmergel([], Acc) ->
+ mergel(Acc, []).
+
+%% Take L1 apart.
+merge3_1([H1 | T1], M, H2, T2, H3, T3) when H1 =< H2 ->
+ merge3_12(T1, H1, H2, T2, H3, T3, M);
+merge3_1([H1 | T1], M, H2, T2, H3, T3) ->
+ merge3_21(T1, H1, H2, T2, H3, T3, M);
+merge3_1(_nil, M, H2, T2, H3, T3) when H2 =< H3 ->
+ merge2_1(T2, H3, T3, [H2 | M]);
+merge3_1(_nil, M, H2, T2, H3, T3) ->
+ merge2_1(T3, H2, T2, [H3 | M]).
+
+%% Take L2 apart.
+merge3_2(T1, H1, M, [H2 | T2], H3, T3) when H1 =< H2 ->
+ merge3_12(T1, H1, H2, T2, H3, T3, M);
+merge3_2(T1, H1, M, [H2 | T2], H3, T3) ->
+ merge3_21(T1, H1, H2, T2, H3, T3, M);
+merge3_2(T1, H1, M, _nil, H3, T3) when H1 =< H3 ->
+ merge2_1(T1, H3, T3, [H1 | M]);
+merge3_2(T1, H1, M, _nil, H3, T3) ->
+ merge2_1(T3, H1, T1, [H3 | M]).
+
+%% H1 <= H2. Inlined.
+merge3_12(T1, H1, H2, T2, H3, T3, M) when H3 < H1 ->
+ merge3_12_3(T1, H1, H2, T2, [H3 | M], T3);
+merge3_12(T1, H1, H2, T2, H3, T3, M) ->
+ merge3_1(T1, [H1 | M], H2, T2, H3, T3).
+
+%% H1 <= H2, take L3 apart.
+merge3_12_3(T1, H1, H2, T2, M, [H3 | T3]) when H3 < H1 ->
+ merge3_12_3(T1, H1, H2, T2, [H3 | M], T3);
+merge3_12_3(T1, H1, H2, T2, M, [H3 | T3]) ->
+ merge3_1(T1, [H1 | M], H2, T2, H3, T3);
+merge3_12_3(T1, H1, H2, T2, M, _nil) ->
+ merge2_1(T1, H2, T2, [H1 | M]).
+
+%% H1 > H2. Inlined.
+merge3_21(T1, H1, H2, T2, H3, T3, M) when H3 < H2 ->
+ merge3_21_3(T1, H1, H2, T2, [H3 | M], T3);
+merge3_21(T1, H1, H2, T2, H3, T3, M) ->
+ merge3_2(T1, H1, [H2 | M], T2, H3, T3).
+
+%% H1 > H2, take L3 apart.
+merge3_21_3(T1, H1, H2, T2, M, [H3 | T3]) when H3 < H2 ->
+ merge3_21_3(T1, H1, H2, T2, [H3 | M], T3);
+merge3_21_3(T1, H1, H2, T2, M, [H3 | T3]) ->
+ merge3_2(T1, H1, [H2 | M], T2, H3, T3);
+merge3_21_3(T1, H1, H2, T2, M, _nil) ->
+ merge2_1(T2, H1, T1, [H2 | M]).
+
+%% Take L1 apart.
+rmerge3_1([H1 | T1], M, H2, T2, H3, T3) when H1 > H2 ->
+ rmerge3_12(T1, H1, H2, T2, H3, T3, M);
+rmerge3_1([H1 | T1], M, H2, T2, H3, T3) ->
+ rmerge3_21(T1, H1, H2, T2, H3, T3, M);
+rmerge3_1(_nil, M, H2, T2, H3, T3) when H2 > H3 ->
+ rmerge2_1(T2, H3, T3, [H2 | M]);
+rmerge3_1(_nil, M, H2, T2, H3, T3) ->
+ rmerge2_1(T3, H2, T2, [H3 | M]).
+
+%% Take L2 apart.
+rmerge3_2(T1, H1, M, [H2 | T2], H3, T3) when H1 > H2 ->
+ rmerge3_12(T1, H1, H2, T2, H3, T3, M);
+rmerge3_2(T1, H1, M, [H2 | T2], H3, T3) ->
+ rmerge3_21(T1, H1, H2, T2, H3, T3, M);
+rmerge3_2(T1, H1, M, _nil, H3, T3) when H1 > H3 ->
+ rmerge2_1(T1, H3, T3, [H1 | M]);
+rmerge3_2(T1, H1, M, _nil, H3, T3) ->
+ rmerge2_1(T3, H1, T1, [H3 | M]).
+
+%% H1 > H2. Inlined.
+rmerge3_12(T1, H1, H2, T2, H3, T3, M) when H3 >= H1 ->
+ rmerge3_12_3(T1, H1, H2, T2, [H3 | M], T3);
+rmerge3_12(T1, H1, H2, T2, H3, T3, M) ->
+ rmerge3_1(T1, [H1 | M], H2, T2, H3, T3).
+
+%% H1 > H2, take L3 apart.
+rmerge3_12_3(T1, H1, H2, T2, M, [H3 | T3]) when H3 >= H1 ->
+ rmerge3_12_3(T1, H1, H2, T2, [H3 | M], T3);
+rmerge3_12_3(T1, H1, H2, T2, M, [H3 | T3]) ->
+ rmerge3_1(T1, [H1 | M], H2, T2, H3, T3);
+rmerge3_12_3(T1, H1, H2, T2, M, _nil) ->
+ rmerge2_1(T1, H2, T2, [H1 | M]).
+
+%% H1 =< H2. Inlined.
+rmerge3_21(T1, H1, H2, T2, H3, T3, M) when H3 >= H2 ->
+ rmerge3_21_3(T1, H1, H2, T2, [H3 | M], T3);
+rmerge3_21(T1, H1, H2, T2, H3, T3, M) ->
+ rmerge3_2(T1, H1, [H2 | M], T2, H3, T3).
+
+%% H1 =< H2, take L3 apart.
+rmerge3_21_3(T1, H1, H2, T2, M, [H3 | T3]) when H3 >= H2 ->
+ rmerge3_21_3(T1, H1, H2, T2, [H3 | M], T3);
+rmerge3_21_3(T1, H1, H2, T2, M, [H3 | T3]) ->
+ rmerge3_2(T1, H1, [H2 | M], T2, H3, T3);
+rmerge3_21_3(T1, H1, H2, T2, M, _nil) ->
+ rmerge2_1(T2, H1, T1, [H2 | M]).
+
+merge2_1([H1 | T1], H2, T2, M) when H2 < H1 ->
+ merge2_2(T1, H1, T2, [H2 | M]);
+merge2_1([H1 | T1], H2, T2, M) ->
+ merge2_1(T1, H2, T2, [H1 | M]);
+merge2_1(_nil, H2, T2, M) ->
+ lists:reverse(T2, [H2 | M]).
+
+merge2_2(T1, H1, [H2 | T2], M) when H1 < H2 ->
+ merge2_1(T1, H2, T2, [H1 | M]);
+merge2_2(T1, H1, [H2 | T2], M) ->
+ merge2_2(T1, H1, T2, [H2 | M]);
+merge2_2(T1, H1, _nil, M) ->
+ lists:reverse(T1, [H1 | M]).
+
+rmerge2_1([H1 | T1], H2, T2, M) when H2 >= H1 ->
+ rmerge2_2(T1, H1, T2, [H2 | M]);
+rmerge2_1([H1 | T1], H2, T2, M) ->
+ rmerge2_1(T1, H2, T2, [H1 | M]);
+rmerge2_1(_nil, H2, T2, M) ->
+ lists:reverse(T2, [H2 | M]).
+
+rmerge2_2(T1, H1, [H2 | T2], M) when H1 >= H2 ->
+ rmerge2_1(T1, H2, T2, [H1 | M]);
+rmerge2_2(T1, H1, [H2 | T2], M) ->
+ rmerge2_2(T1, H1, T2, [H2 | M]);
+rmerge2_2(T1, H1, _nil, M) ->
+ lists:reverse(T1, [H1 | M]).
diff --git a/lib/hipe/test/basic_SUITE_data/basic_records.erl b/lib/hipe/test/basic_SUITE_data/basic_records.erl
new file mode 100644
index 0000000000..cbb451196c
--- /dev/null
+++ b/lib/hipe/test/basic_SUITE_data/basic_records.erl
@@ -0,0 +1,28 @@
+%% -*- erlang-indent-level: 2 -*-
+%%%-------------------------------------------------------------------
+%%% Author: Kostis Sagonas
+%%%
+%%% Contains tests that manipulate and pattern match against records.
+%%%-------------------------------------------------------------------
+-module(basic_records).
+
+-export([test/0]).
+
+test() ->
+ ok = test_rec1(),
+ ok.
+
+%%--------------------------------------------------------------------
+
+-record(r, {ra}).
+-record(s, {sa, sb, sc, sd}).
+
+test_rec1() ->
+ R = #r{},
+ S = #s{},
+ S1 = S#s{sc=R, sd=1},
+ R1 = S1#s.sc,
+ undefined = R1#r.ra,
+ ok.
+
+%%--------------------------------------------------------------------
diff --git a/lib/hipe/test/sanity_SUITE_data/sanity_comp_timeout.erl b/lib/hipe/test/sanity_SUITE_data/sanity_comp_timeout.erl
new file mode 100644
index 0000000000..bee38fd87a
--- /dev/null
+++ b/lib/hipe/test/sanity_SUITE_data/sanity_comp_timeout.erl
@@ -0,0 +1,26 @@
+%%% -*- erlang-indent-level: 2 -*-
+%%%----------------------------------------------------------------------
+%%% Author: Kostis Sagonas
+%%%
+%%% Tests that when the native code compilation times out or gets killed
+%%% for some other reason, the parent process does not also get killed.
+%%%
+%%% Problem discovered by Bjorn G. on 1/12/2003 and fixed by Kostis.
+%%%----------------------------------------------------------------------
+
+-module(sanity_comp_timeout).
+
+-export([test/0]).
+
+test() ->
+ ok = write_dummy_mod(),
+ error_logger:tty(false), % disable printouts of error reports
+ Self = self(), % get the parent process
+ c:c(dummy_mod, [native, {hipe, [{timeout, 1}]}]), % This will kill the process
+ Self = self(), % make sure the parent process stays the same
+ ok.
+
+write_dummy_mod() ->
+ Prog = <<"-module(dummy_mod).\n-export([test/0]).\ntest() -> ok.\n">>,
+ ok = file:write_file("dummy_mod.erl", Prog).
+
diff --git a/lib/hipe/test/sanity_SUITE_data/sanity_no_zombies.erl b/lib/hipe/test/sanity_SUITE_data/sanity_no_zombies.erl
new file mode 100644
index 0000000000..f9f9951de2
--- /dev/null
+++ b/lib/hipe/test/sanity_SUITE_data/sanity_no_zombies.erl
@@ -0,0 +1,19 @@
+%%% -*- erlang-indent-level: 2 -*-
+%%%----------------------------------------------------------------------
+%%% Author: Per Gustafsson
+%%%
+%%% Checks that HiPE's concurrent compilation does not leave any zombie
+%%% processes around after compilation has finished.
+%%%
+%%% This was a bug reported on erlang-bugs (Oct 25, 2007).
+%%%----------------------------------------------------------------------
+
+-module(sanity_no_zombies).
+
+-export([test/0]).
+
+test() ->
+ L = length(processes()),
+ hipe:c(?MODULE, [concurrent_comp]), % force concurrent compilation
+ L = length(processes()),
+ ok.