From 57b192d8ad6c319b20da48e55485799168f4d346 Mon Sep 17 00:00:00 2001 From: Kostis Sagonas Date: Fri, 27 Nov 2015 17:08:02 +0100 Subject: Add some more binary syntax construction tests Some more cases (taken from the BEAM bs_construct suite) that used to show different behaviour than BEAM when compiled to native code were included in the appropriate test file of the HiPE test suite. --- lib/hipe/test/bs_SUITE_data/bs_construct.erl | 115 +++++++++++++++++++++++++++ 1 file changed, 115 insertions(+) (limited to 'lib/hipe/test') diff --git a/lib/hipe/test/bs_SUITE_data/bs_construct.erl b/lib/hipe/test/bs_SUITE_data/bs_construct.erl index 37a54c1981..7d59482662 100644 --- a/lib/hipe/test/bs_SUITE_data/bs_construct.erl +++ b/lib/hipe/test/bs_SUITE_data/bs_construct.erl @@ -14,6 +14,9 @@ test() -> 16#10000008 = bit_size(large_bin(1, 2, 3, 4)), ok = bad_ones(), ok = zero_width(), + ok = not_used(), + ok = bad_append(), + ok = system_limit(), ok. %%-------------------------------------------------------------------- @@ -142,3 +145,115 @@ zero_width() -> ok. id(X) -> X. + +%%-------------------------------------------------------------------- +%% Taken from bs_construct_SUITE. The test checks that constructed +%% binaries that are not used would still give a `badarg' exception. +%% Problem was that in native code one of them gave `badarith'. + +not_used() -> + ok = not_used1(3, <<"dum">>), + {'EXIT',{badarg,_}} = (catch not_used1(42, "dum_string")), + {'EXIT',{badarg,_}} = (catch not_used2(666, -2)), + {'EXIT',{badarg,_}} = (catch not_used2(666, "bad_size")), % this one + {'EXIT',{badarg,_}} = (catch not_used3(666)), + ok. + +not_used1(I, BinString) -> + <>, + ok. + +not_used2(I, Sz) -> + <>, + ok. + +not_used3(I) -> + <>, + ok. + +%%-------------------------------------------------------------------- +%% Taken from bs_construct_SUITE. + +bad_append() -> + do_bad_append(<<127:1>>, fun append_unit_3/1), + do_bad_append(<<127:2>>, fun append_unit_3/1), + do_bad_append(<<127:17>>, fun append_unit_3/1), + + do_bad_append(<<127:3>>, fun append_unit_4/1), + do_bad_append(<<127:5>>, fun append_unit_4/1), + do_bad_append(<<127:7>>, fun append_unit_4/1), + do_bad_append(<<127:199>>, fun append_unit_4/1), + + do_bad_append(<<127:7>>, fun append_unit_8/1), + do_bad_append(<<127:9>>, fun append_unit_8/1), + + do_bad_append(<<0:8>>, fun append_unit_16/1), + do_bad_append(<<0:15>>, fun append_unit_16/1), + do_bad_append(<<0:17>>, fun append_unit_16/1), + ok. + +do_bad_append(Bin0, Appender) -> + {'EXIT',{badarg,_}} = (catch Appender(Bin0)), + + Bin1 = id(<<0:3,Bin0/bitstring>>), + <<_:3,Bin2/bitstring>> = Bin1, + {'EXIT',{badarg,_}} = (catch Appender(Bin2)), + + %% Create a writable binary. + Empty = id(<<>>), + Bin3 = <>, + {'EXIT',{badarg,_}} = (catch Appender(Bin3)), + ok. + +append_unit_3(Bin) -> + <>. + +append_unit_4(Bin) -> + <>. + +append_unit_8(Bin) -> + <>. + +append_unit_16(Bin) -> + <>. + +%%-------------------------------------------------------------------- +%% Taken from bs_construct_SUITE. + +system_limit() -> + WordSize = erlang:system_info(wordsize), + BitsPerWord = WordSize * 8, + {'EXIT',{system_limit,_}} = + (catch <<0:(id(0)),42:(id(1 bsl BitsPerWord))>>), + {'EXIT',{system_limit,_}} = + (catch <<42:(id(1 bsl BitsPerWord)),0:(id(0))>>), + {'EXIT',{system_limit,_}} = + (catch <<(id(<<>>))/binary,0:(id(1 bsl 100))>>), + + %% Would fail to load. + {'EXIT',{system_limit,_}} = (catch <<0:(1 bsl 67)>>), + {'EXIT',{system_limit,_}} = (catch <<0:((1 bsl 64)+1)>>), + case WordSize of + 4 -> + system_limit_32(); + 8 -> + ok + end. + +system_limit_32() -> + {'EXIT',{badarg,_}} = (catch <<42:(-1)>>), + {'EXIT',{badarg,_}} = (catch <<42:(id(-1))>>), + {'EXIT',{badarg,_}} = (catch <<42:(id(-389739873536870912))/unit:8>>), + {'EXIT',{system_limit,_}} = (catch <<42:536870912/unit:8>>), + {'EXIT',{system_limit,_}} = (catch <<42:(id(536870912))/unit:8>>), + {'EXIT',{system_limit,_}} = (catch <<0:(id(8)),42:536870912/unit:8>>), + {'EXIT',{system_limit,_}} = (catch <<0:(id(8)),42:(id(536870912))/unit:8>>), + + %% The size would be silently truncated, resulting in a crash. + {'EXIT',{system_limit,_}} = (catch <<0:(1 bsl 35)>>), + {'EXIT',{system_limit,_}} = (catch <<0:((1 bsl 32)+1)>>), + + %% Would fail to load. + {'EXIT',{system_limit,_}} = (catch <<0:(1 bsl 43)>>), + {'EXIT',{system_limit,_}} = (catch <<0:((1 bsl 40)+1)>>), + ok. -- cgit v1.2.3 From 720139f2d285a5746ba712efa236ad4938436e0f Mon Sep 17 00:00:00 2001 From: Kostis Sagonas Date: Fri, 27 Nov 2015 17:17:21 +0100 Subject: Add a case testing the handling of guards involving binaries The HiPE compiler was leaking exceptions out of guards involving binaries with `strange' arithmetic in them. Fixed by the set of changes in this pull request. --- lib/hipe/test/bs_SUITE_data/bs_add.erl | 10 +++++++++- 1 file changed, 9 insertions(+), 1 deletion(-) (limited to 'lib/hipe/test') diff --git a/lib/hipe/test/bs_SUITE_data/bs_add.erl b/lib/hipe/test/bs_SUITE_data/bs_add.erl index af5a3b2f23..4b92e6b413 100644 --- a/lib/hipe/test/bs_SUITE_data/bs_add.erl +++ b/lib/hipe/test/bs_SUITE_data/bs_add.erl @@ -2,7 +2,7 @@ %%------------------------------------------------------------------------- %% The guard in f/3 revealed a problem in the translation of the 'bs_add' %% BEAM instruction to Icode. The fail label was not properly translated. -%% Fixed 3/2/2011. +%% Fixed 3/2/2011. Then in 2015 we found another issue: g/2. Also fixed. %%------------------------------------------------------------------------- -module(bs_add). @@ -10,9 +10,17 @@ test() -> 42 = f(<<12345:16>>, 4711, <<42>>), + true = g(<<1:13>>, 3), %% was handled OK, but + false = g(<<>>, gurka), %% this one leaked badarith ok. f(Bin, A, B) when <> == Bin -> gazonk; f(Bin, _, _) when is_binary(Bin) -> 42. + +%% Complex way of testing (bit_size(Bin) + Len) rem 8 =:= 0 +g(Bin, Len) when is_binary(<>) -> + true; +g(_, _) -> + false. -- cgit v1.2.3 From 21918b53a12107fdb1374387acd8b439515bd40d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Magnus=20L=C3=A5ng?= Date: Mon, 30 Nov 2015 14:46:42 +0100 Subject: hipe: Add tests for bad bit syntax float sizes --- lib/hipe/test/bs_SUITE_data/bs_construct.erl | 12 ++++++++++++ 1 file changed, 12 insertions(+) (limited to 'lib/hipe/test') diff --git a/lib/hipe/test/bs_SUITE_data/bs_construct.erl b/lib/hipe/test/bs_SUITE_data/bs_construct.erl index 7d59482662..7251cdce43 100644 --- a/lib/hipe/test/bs_SUITE_data/bs_construct.erl +++ b/lib/hipe/test/bs_SUITE_data/bs_construct.erl @@ -17,6 +17,7 @@ test() -> ok = not_used(), ok = bad_append(), ok = system_limit(), + ok = bad_floats(), ok. %%-------------------------------------------------------------------- @@ -257,3 +258,14 @@ system_limit_32() -> {'EXIT',{system_limit,_}} = (catch <<0:(1 bsl 43)>>), {'EXIT',{system_limit,_}} = (catch <<0:((1 bsl 40)+1)>>), ok. + +%%-------------------------------------------------------------------- + +bad_floats() -> + WordSize = erlang:system_info(wordsize), + BitsPerWord = WordSize * 8, + {'EXIT',{badarg,_}} = (catch <<3.14:(id(33))/float>>), + {'EXIT',{badarg,_}} = (catch <<3.14:(id(64 bor 32))/float>>), + {'EXIT',{badarg,_}} = (catch <<3.14:(id((1 bsl 28) bor 32))/float>>), + {'EXIT',{system_limit,_}} = (catch <<3.14:(id(1 bsl BitsPerWord))/float>>), + ok. -- cgit v1.2.3 From 34380bad4985bc827866129597e0bea940e076f4 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Magnus=20L=C3=A5ng?= Date: Tue, 1 Dec 2015 15:24:25 +0000 Subject: hipe: Fix signed compares of unsigned sizes Also, some of the branches were testing sizes in bits against a constant ?MAX_BINSIZE, which was in bytes. The signed comparisons masked this mistake. These branches have been removed since all sizes in bits that fit in a machine word are valid binary sizes. Finally, a test that reproduces the issue was added to bs_construct, along with a test for one of the cases (bs_init<0>(...)) when the test against ?MAX_BINSIZE must be changed to unsigned rather than removed. --- lib/hipe/test/bs_SUITE_data/bs_construct.erl | 34 ++++++++++++++++++++++++++++ 1 file changed, 34 insertions(+) (limited to 'lib/hipe/test') diff --git a/lib/hipe/test/bs_SUITE_data/bs_construct.erl b/lib/hipe/test/bs_SUITE_data/bs_construct.erl index 7251cdce43..b9e7d93570 100644 --- a/lib/hipe/test/bs_SUITE_data/bs_construct.erl +++ b/lib/hipe/test/bs_SUITE_data/bs_construct.erl @@ -18,6 +18,7 @@ test() -> ok = bad_append(), ok = system_limit(), ok = bad_floats(), + ok = huge_binaries(), ok. %%-------------------------------------------------------------------- @@ -269,3 +270,36 @@ bad_floats() -> {'EXIT',{badarg,_}} = (catch <<3.14:(id((1 bsl 28) bor 32))/float>>), {'EXIT',{system_limit,_}} = (catch <<3.14:(id(1 bsl BitsPerWord))/float>>), ok. + +%%-------------------------------------------------------------------- +%% A bug in the implementation of binaries compared sizes in bits with sizes in +%% bytes, causing <<0:(id((1 bsl 31)-1))>> to fail to construct with +%% 'system_limit'. +%% <<0:(id((1 bsl 32)-1))>> was succeeding because the comparison was +%% (incorrectly) signed. + +huge_binaries() -> + AlmostIllegal = id(<<0:(id((1 bsl 32)-8))>>), + case erlang:system_info(wordsize) of + 4 -> huge_binaries_32(AlmostIllegal); + 8 -> ok + end, + garbage_collect(), + id(<<0:(id((1 bsl 31)-1))>>), + id(<<0:(id((1 bsl 30)-1))>>), + garbage_collect(), + ok. + +huge_binaries_32(AlmostIllegal) -> + %% Attempt construction of too large binary using bs_init/1 (which takes the + %% number of bytes as an argument, which should be compared to the maximum + %% size in bytes). + {'EXIT',{system_limit,_}} = (catch <<0:32,AlmostIllegal/binary>>), + %% Attempt construction of too large binary using bs_init/1 with a size in + %% bytes that has the msb set (and would be negative if it was signed). + {'EXIT',{system_limit,_}} = + (catch <<0:8, AlmostIllegal/binary, AlmostIllegal/binary, + AlmostIllegal/binary, AlmostIllegal/binary, + AlmostIllegal/binary, AlmostIllegal/binary, + AlmostIllegal/binary, AlmostIllegal/binary>>), + ok. -- cgit v1.2.3 From 9fd2f21c38944c8a605020d6662bb5935c5bbee2 Mon Sep 17 00:00:00 2001 From: Kostis Sagonas Date: Mon, 3 Mar 2014 01:40:39 +0100 Subject: First part of the basic test suite for the HiPE compiler --- lib/hipe/test/basic_SUITE_data/basic_arith.erl | 72 +++++ .../test/basic_SUITE_data/basic_beam_instrs.erl | 90 ++++++ lib/hipe/test/basic_SUITE_data/basic_bifs.erl | 41 +++ lib/hipe/test/basic_SUITE_data/basic_bignums.erl | 124 ++++++++ lib/hipe/test/basic_SUITE_data/basic_boolean.erl | 47 +++ lib/hipe/test/basic_SUITE_data/basic_bugs_beam.erl | 101 +++++++ lib/hipe/test/basic_SUITE_data/basic_bugs_hipe.erl | 189 ++++++++++++ .../test/basic_SUITE_data/basic_comparisons.erl | 157 ++++++++++ .../test/basic_SUITE_data/basic_exceptions.erl | 206 +++++++++++++ lib/hipe/test/basic_SUITE_data/basic_floats.erl | 156 ++++++++++ lib/hipe/test/basic_SUITE_data/basic_fun.erl | 124 ++++++++ lib/hipe/test/basic_SUITE_data/basic_guards.erl | 58 ++++ .../test/basic_SUITE_data/basic_issues_beam.erl | 325 +++++++++++++++++++++ .../test/basic_SUITE_data/basic_issues_hipe.erl | 119 ++++++++ lib/hipe/test/basic_SUITE_data/basic_lists.erl | 41 +++ .../test/basic_SUITE_data/basic_module_info.erl | 32 ++ .../test/basic_SUITE_data/basic_pattern_match.erl | 36 +++ lib/hipe/test/basic_SUITE_data/basic_receive.erl | 56 ++++ lib/hipe/test/basic_SUITE_data/basic_tuples.erl | 177 +++++++++++ 19 files changed, 2151 insertions(+) create mode 100644 lib/hipe/test/basic_SUITE_data/basic_arith.erl create mode 100644 lib/hipe/test/basic_SUITE_data/basic_beam_instrs.erl create mode 100644 lib/hipe/test/basic_SUITE_data/basic_bifs.erl create mode 100644 lib/hipe/test/basic_SUITE_data/basic_bignums.erl create mode 100644 lib/hipe/test/basic_SUITE_data/basic_boolean.erl create mode 100644 lib/hipe/test/basic_SUITE_data/basic_bugs_beam.erl create mode 100644 lib/hipe/test/basic_SUITE_data/basic_bugs_hipe.erl create mode 100644 lib/hipe/test/basic_SUITE_data/basic_comparisons.erl create mode 100644 lib/hipe/test/basic_SUITE_data/basic_exceptions.erl create mode 100644 lib/hipe/test/basic_SUITE_data/basic_floats.erl create mode 100644 lib/hipe/test/basic_SUITE_data/basic_fun.erl create mode 100644 lib/hipe/test/basic_SUITE_data/basic_guards.erl create mode 100644 lib/hipe/test/basic_SUITE_data/basic_issues_beam.erl create mode 100644 lib/hipe/test/basic_SUITE_data/basic_issues_hipe.erl create mode 100644 lib/hipe/test/basic_SUITE_data/basic_lists.erl create mode 100644 lib/hipe/test/basic_SUITE_data/basic_module_info.erl create mode 100644 lib/hipe/test/basic_SUITE_data/basic_pattern_match.erl create mode 100644 lib/hipe/test/basic_SUITE_data/basic_receive.erl create mode 100644 lib/hipe/test/basic_SUITE_data/basic_tuples.erl (limited to 'lib/hipe/test') 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 +%% . +%% 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 -> <>; + _ -> 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. -- cgit v1.2.3 From 6a645e07a02f9adda9b9534214e699ad8f30a15f Mon Sep 17 00:00:00 2001 From: Kostis Sagonas Date: Tue, 4 Mar 2014 14:05:49 +0100 Subject: More basic tests and some tests that the HiPE compiler is not causing trouble --- lib/hipe/test/basic_SUITE_data/basic_arith.erl | 2 +- .../test/basic_SUITE_data/basic_beam_instrs.erl | 12 ++ lib/hipe/test/basic_SUITE_data/basic_bignums.erl | 19 ++ lib/hipe/test/basic_SUITE_data/basic_bugs_beam.erl | 37 ++++ lib/hipe/test/basic_SUITE_data/basic_bugs_hipe.erl | 111 +++++++++- .../test/basic_SUITE_data/basic_exceptions.erl | 122 ++++++++++- lib/hipe/test/basic_SUITE_data/basic_guards.erl | 17 ++ .../test/basic_SUITE_data/basic_issues_hipe.erl | 38 +++- lib/hipe/test/basic_SUITE_data/basic_lists.erl | 22 +- lib/hipe/test/basic_SUITE_data/basic_random.erl | 238 +++++++++++++++++++++ lib/hipe/test/basic_SUITE_data/basic_records.erl | 28 +++ .../test/sanity_SUITE_data/sanity_comp_timeout.erl | 26 +++ .../test/sanity_SUITE_data/sanity_no_zombies.erl | 19 ++ 13 files changed, 677 insertions(+), 14 deletions(-) create mode 100644 lib/hipe/test/basic_SUITE_data/basic_random.erl create mode 100644 lib/hipe/test/basic_SUITE_data/basic_records.erl create mode 100644 lib/hipe/test/sanity_SUITE_data/sanity_comp_timeout.erl create mode 100644 lib/hipe/test/sanity_SUITE_data/sanity_no_zombies.erl (limited to 'lib/hipe/test') 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. @@ -63,6 +66,40 @@ bad_arith2(X, Y) when is_float(X) -> Y1 = element(1, Y), {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: %% 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 @@ -153,13 +155,104 @@ shift_length_list_plus2() -> 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,11 +15,63 @@ 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) -> @@ -48,6 +100,52 @@ test_catch_element() -> 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. @@ -67,6 +165,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,11 +26,43 @@ 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. -- cgit v1.2.3 From f3b62ad3fb0b989d58e9018cbe3b62d4d7300341 Mon Sep 17 00:00:00 2001 From: Kostis Sagonas Date: Sun, 23 Mar 2014 13:21:26 +0100 Subject: Add function to prevent running tests in the LLVM backend --- lib/hipe/test/sanity_SUITE_data/sanity_comp_timeout.erl | 4 +++- lib/hipe/test/sanity_SUITE_data/sanity_no_zombies.erl | 4 +++- 2 files changed, 6 insertions(+), 2 deletions(-) (limited to 'lib/hipe/test') diff --git a/lib/hipe/test/sanity_SUITE_data/sanity_comp_timeout.erl b/lib/hipe/test/sanity_SUITE_data/sanity_comp_timeout.erl index bee38fd87a..9f0830574f 100644 --- a/lib/hipe/test/sanity_SUITE_data/sanity_comp_timeout.erl +++ b/lib/hipe/test/sanity_SUITE_data/sanity_comp_timeout.erl @@ -10,7 +10,7 @@ -module(sanity_comp_timeout). --export([test/0]). +-export([test/0, to_llvm/0]). test() -> ok = write_dummy_mod(), @@ -20,6 +20,8 @@ test() -> Self = self(), % make sure the parent process stays the same ok. +to_llvm() -> false. + 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 index f9f9951de2..87e746042e 100644 --- a/lib/hipe/test/sanity_SUITE_data/sanity_no_zombies.erl +++ b/lib/hipe/test/sanity_SUITE_data/sanity_no_zombies.erl @@ -10,10 +10,12 @@ -module(sanity_no_zombies). --export([test/0]). +-export([test/0, to_llvm/0]). test() -> L = length(processes()), hipe:c(?MODULE, [concurrent_comp]), % force concurrent compilation L = length(processes()), ok. + +to_llvm() -> false. -- cgit v1.2.3 From 348059f6ff735362977115d5910c1edbd3f1bc25 Mon Sep 17 00:00:00 2001 From: Kostis Sagonas Date: Wed, 2 Apr 2014 23:50:40 +0200 Subject: Use function from hipe module instead of a local one --- lib/hipe/test/hipe_testsuite_driver.erl | 16 ++-------------- 1 file changed, 2 insertions(+), 14 deletions(-) (limited to 'lib/hipe/test') diff --git a/lib/hipe/test/hipe_testsuite_driver.erl b/lib/hipe/test/hipe_testsuite_driver.erl index 5f05a716bc..9f5d7421b4 100644 --- a/lib/hipe/test/hipe_testsuite_driver.erl +++ b/lib/hipe/test/hipe_testsuite_driver.erl @@ -176,7 +176,8 @@ run(TestCase, Dir, _OutDir) -> HiPEOpts = try TestCase:hipe_options() catch error:undef -> [] end, {ok, TestCase} = hipe:c(TestCase, HiPEOpts), ok = TestCase:test(), - case is_llvm_opt_available() of + ToLLVM = try TestCase:to_llvm() catch error:undef -> true end, + case ToLLVM andalso hipe:llvm_support_available() of true -> {ok, TestCase} = hipe:c(TestCase, [to_llvm|HiPEOpts]), ok = TestCase:test(); @@ -186,16 +187,3 @@ run(TestCase, Dir, _OutDir) -> %% lists:foreach(fun (DF) -> ok end, % = file:delete(DF) end, %% [filename:join(OutDir, D) || D <- DataFiles]) %% end. - - -%% This function, which is supposed to check whether the right LLVM -%% infrastructure is available, should be probably written in a better -%% and more portable way and moved to the hipe application. - -is_llvm_opt_available() -> - OptStr = os:cmd("opt -version"), - SubStr = "LLVM version ", N = length(SubStr), - case string:str(OptStr, SubStr) of - 0 -> false; - S -> P = S + N, string:sub_string(OptStr, P, P + 2) >= "3.4" - end. -- cgit v1.2.3 From 7cfbe22bca2569f763b0ca0bbd04eeaaa5a0e298 Mon Sep 17 00:00:00 2001 From: Kostis Sagonas Date: Wed, 2 Apr 2014 23:52:06 +0200 Subject: Add more generated test suites in Makefile --- lib/hipe/test/Makefile | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) (limited to 'lib/hipe/test') diff --git a/lib/hipe/test/Makefile b/lib/hipe/test/Makefile index 009f503abb..d781e4f9be 100644 --- a/lib/hipe/test/Makefile +++ b/lib/hipe/test/Makefile @@ -10,8 +10,10 @@ MODULES= \ # .erl files for these modules are automatically generated GEN_MODULES= \ + basic_SUITE \ bs_SUITE \ - maps_SUITE + maps_SUITE \ + sanity_SUITE ERL_FILES= $(MODULES:%=%.erl) -- cgit v1.2.3 From 77084e1b477a4cf99b944d0e06afd707c51e6576 Mon Sep 17 00:00:00 2001 From: Kostis Sagonas Date: Wed, 2 Apr 2014 23:52:57 +0200 Subject: Minor code cleanup --- lib/hipe/test/bs_SUITE_data/bs_split.erl | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) (limited to 'lib/hipe/test') diff --git a/lib/hipe/test/bs_SUITE_data/bs_split.erl b/lib/hipe/test/bs_SUITE_data/bs_split.erl index 2e52308a77..617543f789 100644 --- a/lib/hipe/test/bs_SUITE_data/bs_split.erl +++ b/lib/hipe/test/bs_SUITE_data/bs_split.erl @@ -26,13 +26,13 @@ bs1(L, B, Pos, Sz1, Sz2) -> <> = B, bs2(L, B, Pos, B1, B2). -bs2(L, B, Pos, B1, B2)-> +bs2(L, B, Pos, B1, B2) -> B1 = list_to_binary(lists:sublist(L, 1, Pos)), bs3(L, B, Pos, B2). bs3(L, B, Pos, B2) -> B2 = list_to_binary(lists:nthtail(Pos, L)), - byte_split(L, B, Pos-1). + byte_split(L, B, Pos - 1). %%-------------------------------------------------------------------- @@ -56,14 +56,14 @@ bit_split_binary2(_Action, _Bin, [], _Bef) -> ok. bit_split_binary3(Action, Bin, List, Bef, Aft) when Bef =< Aft -> Action(Bin, List, Bef, (Aft-Bef) div 8 * 8), - bit_split_binary3(Action, Bin, List, Bef, Aft-8); + bit_split_binary3(Action, Bin, List, Bef, Aft - 8); bit_split_binary3(_, _, _, _, _) -> ok. make_bin_from_list(_List, 0) -> mkbin([]); make_bin_from_list(List, N) -> list_to_binary([make_int(List, 8, 0), - make_bin_from_list(lists:nthtail(8, List), N-8)]). + make_bin_from_list(lists:nthtail(8, List), N - 8)]). make_int(_List, 0, Acc) -> Acc; make_int([H|T], N, Acc) -> make_int(T, N-1, Acc bsl 1 bor H). @@ -101,5 +101,5 @@ z_split(B, N) -> <<_:N/binary>> -> [B]; _ -> - z_split(B, N+1) + z_split(B, N + 1) end. -- cgit v1.2.3 From 1c6075b7c69709ce129e817b4652ccb5ff9d2e95 Mon Sep 17 00:00:00 2001 From: Kostis Sagonas Date: Thu, 3 Apr 2014 01:24:51 +0200 Subject: More tests for handling of UTF in bitstrings --- lib/hipe/test/bs_SUITE_data/bs_utf.erl | 343 ++++++++++++++++++++++++++++++++- 1 file changed, 340 insertions(+), 3 deletions(-) (limited to 'lib/hipe/test') diff --git a/lib/hipe/test/bs_SUITE_data/bs_utf.erl b/lib/hipe/test/bs_SUITE_data/bs_utf.erl index f50ae08964..3a1988be0a 100644 --- a/lib/hipe/test/bs_SUITE_data/bs_utf.erl +++ b/lib/hipe/test/bs_SUITE_data/bs_utf.erl @@ -1,18 +1,355 @@ %% -*- erlang-indent-level: 2 -*- %%------------------------------------------------------------------- -%% Purpose: test support for UTF datatypes in binaries - INCOMPLETE +%% Purpose: test support for UTF datatypes in binaries +%% +%% Most of it taken from emulator/test/bs_utf_SUITE.erl %%------------------------------------------------------------------- -module(bs_utf). -export([test/0]). +-include_lib("test_server/include/test_server.hrl"). + test() -> + ok = utf8_cm65(), + ok = utf8_roundtrip(), + ok = utf16_roundtrip(), + ok = utf32_roundtrip(), + ok = utf8_illegal_sequences(), + ok = utf16_illegal_sequences(), + ok = utf32_illegal_sequences(), + ok. + +%%------------------------------------------------------------------- +%% A test with construction and matching + +utf8_cm65() -> <<65>> = b65utf8(), ok = m(<<65>>). +b65utf8() -> + <<65/utf8>>. + m(<<65/utf8>>) -> ok. -b65utf8() -> - <<65/utf8>>. +%%------------------------------------------------------------------- + +utf8_roundtrip() -> + ok = utf8_roundtrip(0, 16#D7FF), + ok = utf8_roundtrip(16#E000, 16#10FFFF), + ok. + +utf8_roundtrip(First, Last) when First =< Last -> + Bin = int_to_utf8(First), + Bin = id(<>), + Bin = id(<<(id(<<>>))/binary,First/utf8>>), + Unaligned = id(<<3:2,First/utf8>>), + <<_:2,Bin/binary>> = Unaligned, + <> = Bin, + <> = make_unaligned(Bin), + utf8_roundtrip(First+1, Last); +utf8_roundtrip(_, _) -> + ok. + +%%------------------------------------------------------------------- + +utf16_roundtrip() -> + Big = fun utf16_big_roundtrip/1, + Little = fun utf16_little_roundtrip/1, + PidRefs = [spawn_monitor(fun() -> do_utf16_roundtrip(Fun) end) || + Fun <- [Big,Little]], + [receive {'DOWN', Ref, process, Pid, Reason} -> normal=Reason end || + {Pid, Ref} <- PidRefs], + ok. + +do_utf16_roundtrip(Fun) -> + do_utf16_roundtrip(0, 16#D7FF, Fun), + do_utf16_roundtrip(16#E000, 16#10FFFF, Fun). + +do_utf16_roundtrip(First, Last, Fun) when First =< Last -> + Fun(First), + do_utf16_roundtrip(First+1, Last, Fun); +do_utf16_roundtrip(_, _, _) -> ok. + +utf16_big_roundtrip(Char) -> + Bin = id(<>), + Bin = id(<<(id(<<>>))/binary,Char/utf16>>), + Unaligned = id(<<3:2,Char/utf16>>), + <<_:2,Bin/binary>> = Unaligned, + <> = Bin, + <> = make_unaligned(Bin), + ok. + +utf16_little_roundtrip(Char) -> + Bin = id(<>), + Bin = id(<<(id(<<>>))/binary,Char/little-utf16>>), + Unaligned = id(<<3:2,Char/little-utf16>>), + <<_:2,Bin/binary>> = Unaligned, + <> = Bin, + <> = make_unaligned(Bin), + ok. + +%%------------------------------------------------------------------- + +utf32_roundtrip() -> + Big = fun utf32_big_roundtrip/1, + Little = fun utf32_little_roundtrip/1, + PidRefs = [spawn_monitor(fun() -> do_utf32_roundtrip(Fun) end) || + Fun <- [Big,Little]], + [receive {'DOWN', Ref, process, Pid, Reason} -> normal=Reason end || + {Pid, Ref} <- PidRefs], + ok. + +do_utf32_roundtrip(Fun) -> + do_utf32_roundtrip(0, 16#D7FF, Fun), + do_utf32_roundtrip(16#E000, 16#10FFFF, Fun). + +do_utf32_roundtrip(First, Last, Fun) when First =< Last -> + Fun(First), + do_utf32_roundtrip(First+1, Last, Fun); +do_utf32_roundtrip(_, _, _) -> ok. + +utf32_big_roundtrip(Char) -> + Bin = id(<>), + Bin = id(<<(id(<<>>))/binary,Char/utf32>>), + Unaligned = id(<<3:2,Char/utf32>>), + <<_:2,Bin/binary>> = Unaligned, + <> = Bin, + <> = make_unaligned(Bin), + ok. + +utf32_little_roundtrip(Char) -> + Bin = id(<>), + Bin = id(<<(id(<<>>))/binary,Char/little-utf32>>), + Unaligned = id(<<3:2,Char/little-utf32>>), + <<_:2,Bin/binary>> = Unaligned, + <> = Bin, + <> = make_unaligned(Bin), + ok. + +%%------------------------------------------------------------------- + +utf8_illegal_sequences() -> + fail_range(16#10FFFF+1, 16#10FFFF+512), % Too large. + fail_range(16#D800, 16#DFFF), % Reserved for UTF-16. + + %% Illegal first character. + [fail(<>) || I <- lists:seq(16#80, 16#BF)], + + %% Short sequences. + short_sequences(16#80, 16#10FFFF), + + %% Overlong sequences. (Using more bytes than necessary + %% is not allowed.) + overlong(0, 127, 2), + overlong(128, 16#7FF, 3), + overlong(16#800, 16#FFFF, 4), + ok. + +fail_range(Char, End) when Char =< End -> + {'EXIT', _} = (catch <>), + Bin = int_to_utf8(Char), + fail(Bin), + fail_range(Char+1, End); +fail_range(_, _) -> ok. + +short_sequences(Char, End) -> + Step = (End - Char) div erlang:system_info(schedulers) + 1, + PidRefs = short_sequences_1(Char, Step, End), + [receive {'DOWN', Ref, process, Pid, Reason} -> normal=Reason end || + {Pid, Ref} <- PidRefs], + ok. + +short_sequences_1(Char, Step, End) when Char =< End -> + CharEnd = lists:min([Char+Step-1,End]), + [spawn_monitor(fun() -> + %% io:format("~p - ~p\n", [Char, CharEnd]), + do_short_sequences(Char, CharEnd) + end)|short_sequences_1(Char+Step, Step, End)]; +short_sequences_1(_, _, _) -> []. + +do_short_sequences(Char, End) when Char =< End -> + short_sequence(Char), + do_short_sequences(Char+1, End); +do_short_sequences(_, _) -> ok. + +short_sequence(I) -> + case int_to_utf8(I) of + <> -> + <> = S0, + <> = S1, + fail(S0), + fail(S1), + fail(S2), + fail(<>), + fail(<>), + fail(<>); + <> -> + <> = S0, + fail(S0), + fail(S1), + fail(<>), + fail(<>), + fail(<>); + <> -> + fail(S), + fail(<>) + end. + +overlong(Char, Last, NumBytes) when Char =< Last -> + overlong(Char, NumBytes), + overlong(Char+1, Last, NumBytes); +overlong(_, _, _) -> ok. + +overlong(Char, NumBytes) when NumBytes < 5 -> + case int_to_utf8(Char, NumBytes) of + <>=Bin -> + ?t:fail({illegal_encoding_accepted,Bin,Char}); + <>=Bin -> + ?t:fail({illegal_encoding_accepted,Bin,Char,OtherChar}); + _ -> ok + end, + overlong(Char, NumBytes+1); +overlong(_, _) -> ok. + +fail(Bin) -> + fail_1(Bin), + fail_1(make_unaligned(Bin)). + +fail_1(<> = Bin) -> + ?t:fail({illegal_encoding_accepted, Bin, Char}); +fail_1(_) -> ok. + +%%------------------------------------------------------------------- + +utf16_illegal_sequences() -> + utf16_fail_range(16#10FFFF+1, 16#10FFFF+512), % Too large. + utf16_fail_range(16#D800, 16#DFFF), % Reserved for UTF-16. + lonely_hi_surrogate(16#D800, 16#DFFF), + leading_lo_surrogate(16#DC00, 16#DFFF), + ok. + +utf16_fail_range(Char, End) when Char =< End -> + {'EXIT', _} = (catch <>), + {'EXIT', _} = (catch <>), + utf16_fail_range(Char+1, End); +utf16_fail_range(_, _) -> ok. + +lonely_hi_surrogate(Char, End) when Char =< End -> + BinBig = <>, + BinLittle = <>, + case {BinBig,BinLittle} of + {<>,_} -> + ?t:fail({lonely_hi_surrogate_accepted,Bad}); + {_,<>} -> + ?t:fail({lonely_hi_surrogate_accepted,Bad}); + {_,_} -> + ok + end, + lonely_hi_surrogate(Char+1, End); +lonely_hi_surrogate(_, _) -> ok. + +leading_lo_surrogate(Char, End) when Char =< End -> + leading_lo_surrogate(Char, 16#D800, 16#DFFF), + leading_lo_surrogate(Char+1, End); +leading_lo_surrogate(_, _) -> ok. + +leading_lo_surrogate(HiSurr, LoSurr, End) when LoSurr =< End -> + BinBig = <>, + BinLittle = <>, + case {BinBig,BinLittle} of + {<>,_} -> + ?t:fail({leading_lo_surrogate_accepted,Bad}); + {_,<>} -> + ?t:fail({leading_lo_surrogate_accepted,Bad}); + {_,_} -> + ok + end, + leading_lo_surrogate(HiSurr, LoSurr+1, End); +leading_lo_surrogate(_, _, _) -> ok. + +%%------------------------------------------------------------------- + +utf32_illegal_sequences() -> + utf32_fail_range(16#10FFFF+1, 16#10FFFF+512), % Too large. + utf32_fail_range(16#D800, 16#DFFF), % Reserved for UTF-16. + utf32_fail_range(-100, -1), + ok. + +utf32_fail_range(Char, End) when Char =< End -> + {'EXIT', _} = (catch <>), + {'EXIT', _} = (catch <>), + case {<>,<>} of + {<>,_} -> + ?t:fail(Unexpected); + {_,<>} -> + ?t:fail(Unexpected); + {_,_} -> ok + end, + utf32_fail_range(Char+1, End); +utf32_fail_range(_, _) -> ok. + +%%------------------------------------------------------------------- +%% This function intentionally allows construction of UTF-8 sequence +%% in illegal ranges. + +int_to_utf8(I) when I =< 16#7F -> + <>; +int_to_utf8(I) when I =< 16#7FF -> + B2 = I, + B1 = (I bsr 6), + <<1:1,1:1,0:1,B1:5,1:1,0:1,B2:6>>; +int_to_utf8(I) when I =< 16#FFFF -> + B3 = I, + B2 = (I bsr 6), + B1 = (I bsr 12), + <<1:1,1:1,1:1,0:1,B1:4,1:1,0:1,B2:6,1:1,0:1,B3:6>>; +int_to_utf8(I) when I =< 16#3FFFFF -> + B4 = I, + B3 = (I bsr 6), + B2 = (I bsr 12), + B1 = (I bsr 18), + <<1:1,1:1,1:1,1:1,0:1,B1:3,1:1,0:1,B2:6,1:1,0:1,B3:6,1:1,0:1,B4:6>>; +int_to_utf8(I) when I =< 16#3FFFFFF -> + B5 = I, + B4 = (I bsr 6), + B3 = (I bsr 12), + B2 = (I bsr 18), + B1 = (I bsr 24), + <<1:1,1:1,1:1,1:1,1:1,0:1,B1:2,1:1,0:1,B2:6,1:1,0:1,B3:6,1:1,0:1,B4:6, + 1:1,0:1,B5:6>>. + +%% int_to_utf8(I, NumberOfBytes) -> Binary. +%% This function can be used to construct overlong sequences. +int_to_utf8(I, 1) -> + <>; +int_to_utf8(I, 2) -> + B2 = I, + B1 = (I bsr 6), + <<1:1,1:1,0:1,B1:5,1:1,0:1,B2:6>>; +int_to_utf8(I, 3) -> + B3 = I, + B2 = (I bsr 6), + B1 = (I bsr 12), + <<1:1,1:1,1:1,0:1,B1:4,1:1,0:1,B2:6,1:1,0:1,B3:6>>; +int_to_utf8(I, 4) -> + B4 = I, + B3 = (I bsr 6), + B2 = (I bsr 12), + B1 = (I bsr 18), + <<1:1,1:1,1:1,1:1,0:1,B1:3,1:1,0:1,B2:6,1:1,0:1,B3:6,1:1,0:1,B4:6>>. + +%%------------------------------------------------------------------- + +make_unaligned(Bin0) when is_binary(Bin0) -> + Bin1 = <<0:3,Bin0/binary,31:5>>, + Sz = byte_size(Bin0), + <<0:3,Bin:Sz/binary,31:5>> = id(Bin1), + Bin. + +%%------------------------------------------------------------------- +%% Just to prevent compiler optimizations + +id(X) -> X. -- cgit v1.2.3 From 1c759f0bab4b0598231bd6e1d78171722d5c29df Mon Sep 17 00:00:00 2001 From: Kostis Sagonas Date: Sat, 28 Nov 2015 22:18:42 +0100 Subject: Cleanups & uncomment some code --- lib/hipe/test/basic_SUITE_data/basic_arith.erl | 2 +- lib/hipe/test/basic_SUITE_data/basic_bignums.erl | 2 +- lib/hipe/test/basic_SUITE_data/basic_floats.erl | 2 +- lib/hipe/test/basic_SUITE_data/basic_guards.erl | 6 ++-- .../test/basic_SUITE_data/basic_issues_beam.erl | 38 +++++++++++----------- lib/hipe/test/basic_SUITE_data/basic_random.erl | 4 +-- 6 files changed, 27 insertions(+), 27 deletions(-) (limited to 'lib/hipe/test') diff --git a/lib/hipe/test/basic_SUITE_data/basic_arith.erl b/lib/hipe/test/basic_SUITE_data/basic_arith.erl index 0277ad852b..28e99be053 100644 --- a/lib/hipe/test/basic_SUITE_data/basic_arith.erl +++ b/lib/hipe/test/basic_SUITE_data/basic_arith.erl @@ -14,7 +14,7 @@ test() -> ok = test_uplus(), ok = test_bsl_errors(), ok. - + %%---------------------------------------------------------------------- %% Tests the remainder operator. diff --git a/lib/hipe/test/basic_SUITE_data/basic_bignums.erl b/lib/hipe/test/basic_SUITE_data/basic_bignums.erl index 79f62e3229..e3b523b3f5 100644 --- a/lib/hipe/test/basic_SUITE_data/basic_bignums.erl +++ b/lib/hipe/test/basic_SUITE_data/basic_bignums.erl @@ -87,7 +87,7 @@ 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). +n(N, F, X, Y) when N > 1 -> n(N-1, F, F(X, Y), Y). %%-------------------------------------------------------------------- diff --git a/lib/hipe/test/basic_SUITE_data/basic_floats.erl b/lib/hipe/test/basic_SUITE_data/basic_floats.erl index a3df73b928..c49ac3946e 100644 --- a/lib/hipe/test/basic_SUITE_data/basic_floats.erl +++ b/lib/hipe/test/basic_SUITE_data/basic_floats.erl @@ -36,7 +36,7 @@ sub(X) -> mult(X) -> 3.1415 * X. - + %% tests the translation of the fnegate BEAM instruction. negate(X) -> - (X + 0.0). diff --git a/lib/hipe/test/basic_SUITE_data/basic_guards.erl b/lib/hipe/test/basic_SUITE_data/basic_guards.erl index a519944916..4bfe363ed3 100644 --- a/lib/hipe/test/basic_SUITE_data/basic_guards.erl +++ b/lib/hipe/test/basic_SUITE_data/basic_guards.erl @@ -35,7 +35,7 @@ guard1(X) when hd(X) == foo -> test_guard2() -> ok1 = guard2(true), not_boolean = guard2(42), - ok2 = guard2(false), + ok2 = guard2(false), ok. guard2(X) when X -> % gets transformed to: is_boolean(X), X =:= true @@ -48,7 +48,7 @@ guard2(_) -> %%-------------------------------------------------------------------- -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}), @@ -65,7 +65,7 @@ f(_) -> no. test_guard4() -> yes = is_ref(make_ref()), no = is_ref(gazonk), - yes = is_ref(an_external_ref(?EXT_REF)), + yes = is_ref(an_external_ref(?EXT_REF)), ok. is_ref(Ref) when is_reference(Ref) -> yes; diff --git a/lib/hipe/test/basic_SUITE_data/basic_issues_beam.erl b/lib/hipe/test/basic_SUITE_data/basic_issues_beam.erl index 47306b2502..7c4db28dd4 100644 --- a/lib/hipe/test/basic_SUITE_data/basic_issues_beam.erl +++ b/lib/hipe/test/basic_SUITE_data/basic_issues_beam.erl @@ -33,11 +33,11 @@ test() -> 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 + A when A#r.b == ""; A#r.b == undefined -> ok; + _ -> error end. %%-------------------------------------------------------------------- @@ -118,7 +118,7 @@ just_compile_me_R11_bjorklund() -> %% 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 @@ -198,9 +198,9 @@ die(A) -> test_crash_R12_morris() -> foo(42). - + foo(Bar) when (is_integer(Bar) andalso Bar =:= 0) ; Bar =:= 42 -> - ok. + ok. %%-------------------------------------------------------------------- %% From: Paulo Sergio Almeida @@ -237,20 +237,20 @@ collect(_, _, _) -> ok. test_error_R13B01_fisher() -> perform_select({foo, "42"}). -perform_select({Type, Keyval}) -> +perform_select({Type, Keyval}) -> try - if is_atom(Type) andalso length(Keyval) > 0 -> ok; - true -> ok - end - catch - _:_ -> fail - end. + 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. +%% I have the following compilation problem on Erlang R13B01. %% Compiler reports "Internal consistency check failed". %%-------------------------------------------------------------------- @@ -263,7 +263,7 @@ test_sawatari([H|T], Bin) -> null -> <>; _ -> ok end, - test_sawatari(T, Bin). + test_sawatari(T, Bin). %%-------------------------------------------------------------------- @@ -278,10 +278,10 @@ orgno_alphanum(Cs) -> orelse ((C >= $A) andalso (C =< $Z))]. %%-------------------------------------------------------------------- -%% I'm getting an Internal Consistency Check error when attempting to +%% 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 +%% +%% 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. @@ -322,4 +322,4 @@ test_error_R16B03_norell() -> test_error_R16B03_norell(#r{}, gazonk). test_error_R16B03_norell(Rec, Tag) -> - ok. %% is_record(Rec, Tag, 3) orelse ok. + is_record(Rec, Tag, 3) orelse ok. diff --git a/lib/hipe/test/basic_SUITE_data/basic_random.erl b/lib/hipe/test/basic_SUITE_data/basic_random.erl index 8866218318..783947bd31 100644 --- a/lib/hipe/test/basic_SUITE_data/basic_random.erl +++ b/lib/hipe/test/basic_SUITE_data/basic_random.erl @@ -218,7 +218,7 @@ merge2_1(_nil, H2, T2, 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, [H2 | T2], M) -> merge2_2(T1, H1, T2, [H2 | M]); merge2_2(T1, H1, _nil, M) -> lists:reverse(T1, [H1 | M]). @@ -232,7 +232,7 @@ rmerge2_1(_nil, H2, T2, 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, [H2 | T2], M) -> rmerge2_2(T1, H1, T2, [H2 | M]); rmerge2_2(T1, H1, _nil, M) -> lists:reverse(T1, [H1 | M]). -- cgit v1.2.3 From e991a1cf556e3af1894773834195d33d4e3bbb78 Mon Sep 17 00:00:00 2001 From: Kostis Sagonas Date: Sat, 28 Nov 2015 22:19:45 +0100 Subject: Comment out tests that are not ready for to_llvm --- lib/hipe/test/bs_SUITE_data/bs_utf.erl | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) (limited to 'lib/hipe/test') diff --git a/lib/hipe/test/bs_SUITE_data/bs_utf.erl b/lib/hipe/test/bs_SUITE_data/bs_utf.erl index 3a1988be0a..b50566ab1b 100644 --- a/lib/hipe/test/bs_SUITE_data/bs_utf.erl +++ b/lib/hipe/test/bs_SUITE_data/bs_utf.erl @@ -16,9 +16,10 @@ test() -> ok = utf8_roundtrip(), ok = utf16_roundtrip(), ok = utf32_roundtrip(), - ok = utf8_illegal_sequences(), - ok = utf16_illegal_sequences(), - ok = utf32_illegal_sequences(), + %% Currently, the following are problematic for the LLVM backend + %% ok = utf8_illegal_sequences(), + %% ok = utf16_illegal_sequences(), + %% ok = utf32_illegal_sequences(), ok. %%------------------------------------------------------------------- @@ -134,10 +135,10 @@ utf32_little_roundtrip(Char) -> utf8_illegal_sequences() -> fail_range(16#10FFFF+1, 16#10FFFF+512), % Too large. fail_range(16#D800, 16#DFFF), % Reserved for UTF-16. - + %% Illegal first character. [fail(<>) || I <- lists:seq(16#80, 16#BF)], - + %% Short sequences. short_sequences(16#80, 16#10FFFF), -- cgit v1.2.3 From 11e67cc4bfa8242bbb5a5c64d91dd6186bb2c4e4 Mon Sep 17 00:00:00 2001 From: Kostis Sagonas Date: Sun, 29 Nov 2015 15:05:30 +0100 Subject: Minor cleanup Take out extraneous spaces at the end of lines. --- lib/hipe/test/basic_SUITE_data/basic_issues_beam.erl | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'lib/hipe/test') diff --git a/lib/hipe/test/basic_SUITE_data/basic_issues_beam.erl b/lib/hipe/test/basic_SUITE_data/basic_issues_beam.erl index 7c4db28dd4..73367c5c45 100644 --- a/lib/hipe/test/basic_SUITE_data/basic_issues_beam.erl +++ b/lib/hipe/test/basic_SUITE_data/basic_issues_beam.erl @@ -119,6 +119,7 @@ just_compile_me_R11_bjorklund() -> %% 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 @@ -201,7 +202,7 @@ test_crash_R12_morris() -> foo(Bar) when (is_integer(Bar) andalso Bar =:= 0) ; Bar =:= 42 -> ok. - + %%-------------------------------------------------------------------- %% From: Paulo Sergio Almeida %% Date: May 20, 2009 -- cgit v1.2.3 From e91d465773e349409476ab8c85f9967a4fb7cc4a Mon Sep 17 00:00:00 2001 From: Kostis Sagonas Date: Mon, 30 Nov 2015 00:12:30 +0100 Subject: Three more tests added --- lib/hipe/test/basic_SUITE_data/basic_bugs_hipe.erl | 81 ++++++++++++ .../test/basic_SUITE_data/basic_exceptions.erl | 139 +++++++++++++++++++++ .../test/basic_SUITE_data/basic_pattern_match.erl | 10 ++ 3 files changed, 230 insertions(+) (limited to 'lib/hipe/test') diff --git a/lib/hipe/test/basic_SUITE_data/basic_bugs_hipe.erl b/lib/hipe/test/basic_SUITE_data/basic_bugs_hipe.erl index 01add52cb0..e70c25c905 100644 --- a/lib/hipe/test/basic_SUITE_data/basic_bugs_hipe.erl +++ b/lib/hipe/test/basic_SUITE_data/basic_bugs_hipe.erl @@ -10,6 +10,7 @@ test() -> ok = test_ets_bifs(), + ok = test_szar_bug(), ok = test_bit_shift(), ok = test_match_big_list(), ok = test_unsafe_bsl(), @@ -109,6 +110,86 @@ do_n_times(Fun, N) -> end, do_n_times(Fun, N - 1). +%%----------------------------------------------------------------------- +%% From: Jozsef Berces (PR/ECZ) +%% Date: Feb 19, 2004 +%% +%% Program which was added to the testsuite as a result of another bug +%% report involving tuples as funs. Thanks God, these are no longer +%% supported, but the following is a good test for testing calling +%% native code funs from BEAM code (lists:map, lists:filter, ...). +%%----------------------------------------------------------------------- + +test_szar_bug() -> + ["A","B","C"] = smartconcat([], "H'A, H'B, H'C"), + ok. + +smartconcat(B, L) -> + LL = tokenize(L, $,), + NewlineDel = fun (X) -> killcontrol(X) end, + StripFun = fun (X) -> string:strip(X) end, + LL2 = lists:map(NewlineDel, lists:map(StripFun, LL)), + EmptyDel = fun(X) -> + case string:len(X) of + 0 -> false; + _ -> true + end + end, + LL3 = lists:filter(EmptyDel, LL2), + HexFormat = fun(X, Acc) -> + case string:str(X, "H'") of + 1 -> + case checkhex(string:substr(X, 3)) of + {ok, Y} -> + {Y, Acc}; + _ -> + {X, Acc + 1} + end; + _ -> + {X, Acc + 1} + end + end, + {LL4,_Ret} = lists:mapfoldl(HexFormat, 0, LL3), + lists:append(B, lists:sublist(LL4, lists:max([0, 25 - length(B)]))). + +checkhex(L) -> + checkhex(L, ""). + +checkhex([H | T], N) when H >= $0, H =< $9 -> + checkhex(T, [H | N]); +checkhex([H | T], N) when H >= $A, H =< $F -> + checkhex(T, [H | N]); +checkhex([H | T], N) when H =< 32 -> + checkhex(T, N); +checkhex([_ | _], _) -> + {error, ""}; +checkhex([], N) -> + {ok, lists:reverse(N)}. + +killcontrol([C | S]) when C < 32 -> + killcontrol(S); +killcontrol([C | S]) -> + [C | killcontrol(S)]; +killcontrol([]) -> + []. + +tokenize(L, C) -> + tokenize(L, C, [], []). + +tokenize([C | T], C, A, B) -> + case A of + [] -> + tokenize(T, C, [], B); + _ -> + tokenize(T, C, [], [lists:reverse(A) | B]) + end; +tokenize([H | T], C, A, B) -> + tokenize(T, C, [H | A], B); +tokenize(_, _, [], B) -> + lists:reverse(B); +tokenize(_, _, A, B) -> + lists:reverse([lists:reverse(A) | B]). + %%----------------------------------------------------------------------- %% From: Niclas Pehrsson %% Date: Apr 20, 2006 diff --git a/lib/hipe/test/basic_SUITE_data/basic_exceptions.erl b/lib/hipe/test/basic_SUITE_data/basic_exceptions.erl index 082e805580..229a0516dc 100644 --- a/lib/hipe/test/basic_SUITE_data/basic_exceptions.erl +++ b/lib/hipe/test/basic_SUITE_data/basic_exceptions.erl @@ -21,6 +21,7 @@ test() -> ok = test_catches_merged(), ok = test_pending_errors(), ok = test_bad_fun_call(), + ok = test_guard_bif(), ok. %%-------------------------------------------------------------------- @@ -324,3 +325,141 @@ bad_call_fc(Fun) -> io:format("~p(~p) -> ~p\n", [Fun, Args, Res]), exit({bad_result, Other}) end. + +%%-------------------------------------------------------------------- +%% Taken from guard_SUITE.erl +%% +%% Tests correct handling of exceptions by calling guard BIFs with +%% nasty (but legal arguments). +%%-------------------------------------------------------------------- + +test_guard_bif() -> + Big = -237849247829874297658726487367328971246284736473821617265433, + Float = 387924.874, + + %% Succeding use of guard bifs. + + try_gbif('abs/1', Big, -Big), + try_gbif('float/1', Big, float(Big)), + try_gbif('trunc/1', Float, 387924.0), + try_gbif('round/1', Float, 387925.0), + try_gbif('length/1', [], 0), + + try_gbif('length/1', [a], 1), + try_gbif('length/1', [a, b], 2), + try_gbif('length/1', lists:seq(0, 31), 32), + + try_gbif('hd/1', [a], a), + try_gbif('hd/1', [a, b], a), + + try_gbif('tl/1', [a], []), + try_gbif('tl/1', [a, b], [b]), + try_gbif('tl/1', [a, b, c], [b, c]), + + try_gbif('size/1', {}, 0), + try_gbif('size/1', {a}, 1), + try_gbif('size/1', {a, b}, 2), + try_gbif('size/1', {a, b, c}, 3), + try_gbif('size/1', list_to_binary([]), 0), + try_gbif('size/1', list_to_binary([1]), 1), + try_gbif('size/1', list_to_binary([1, 2]), 2), + try_gbif('size/1', list_to_binary([1, 2, 3]), 3), + + try_gbif('element/2', {x}, {1, x}), + try_gbif('element/2', {x, y}, {1, x}), + try_gbif('element/2', {x, y}, {2, y}), + + try_gbif('self/0', 0, self()), + try_gbif('node/0', 0, node()), + try_gbif('node/1', self(), node()), + + %% Failing use of guard bifs. + + try_fail_gbif('abs/1', Big, 1), + try_fail_gbif('abs/1', [], 1), + + try_fail_gbif('float/1', Big, 42), + try_fail_gbif('float/1', [], 42), + + try_fail_gbif('trunc/1', Float, 0.0), + try_fail_gbif('trunc/1', [], 0.0), + + try_fail_gbif('round/1', Float, 1.0), + try_fail_gbif('round/1', [], a), + + try_fail_gbif('length/1', [], 1), + try_fail_gbif('length/1', [a], 0), + try_fail_gbif('length/1', a, 0), + try_fail_gbif('length/1', {a}, 0), + + try_fail_gbif('hd/1', [], 0), + try_fail_gbif('hd/1', [a], x), + try_fail_gbif('hd/1', x, x), + + try_fail_gbif('tl/1', [], 0), + try_fail_gbif('tl/1', [a], x), + try_fail_gbif('tl/1', x, x), + + try_fail_gbif('size/1', {}, 1), + try_fail_gbif('size/1', [], 0), + try_fail_gbif('size/1', [a], 1), + try_fail_gbif('size/1', fun() -> 1 end, 0), + try_fail_gbif('size/1', fun() -> 1 end, 1), + + try_fail_gbif('element/2', {}, {1, x}), + try_fail_gbif('element/2', {x}, {1, y}), + try_fail_gbif('element/2', [], {1, z}), + + try_fail_gbif('self/0', 0, list_to_pid("<0.0.0>")), + try_fail_gbif('node/0', 0, xxxx), + try_fail_gbif('node/1', self(), xxx), + try_fail_gbif('node/1', yyy, xxx), + ok. + +try_gbif(Id, X, Y) -> + case guard_bif(Id, X, Y) of + {Id, X, Y} -> + %% io:format("guard_bif(~p, ~p, ~p) -- ok\n", [Id, X, Y]); + ok; + Other -> + ok = io:format("guard_bif(~p, ~p, ~p) -- bad result: ~p\n", + [Id, X, Y, Other]), + exit({bad_result,try_gbif}) + end. + +try_fail_gbif(Id, X, Y) -> + case catch guard_bif(Id, X, Y) of + %% {'EXIT', {function_clause,[{?MODULE,guard_bif,[Id,X,Y]}|_]}} -> + {'EXIT', {function_clause,_}} -> % in HiPE, a trace is not generated + %% io:format("guard_bif(~p, ~p, ~p) -- ok\n", [Id,X,Y]); + ok; + Other -> + ok = io:format("guard_bif(~p, ~p, ~p) -- bad result: ~p\n", + [Id, X, Y, Other]), + exit({bad_result,try_fail_gbif}) + end. + +guard_bif('abs/1', X, Y) when abs(X) == Y -> + {'abs/1', X, Y}; +guard_bif('float/1', X, Y) when float(X) == Y -> + {'float/1', X, Y}; +guard_bif('trunc/1', X, Y) when trunc(X) == Y -> + {'trunc/1', X, Y}; +guard_bif('round/1', X, Y) when round(X) == Y -> + {'round/1', X, Y}; +guard_bif('length/1', X, Y) when length(X) == Y -> + {'length/1', X, Y}; +guard_bif('hd/1', X, Y) when hd(X) == Y -> + {'hd/1', X, Y}; +guard_bif('tl/1', X, Y) when tl(X) == Y -> + {'tl/1', X, Y}; +guard_bif('size/1', X, Y) when size(X) == Y -> + {'size/1', X, Y}; +guard_bif('element/2', X, {Pos, Expected}) when element(Pos, X) == Expected -> + {'element/2', X, {Pos, Expected}}; +guard_bif('self/0', X, Y) when self() == Y -> + {'self/0', X, Y}; +guard_bif('node/0', X, Y) when node() == Y -> + {'node/0', X, Y}; +guard_bif('node/1', X, Y) when node(X) == Y -> + {'node/1', X, Y}. diff --git a/lib/hipe/test/basic_SUITE_data/basic_pattern_match.erl b/lib/hipe/test/basic_SUITE_data/basic_pattern_match.erl index 9922b34415..93240354a7 100644 --- a/lib/hipe/test/basic_SUITE_data/basic_pattern_match.erl +++ b/lib/hipe/test/basic_SUITE_data/basic_pattern_match.erl @@ -11,6 +11,7 @@ test() -> ok = test_hello_world(), + ok = test_list_plus_plus_match(), ok. %%-------------------------------------------------------------------- @@ -34,3 +35,12 @@ gimme(binary) -> <<"hello world">>. %%-------------------------------------------------------------------- +%% Makes sure that pattern matching expressions involving ++ work OK. +%% The third expression caused a problem in the Erlang shell of R11B-5. +%% It worked OK in both interpreted and compiled code. + +test_list_plus_plus_match() -> + ok = (fun("X" ++ _) -> ok end)("X"), + ok = (fun([$X | _]) -> ok end)("X"), + ok = (fun([$X] ++ _) -> ok end)("X"), + ok. -- cgit v1.2.3 From c3e5a1ea98d2dae23aa6d050f93b7912dbe6f43c Mon Sep 17 00:00:00 2001 From: Kostis Sagonas Date: Mon, 30 Nov 2015 00:42:56 +0100 Subject: Test that apply/3 is tail recursive --- lib/hipe/test/basic_SUITE_data/basic_tail_rec.erl | 39 +++++++++++++++++++++++ 1 file changed, 39 insertions(+) create mode 100644 lib/hipe/test/basic_SUITE_data/basic_tail_rec.erl (limited to 'lib/hipe/test') diff --git a/lib/hipe/test/basic_SUITE_data/basic_tail_rec.erl b/lib/hipe/test/basic_SUITE_data/basic_tail_rec.erl new file mode 100644 index 0000000000..0124f13df6 --- /dev/null +++ b/lib/hipe/test/basic_SUITE_data/basic_tail_rec.erl @@ -0,0 +1,39 @@ +%%% -*- erlang-indent-level: 2 -*- +%%%------------------------------------------------------------------- +%%% Author: Kostis Sagonas +%%% +%%% Contains tests that check that tail recursion optimization occurs. +%%%------------------------------------------------------------------- +-module(basic_tail_rec). + +-export([test/0]). +-export([app0/2]). %% used in an apply/3 call + +test() -> + ok = test_app_tail(), + ok. + +%%-------------------------------------------------------------------- +%% Written by Mikael Pettersson: check that apply is tail recursive. + +%% Increased the following quantity from 20 to 30 so that the test +%% remains valid even with the naive register allocator. - Kostis +-define(SIZE_INCREASE, 30). + +test_app_tail() -> + Inc = start(400), + %% io:format("Inc ~w\n", [Inc]), + case Inc > ?SIZE_INCREASE of + true -> + {error, "apply/3 is not tail recursive in native code"}; + false -> + ok + end. + +start(N) -> + app0(N, hipe_bifs:nstack_used_size()). + +app0(0, Size0) -> + hipe_bifs:nstack_used_size() - Size0; +app0(N, Size) -> + apply(?MODULE, app0, [N-1, Size]). -- cgit v1.2.3 From 664cfa9f9c0676bdc949b2fd8c92dabcb3f75a09 Mon Sep 17 00:00:00 2001 From: Kostis Sagonas Date: Mon, 30 Nov 2015 00:54:40 +0100 Subject: Two more tests added - A test for proper handling of negative numbers in binary search key tables - A test for HiPE's ICode range analysis --- lib/hipe/test/basic_SUITE_data/basic_bugs_hipe.erl | 102 ++++++++++++++++++++- 1 file changed, 101 insertions(+), 1 deletion(-) (limited to 'lib/hipe/test') 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 e70c25c905..caa0e71d0b 100644 --- a/lib/hipe/test/basic_SUITE_data/basic_bugs_hipe.erl +++ b/lib/hipe/test/basic_SUITE_data/basic_bugs_hipe.erl @@ -16,6 +16,8 @@ test() -> ok = test_unsafe_bsl(), ok = test_unsafe_bsr(), ok = test_R12B5_seg_fault(), + ok = test_switch_neg_int(), + ok = test_icode_range_anal(), ok. %%----------------------------------------------------------------------- @@ -338,7 +340,7 @@ do_bsr(X, Y) -> %% # Some message to be printed here each loop iteration %% Segmentation fault %% -%% Diagnozed and fixed by Mikael Petterson (22 Jan 2009): +%% Diagnosed and fixed by Mikael Pettersson (22 Jan 2009): %% %% I've analysed the recently posted HiPE bug report on erlang-bugs %% . @@ -361,3 +363,101 @@ repeat(N, Fun) -> %% io:format("# Some message to be printed here each loop iteration\n"), Fun(), repeat(N - 1, Fun). + +%%----------------------------------------------------------------------- +%% From: Jon Meredith +%% Date: July 9, 2009 +%% +%% Binary search key tables are sorted by the loader based on the +%% runtime representations of the keys as unsigned words. However, +%% the code generated for the binary search used signed comparisons. +%% That worked for atoms and non-negative fixnums, but not for +%% negative fixnums. Fixed by Mikael Pettersson July 10, 2009. +%%----------------------------------------------------------------------- + +test_switch_neg_int() -> + ok = f(-80, 8). + +f(10, -1) -> ok; +f(X, Y) -> + Y = g(X), + f(X + 10, Y - 1). + +g(X) -> % g(0) should be 0 but became -1 + case X of + 0 -> 0; + -10 -> 1; + -20 -> 2; + -30 -> 3; + -40 -> 4; + -50 -> 5; + -60 -> 6; + -70 -> 7; + -80 -> 8; + _ -> -1 + end. + +%%----------------------------------------------------------------------- +%% From: Paul Guyot +%% Date: Jan 31, 2011 +%% +%% There is a bug in HiPE compilation with the comparison of floats +%% with integers. This bug happens in functions f/1 and g/2 below. +%% BEAM will evaluate f_eq(42) and f_eq(42.0) to true, while HiPE +%% will evaluate them to false. +%% +%% The culprit was the Icode range analysis which was buggy. (On the +%% other hand, HiPE properly evaluated these calls to true if passed +%% the option 'no_icode_range'.) Fixed by Kostis Sagonas. +%% -------------------------------------------------------------------- + +test_icode_range_anal() -> + true = f_eq(42), + true = f_eq(42.0), + false = f_ne(42), + false = f_ne(42.0), + false = f_eq_ex(42), + false = f_eq_ex(42.0), + true = f_ne_ex(42), + true = f_ne_ex(42.0), + false = f_gt(42), + false = f_gt(42.0), + true = f_le(42), + true = f_le(42.0), + zero_test = g(0, test), + zero_test = g(0.0, test), + non_zero_test = g(42, test), + other = g(42, other), + ok. + +f_eq(X) -> + Y = X / 2, + Y == 21. + +f_ne(X) -> + Y = X / 2, + Y /= 21. + +f_eq_ex(X) -> + Y = X / 2, + Y =:= 21. + +f_ne_ex(X) -> + Y = X / 2, + Y =/= 21. + +f_gt(X) -> + Y = X / 2, + Y > 21. + +f_le(X) -> + Y = X / 2, + Y =< 21. + +g(X, Z) -> + Y = X / 2, + case Z of + test when Y == 0 -> zero_test; + test -> non_zero_test; + other -> other + end. -- cgit v1.2.3 From 186868ede408e714afe191c0a40123e4f8b2e847 Mon Sep 17 00:00:00 2001 From: Kostis Sagonas Date: Mon, 30 Nov 2015 01:59:00 +0100 Subject: Add tests for the is_boolean/1 guard --- lib/hipe/test/basic_SUITE_data/basic_guards.erl | 42 +++++++++++++++++++++++++ 1 file changed, 42 insertions(+) (limited to 'lib/hipe/test') diff --git a/lib/hipe/test/basic_SUITE_data/basic_guards.erl b/lib/hipe/test/basic_SUITE_data/basic_guards.erl index 4bfe363ed3..b821a05ad5 100644 --- a/lib/hipe/test/basic_SUITE_data/basic_guards.erl +++ b/lib/hipe/test/basic_SUITE_data/basic_guards.erl @@ -14,6 +14,7 @@ test() -> ok = test_guard2(), ok = test_guard3(), ok = test_guard4(), + ok = test_is_boolean(), ok. %%-------------------------------------------------------------------- @@ -73,3 +74,44 @@ is_ref(_Ref) -> no. an_external_ref(Bin) -> binary_to_term(Bin). + +%%-------------------------------------------------------------------- + +test_is_boolean() -> + ok = is_boolean_in_if(), + ok = is_boolean_in_guard(). + +is_boolean_in_if() -> + ok1 = tif(true), + ok2 = tif(false), + not_bool = tif(other), + ok. + +is_boolean_in_guard() -> + ok = tg(true), + ok = tg(false), + not_bool = tg(other), + ok. + +tif(V) -> + Yes = yes(), %% just to prevent the optimizer removing this + if + %% the following line generates an is_boolean instruction + V, Yes == yes -> + %% while the following one does not (?!) + %% Yes == yes, V -> + ok1; + not(not(not(V))) -> + ok2; + V -> + ok3; + true -> + not_bool + end. + +tg(V) when is_boolean(V) -> + ok; +tg(_) -> + not_bool. + +yes() -> yes. -- cgit v1.2.3 From a0286ce52c775812e499c4f036033daa5ffe4676 Mon Sep 17 00:00:00 2001 From: Kostis Sagonas Date: Mon, 30 Nov 2015 23:36:42 +0100 Subject: Include some more old HiPE tests to the test suite --- lib/hipe/test/basic_SUITE_data/basic_guards.erl | 47 ++++++++++++++++ .../basic_SUITE_data/basic_strength_reduce.erl | 65 ++++++++++++++++++++++ lib/hipe/test/basic_SUITE_data/basic_switches.erl | 52 +++++++++++++++++ 3 files changed, 164 insertions(+) create mode 100644 lib/hipe/test/basic_SUITE_data/basic_strength_reduce.erl create mode 100644 lib/hipe/test/basic_SUITE_data/basic_switches.erl (limited to 'lib/hipe/test') diff --git a/lib/hipe/test/basic_SUITE_data/basic_guards.erl b/lib/hipe/test/basic_SUITE_data/basic_guards.erl index b821a05ad5..81eeed7c3b 100644 --- a/lib/hipe/test/basic_SUITE_data/basic_guards.erl +++ b/lib/hipe/test/basic_SUITE_data/basic_guards.erl @@ -7,6 +7,8 @@ -module(basic_guards). -export([test/0]). +%% Prevent the inlining of the following functions +-export([bad_arith/0, bad_tuple/0, is_strange_guard/0]). test() -> ok = guard0(4.2), @@ -15,6 +17,7 @@ test() -> ok = test_guard3(), ok = test_guard4(), ok = test_is_boolean(), + ok = test_bad_guards(), ok. %%-------------------------------------------------------------------- @@ -115,3 +118,47 @@ tg(_) -> not_bool. yes() -> yes. + +%%-------------------------------------------------------------------- +%% original test by Bjorn G + +test_bad_guards() -> + ok = bad_arith(), + ok = bad_tuple(), + ok = is_strange_guard(), + ok. + +bad_arith() -> + 13 = bad_arith1(1, 12), + 42 = bad_arith1(1, infinity), + 42 = bad_arith1(infinity, 1), + 42 = bad_arith2(infinity, 1), + 42 = bad_arith3(inf), + 42 = bad_arith4(infinity, 1), + ok. + +bad_arith1(T1, T2) when (T1 + T2) < 17 -> T1 + T2; +bad_arith1(_, _) -> 42. + +bad_arith2(T1, T2) when (T1 * T2) < 17 -> T1 * T2; +bad_arith2(_, _) -> 42. + +bad_arith3(T) when (bnot T) < 17 -> T; +bad_arith3(_) -> 42. + +bad_arith4(T1, T2) when (T1 bsr T2) < 10 -> T1 bsr T2; +bad_arith4(_, _) -> 42. + +bad_tuple() -> + error = bad_tuple1(a), + error = bad_tuple1({a, b}), + x = bad_tuple1({x, b}), + y = bad_tuple1({a, b, y}), + ok. + +bad_tuple1(T) when element(1, T) =:= x -> x; +bad_tuple1(T) when element(3, T) =:= y -> y; +bad_tuple1(_) -> error. + +is_strange_guard() when is_tuple({1, bar, length([1, 2, 3, 4]), self()}) -> ok; +is_strange_guard() -> error. diff --git a/lib/hipe/test/basic_SUITE_data/basic_strength_reduce.erl b/lib/hipe/test/basic_SUITE_data/basic_strength_reduce.erl new file mode 100644 index 0000000000..0f94320a33 --- /dev/null +++ b/lib/hipe/test/basic_SUITE_data/basic_strength_reduce.erl @@ -0,0 +1,65 @@ +%%% -*- erlang-indent-level: 2 -*- +%%%------------------------------------------------------------------- +%%% Author: Kostis Sagonas +%%% +%%% Tests the strength reduction component of the HiPE compiler. +%%%------------------------------------------------------------------- +-module(basic_strength_reduce). + +-export([test/0]). +%% These functions are exported so as to not remove them by inlining +-export([crash_0/1, crash_1/1, crash_2/1, crash_3/1, bug_div_2N/1]). + +test() -> + ok = test_strength_reduce1(), + ok. + +%%-------------------------------------------------------------------- + +test_strength_reduce1() -> + ok = crash_0(0), + ok = crash_1(42), + ok = crash_2(42), + ok = crash_3(42), + 5 = 42 bsr 3 = bug_div_2N(42), + -6 = -42 bsr 3 = bug_div_2N(-42) - 1, + ok. + +%% This is a crash report by Peter Wang (10 July 2007) triggering an +%% R11B-5 crash: strength reduction could not handle calls with no +%% destination +crash_0(A) -> + case A of + 0 -> + A div 8, + ok + end. + +%% The above was simplified to the following which showed another +%% crash, this time on RTL +crash_1(A) when is_integer(A), A >= 0 -> + A div 8, + ok. + +%% A similar crash like the first one, but in a different place in the +%% code, was triggered by the following code +crash_2(A) when is_integer(A), A >= 0 -> + A div 1, + ok. + +%% A crash similar to the first one happened in the following code +crash_3(A) -> + case A of + 42 -> + A * 0, + ok + end. + +%% Strength reduction for div/2 and rem/2 with a power of 2 +%% should be performed only for non-negative integers +bug_div_2N(X) when is_integer(X), X >= 0 -> + X div 8; +bug_div_2N(X) when is_integer(X), X < 0 -> + X div 8. + +%%-------------------------------------------------------------------- diff --git a/lib/hipe/test/basic_SUITE_data/basic_switches.erl b/lib/hipe/test/basic_SUITE_data/basic_switches.erl new file mode 100644 index 0000000000..0a7ae5b8b7 --- /dev/null +++ b/lib/hipe/test/basic_SUITE_data/basic_switches.erl @@ -0,0 +1,52 @@ +%%% -*- erlang-indent-level: 2 -*- +%%%------------------------------------------------------------------- +%%% Author: Kostis Sagonas +%%% +%%% Contains tests for pattern matching switches. +%%%------------------------------------------------------------------- +-module(basic_switches). + +-export([test/0]). + +test() -> + ok = test_switch_mix(), + ok. + +%%--------------------------------------------------------------------- + +-define(BIG1, 21323233222132323322). +-define(BIG2, 4242424242424242424242424242424242). + +test_switch_mix() -> + small1 = t(42), + small2 = t(17), + big1 = t(?BIG1), + big2 = t(?BIG2), + atom = t(foo), + pid = t(self()), + float = t(4.2), + ok. + +t(V) -> + S = self(), + case V of + 42 -> small1; + 17 -> small2; + ?BIG1 -> big1; + ?BIG2 -> big2; + 1 -> no; + 2 -> no; + 3 -> no; + 4 -> no; + 5 -> no; + 6 -> no; + 7 -> no; + 8 -> no; + foo -> atom; + 9 -> no; + 4.2 -> float; + S -> pid; + _ -> no + end. + +%%--------------------------------------------------------------------- -- cgit v1.2.3 From 34e992d6681563145c777d5c16e1305f27a751fd Mon Sep 17 00:00:00 2001 From: Kostis Sagonas Date: Tue, 1 Dec 2015 01:44:10 +0100 Subject: More tests for BIFs --- lib/hipe/test/basic_SUITE_data/basic_bifs.erl | 232 +++++++++++++++++++++++++- 1 file changed, 224 insertions(+), 8 deletions(-) (limited to 'lib/hipe/test') diff --git a/lib/hipe/test/basic_SUITE_data/basic_bifs.erl b/lib/hipe/test/basic_SUITE_data/basic_bifs.erl index d6f21ceb52..e7ee2f3678 100644 --- a/lib/hipe/test/basic_SUITE_data/basic_bifs.erl +++ b/lib/hipe/test/basic_SUITE_data/basic_bifs.erl @@ -8,20 +8,39 @@ -export([test/0]). +-define(BIG, 1398479237498374913984792374983749). + test() -> + ok = test_abs(), + ok = test_binary_part(), ok = test_element(), - ok = test_binary_part(). + ok = test_float(), + ok = test_float_to_list(), + ok = test_integer_to_list(), + ok = test_list_to_float(), + ok = test_list_to_integer(), + ok = test_round(), + ok = test_trunc(), + ok. %%-------------------------------------------------------------------- -test_element() -> - true = elem({a, b}), - false = elem({a, c}), - other = elem(gazonk), - ok. +test_abs() -> + t_abs(5.5, 0.0, -100.0, 5, 0, -100, ?BIG). -elem(T) when element(1, T) == a -> element(2, T) == b; -elem(_) -> other. +t_abs(F1, F2, F3, I1, I2, I3, BigNum) -> + %% Floats. + 5.5 = abs(F1), + 0.0 = abs(F2), + 100.0 = abs(F3), + %% Integers. + 5 = abs(I1), + 0 = abs(I2), + 100 = abs(I3), + %% Bignums. + BigNum = abs(BigNum), + BigNum = abs(-BigNum), + ok. %%-------------------------------------------------------------------- %% Checks that 2-ary and 3-ary BIFs can be compiled to native code. @@ -39,3 +58,200 @@ bp3(Bin) -> binary_part(Bin, byte_size(Bin), -5). %%-------------------------------------------------------------------- + +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. + +%%-------------------------------------------------------------------- + +test_float() -> + t_float(0, 42, -100, 2.5, 0.0, -100.42, ?BIG, -?BIG). + +t_float(I1, I2, I3, F1, F2, F3, B1, B2) -> + 0.0 = float(I1), + 2.5 = float(F1), + 0.0 = float(F2), + -100.42 = float(F3), + 42.0 = float(I2), + -100.0 = float(I3), + %% Bignums. + 1398479237498374913984792374983749.0 = float(B1), + -1398479237498374913984792374983749.0 = float(B2), + %% Extremly big bignums. + Big = list_to_integer(duplicate(2000, $1)), + {'EXIT', _} = (catch float(Big)), + %% Invalid types and lists. + {'EXIT', _} = (catch my_list_to_integer(atom)), + {'EXIT', _} = (catch my_list_to_integer(123)), + {'EXIT', _} = (catch my_list_to_integer([$1, [$2]])), + {'EXIT', _} = (catch my_list_to_integer("1.2")), + {'EXIT', _} = (catch my_list_to_integer("a")), + {'EXIT', _} = (catch my_list_to_integer("")), + ok. + +my_list_to_integer(X) -> + list_to_integer(X). + +%%-------------------------------------------------------------------- + +test_float_to_list() -> + test_ftl("0.0e+0", 0.0), + test_ftl("2.5e+1", 25.0), + test_ftl("2.5e+0", 2.5), + test_ftl("2.5e-1", 0.25), + test_ftl("-3.5e+17", -350.0e15), + ok. + +test_ftl(Expect, Float) -> + %% No \n on the next line -- we want the line number from t_float_to_list. + Expect = remove_zeros(lists:reverse(float_to_list(Float)), []). + +%% Removes any non-significant zeros in a floating point number. +%% Example: 2.500000e+01 -> 2.5e+1 + +remove_zeros([$+, $e|Rest], [$0, X|Result]) -> + remove_zeros([$+, $e|Rest], [X|Result]); +remove_zeros([$-, $e|Rest], [$0, X|Result]) -> + remove_zeros([$-, $e|Rest], [X|Result]); +remove_zeros([$0, $.|Rest], [$e|Result]) -> + remove_zeros(Rest, [$., $0, $e|Result]); +remove_zeros([$0|Rest], [$e|Result]) -> + remove_zeros(Rest, [$e|Result]); +remove_zeros([Char|Rest], Result) -> + remove_zeros(Rest, [Char|Result]); +remove_zeros([], Result) -> + Result. + +%%-------------------------------------------------------------------- + +test_integer_to_list() -> + t_integer_to_list(0, 42, 32768, 268435455, 123456932798748738738). + +t_integer_to_list(I1, I2, I3, I4, BIG) -> + "0" = integer_to_list(I1), + "42" = integer_to_list(I2), + "-42" = integer_to_list(-I2), + "-42" = integer_to_list(-I2), + "32768" = integer_to_list(I3), + "268435455" = integer_to_list(I4), + "-268435455" = integer_to_list(-I4), + "123456932798748738738" = integer_to_list(BIG), + BigList = duplicate(2000, $1), + Big = list_to_integer(BigList), + BigList = integer_to_list(Big), + ok. + +%%-------------------------------------------------------------------- + +test_list_to_float() -> + ok = t_list_to_float_safe(), + ok = t_list_to_float_risky(). + +t_list_to_float_safe() -> + 0.0 = my_list_to_float("0.0"), + 0.0 = my_list_to_float("-0.0"), + 0.5 = my_list_to_float("0.5"), + -0.5 = my_list_to_float("-0.5"), + 100.0 = my_list_to_float("1.0e2"), + 127.5 = my_list_to_float("127.5"), + -199.5 = my_list_to_float("-199.5"), + {'EXIT', _} = (catch my_list_to_float("0")), + {'EXIT', _} = (catch my_list_to_float("0..0")), + {'EXIT', _} = (catch my_list_to_float("0e12")), + {'EXIT', _} = (catch my_list_to_float("--0.0")), + ok. + +my_list_to_float(X) -> + list_to_float(X). + +%% This might crash the emulator. (Used to crash Erlang 4.4.1 on Unix.) + +t_list_to_float_risky() -> + Many_Ones = duplicate(25000, $1), + ok = case list_to_float("2." ++ Many_Ones) of + F when is_float(F), 0.0 < F, F =< 3.14 -> ok + end, + {'EXIT', _} = (catch list_to_float("2" ++ Many_Ones)), + ok. + +%%-------------------------------------------------------------------- + +test_list_to_integer() -> + ok = t_list_to_integer_small("0", "00", "-0", "1", "-1", "42", "-12", + "32768", "268435455", "-268435455"), + ok = t_list_to_integer_bignum("123456932798748738738666"), + ok. + +t_list_to_integer_small(S1, S2, S3, S4, S5, S6, S7, S8, S9, S10) -> + 0 = list_to_integer(S1), + 0 = list_to_integer(S2), + 0 = list_to_integer(S3), + 1 = list_to_integer(S4), + -1 = list_to_integer(S5), + 42 = list_to_integer(S6), + -12 = list_to_integer(S7), + 32768 = list_to_integer(S8), + 268435455 = list_to_integer(S9), + -268435455 = list_to_integer(S10), + ok. + +t_list_to_integer_bignum(S) -> + 123456932798748738738666 = list_to_integer(S), + case list_to_integer(duplicate(2000, $1)) of + I when is_integer(I), I > 123456932798748738738666 -> ok + end. + +%%-------------------------------------------------------------------- + +test_round() -> + ok = t_round_small(0.0, 0.4, 0.5, -0.4, -0.5, 255.3, 255.6, -1033.3, -1033.6), + ok = t_round_big(4294967296.1, 4294967296.9), + ok. + +t_round_small(F1, F2, F3, F4, F5, F6, F7, F8, F9) -> + 0 = round(F1), + 0 = round(F2), + 1 = round(F3), + 0 = round(F4), + -1 = round(F5), + 255 = round(F6), + 256 = round(F7), + -1033 = round(F8), + -1034 = round(F9), + ok. + +t_round_big(B1, B2) -> + 4294967296 = round(B1), + 4294967297 = round(B2), + -4294967296 = round(-B1), + -4294967297 = round(-B2), + ok. + +%%-------------------------------------------------------------------- + +test_trunc() -> + t_trunc(0.0, 5.3333, -10.978987, 4294967305.7). + +t_trunc(F1, F2, F3, B) -> + 0 = trunc(F1), + 5 = trunc(F2), + -10 = trunc(F3), + %% Bignums. + 4294967305 = trunc(B), + -4294967305 = trunc(-B), + ok. + +%%-------------------------------------------------------------------- +%% Auxiliary functions below + +duplicate(N, X) when is_integer(N), N >= 0 -> + duplicate(N, X, []). + +duplicate(0, _, L) -> L; +duplicate(N, X, L) -> duplicate(N-1, X, [X|L]). -- cgit v1.2.3 From fd154a229271e488eccd25cf1b838560c2decb52 Mon Sep 17 00:00:00 2001 From: Kostis Sagonas Date: Wed, 2 Dec 2015 01:11:24 +0100 Subject: Two tests that depend on inlining being turned on --- .../basic_SUITE_data/basic_inline_function.erl | 73 ++++++++++++++++++++++ .../test/basic_SUITE_data/basic_inline_module.erl | 31 +++++++++ 2 files changed, 104 insertions(+) create mode 100644 lib/hipe/test/basic_SUITE_data/basic_inline_function.erl create mode 100644 lib/hipe/test/basic_SUITE_data/basic_inline_module.erl (limited to 'lib/hipe/test') diff --git a/lib/hipe/test/basic_SUITE_data/basic_inline_function.erl b/lib/hipe/test/basic_SUITE_data/basic_inline_function.erl new file mode 100644 index 0000000000..4c08064670 --- /dev/null +++ b/lib/hipe/test/basic_SUITE_data/basic_inline_function.erl @@ -0,0 +1,73 @@ +%%% -*- erlang-indent-level: 2 -*- +%%%------------------------------------------------------------------- +%%% Author: Kostis Sagonas +%%% +%%% Contains tests that depend on the compiler inliner being turned on. +%%%------------------------------------------------------------------- +-module(basic_inline_function). + +-export([test/0]). + +-compile({inline, [{to_objects, 3}]}). + +test() -> + ok = test_inline_match(), + ok. + +%%-------------------------------------------------------------------- + +test_inline_match() -> + bad_object = test1(a, {binary, foo, set}, c), + bad_object = test2(a, {binary, foo, set}, c), + bad_object = test3(a, {binary, foo, set}, c), + ok. + +%% Inlined +test1(KeysObjs, C, Ts) -> + case catch to_objects(KeysObjs, C, Ts) of + {'EXIT', _} -> + bad_object; + ok -> + ok + end. + +%% "Inlined" by hand +test2(KeysObjs, C, _Ts) -> + case catch (case C of + {binary, _, set} -> + <<_ObjSz0:32, _T/binary>> = KeysObjs; + _ -> ok + end) of + {'EXIT', _} -> + bad_object; + ok -> + ok + end. + +%% Not inlined +test3(KeysObjs, C, Ts) -> + case catch fto_objects(KeysObjs, C, Ts) of + {'EXIT', _} -> + bad_object; + ok -> + ok + end. + +%% Inlined. +to_objects(Bin, {binary, _, set}, _Ts) -> + <<_ObjSz0:32, _T/binary>> = Bin, + ok; +to_objects(<<_ObjSz0:32, _T/binary>> ,_, _) -> + ok; +to_objects(_Bin, _, _Ts) -> + ok. + +%% Not Inlined. +fto_objects(Bin, {binary, _, set}, _Ts) -> + <<_ObjSz0:32, _T/binary>> = Bin, + ok; +fto_objects(<<_ObjSz0:32, _T/binary>> ,_,_) -> + ok; +fto_objects(_Bin, _, _Ts) -> + ok. + diff --git a/lib/hipe/test/basic_SUITE_data/basic_inline_module.erl b/lib/hipe/test/basic_SUITE_data/basic_inline_module.erl new file mode 100644 index 0000000000..306c6a39ce --- /dev/null +++ b/lib/hipe/test/basic_SUITE_data/basic_inline_module.erl @@ -0,0 +1,31 @@ +%%% -*- erlang-indent-level: 2 -*- +%%%------------------------------------------------------------------- +%%% Author: Kostis Sagonas +%%% +%%% Contains tests that depend on the compiler inliner being turned on. +%%%------------------------------------------------------------------- +-module(basic_inline_module). + +-export([test/0]). + +-compile([inline]). %% necessary for these tests + +test() -> + ok = test_case_end_atom(), + ok. + +%%-------------------------------------------------------------------- +%% Tests whether the translation of a case_end instruction works even +%% when an exception (no matching case pattern) is to be raised. + +test_case_end_atom() -> + {'EXIT',{{case_clause,some_atom},_Trace}} = (catch test_case_stm_inlining()), + ok. + +test_case_stm_inlining() -> + case some_atom() of + another_atom -> strange_result + end. + +some_atom() -> + some_atom. -- cgit v1.2.3 From 8da78333089d1e28e51a9724f67cac66656e1368 Mon Sep 17 00:00:00 2001 From: Kostis Sagonas Date: Wed, 2 Dec 2015 01:52:50 +0100 Subject: Cleanup and add one more test case --- lib/hipe/test/basic_SUITE_data/basic_floats.erl | 42 +++++++++++++++++++------ 1 file changed, 33 insertions(+), 9 deletions(-) (limited to 'lib/hipe/test') diff --git a/lib/hipe/test/basic_SUITE_data/basic_floats.erl b/lib/hipe/test/basic_SUITE_data/basic_floats.erl index c49ac3946e..eec175075a 100644 --- a/lib/hipe/test/basic_SUITE_data/basic_floats.erl +++ b/lib/hipe/test/basic_SUITE_data/basic_floats.erl @@ -7,6 +7,7 @@ -module(basic_floats). -export([test/0]). +-export([test_fmt_double_fpe_leak/0]). % suppress the unused warning test() -> ok = test_arith_ops(), @@ -16,6 +17,7 @@ test() -> ok = test_catch_bad_fp_arith(), ok = test_catch_fp_conv(), ok = test_fp_with_fp_exceptions(), + %% ok = test_fmt_double_fpe_leak(), % this requires printing ok. %%-------------------------------------------------------------------- @@ -47,8 +49,8 @@ negate(X) -> %%-------------------------------------------------------------------- test_fp_ebb() -> - 1.0 = foo(2*math:pi()), - 1.0 = bar(2*math:pi()), + 1.0 = foo(2 * math:pi()), + 1.0 = bar(2 * math:pi()), ok. foo(X) -> @@ -123,7 +125,7 @@ big_int_arith(I) when is_integer(I) -> big_const_float(F) -> I = trunc(F), badarith = try (1/(2*I)) catch error:Err -> Err end, - _Ignore = 2/I, + _ = 2/I, {'EXIT', _} = (catch 4/(2*I)), ok. @@ -133,14 +135,14 @@ big_const_float(F) -> test_fp_with_fp_exceptions() -> 0.0 = math:log(1.0), - badarith = try math:log(minus_one_float()) catch error:E1 -> E1 end, + badarith = try math:log(float_minus_one()) catch error:E1 -> E1 end, 0.0 = math:log(1.0), - badarith = try math:log(zero_float()) catch error:E2 -> E2 end, + badarith = try math:log(float_zero()) 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)), + {'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, + badarith = try fp_div(5.0, 0.0) catch error:E3 -> E3 end, 0.0 = math:log(1.0), ok. @@ -151,6 +153,28 @@ 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. +float_zero() -> 0.0. -minus_one_float() -> -1.0. +float_minus_one() -> -1.0. + +%%-------------------------------------------------------------------- +%% Test that erl_printf_format.c:fmt_double() does not leak pending FP +%% exceptions to subsequent code. This used to break x87 FP code on +%% 32-bit x86. Based on a problem report from Richard Carlsson. + +test_fmt_double_fpe_leak() -> + test_fmt_double_fpe_leak(float_zero(), int_two()), + ok. + +%% We need the specific sequence of erlang:display/1 on a float that +%% triggers faulting ops in fmt_double() followed by a simple FP BIF. +%% We also need to repeat this at least three times. +test_fmt_double_fpe_leak(X, Y) -> + erlang:display(X), _ = math:log10(Y), + erlang:display(X), _ = math:log10(Y), + erlang:display(X), _ = math:log10(Y), + erlang:display(X), _ = math:log10(Y), + erlang:display(X), + math:log10(Y). + +int_two() -> 2. -- cgit v1.2.3 From 8970c8c25c45e6a4f92b0652c65e26d890939409 Mon Sep 17 00:00:00 2001 From: Kostis Sagonas Date: Wed, 16 Dec 2015 23:09:46 +0100 Subject: Fix compilation of matching with UTF binaries The code generated by the HiPE compiler for pattern matching with UTF binaries was such that sometimes THE_NON_VALUE was stored in the roots followed by the garbage collector. This was not an issue for the vanilla native code compiler, but was problematic for the ErLLVM back-end. Fix the issue by not storing THE_NON_VALUE in the live roots. An alternative fix would be to change the code of the garbage collector. With this fix, there are no more (known) failing test cases for the ErLLVM back-end (at least on x86_64 with LLVM 3.5, which is the configuation regularly tested). Thanks to @margnus1 for the fix. --- lib/hipe/test/bs_SUITE_data/bs_utf.erl | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) (limited to 'lib/hipe/test') diff --git a/lib/hipe/test/bs_SUITE_data/bs_utf.erl b/lib/hipe/test/bs_SUITE_data/bs_utf.erl index b50566ab1b..24526f574d 100644 --- a/lib/hipe/test/bs_SUITE_data/bs_utf.erl +++ b/lib/hipe/test/bs_SUITE_data/bs_utf.erl @@ -16,10 +16,10 @@ test() -> ok = utf8_roundtrip(), ok = utf16_roundtrip(), ok = utf32_roundtrip(), - %% Currently, the following are problematic for the LLVM backend - %% ok = utf8_illegal_sequences(), - %% ok = utf16_illegal_sequences(), - %% ok = utf32_illegal_sequences(), + %% The following were problematic for the LLVM backend + ok = utf8_illegal_sequences(), + ok = utf16_illegal_sequences(), + ok = utf32_illegal_sequences(), ok. %%------------------------------------------------------------------- -- cgit v1.2.3 From 03fcb7dabf8861e60ffab4121a909b347bccfec9 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Mon, 15 Feb 2016 15:33:12 +0100 Subject: Eliminate use of test_server.hrl and test_server_line.hrl As a first step to removing the test_server application as as its own separate application, change the inclusion of test_server.hrl to an inclusion of ct.hrl and remove the inclusion of test_server_line.hrl. --- lib/hipe/test/bs_SUITE_data/bs_utf.erl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lib/hipe/test') diff --git a/lib/hipe/test/bs_SUITE_data/bs_utf.erl b/lib/hipe/test/bs_SUITE_data/bs_utf.erl index 24526f574d..368ad0cd20 100644 --- a/lib/hipe/test/bs_SUITE_data/bs_utf.erl +++ b/lib/hipe/test/bs_SUITE_data/bs_utf.erl @@ -9,7 +9,7 @@ -export([test/0]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). test() -> ok = utf8_cm65(), -- cgit v1.2.3 From 4e1162bbdf88465a03da165c088ad1256b816956 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Mon, 15 Feb 2016 16:04:32 +0100 Subject: Makefiles: Remove test_server from include path and code path Since no test suites includede test_server.hrl, there is no need to have test_server in the include path or code path. --- lib/hipe/test/Makefile | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lib/hipe/test') diff --git a/lib/hipe/test/Makefile b/lib/hipe/test/Makefile index d781e4f9be..09f4fd2129 100644 --- a/lib/hipe/test/Makefile +++ b/lib/hipe/test/Makefile @@ -36,7 +36,7 @@ RELSYSDIR = $(RELEASE_PATH)/hipe_test # ---------------------------------------------------- ERL_MAKE_FLAGS += -ERL_COMPILE_FLAGS += -I$(ERL_TOP)/lib/test_server/include +ERL_COMPILE_FLAGS += EBIN = . -- cgit v1.2.3