diff options
Diffstat (limited to 'erts/emulator/test/beam_SUITE.erl')
-rw-r--r-- | erts/emulator/test/beam_SUITE.erl | 154 |
1 files changed, 96 insertions, 58 deletions
diff --git a/erts/emulator/test/beam_SUITE.erl b/erts/emulator/test/beam_SUITE.erl index 60339ea422..6a54fa87e0 100644 --- a/erts/emulator/test/beam_SUITE.erl +++ b/erts/emulator/test/beam_SUITE.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1998-2013. All Rights Reserved. +%% Copyright Ericsson AB 1998-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at %% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -23,17 +24,19 @@ init_per_group/2,end_per_group/2, packed_registers/1, apply_last/1, apply_last_bif/1, buildo_mucho/1, heap_sizes/1, big_lists/1, fconv/1, - select_val/1]). + select_val/1, swap_temp_apply/1]). --export([applied/2]). +-export([applied/2,swap_temp_applied/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). +-include_lib("syntax_tools/include/merl.hrl"). suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> [packed_registers, apply_last, apply_last_bif, - buildo_mucho, heap_sizes, big_lists, select_val]. + buildo_mucho, heap_sizes, big_lists, select_val, + swap_temp_apply]. groups() -> []. @@ -60,15 +63,15 @@ apply_last(Config) when is_list(Config) -> {Pid, finished} -> stack_size(Pid) after 30000 -> - ?t:fail("applied/2 timed out.") + ct:fail("applied/2 timed out.") end, Pid ! die, - ?t:format("Size: ~p~n", [Size]), + io:format("Size: ~p~n", [Size]), if Size < 700 -> ok; true -> - ?t:fail("10000 apply() grew stack too much.") + ct:fail("10000 apply() grew stack too much.") end, ok. @@ -91,49 +94,46 @@ applied(Starter, N) -> apply_last_bif(Config) when is_list(Config) -> apply(erlang, abs, [1]). -%% Test three high register numbers in a put_list instruction -%% (to test whether packing works properly). +%% Test whether packing works properly. packed_registers(Config) when is_list(Config) -> - PrivDir = ?config(priv_dir, Config), - Mod = packed_regs, - Name = filename:join(PrivDir, atom_to_list(Mod) ++ ".erl"), - - %% Generate a module which generates a list of tuples. - %% put_list(A) -> [{A, 600}, {A, 999}, ... {A, 0}]. - Code = gen_packed_regs(600, ["-module("++atom_to_list(Mod)++").\n", - "-export([put_list/1]).\n", - "put_list(A) ->\n["]), - ok = file:write_file(Name, Code), - - %% Compile the module. - io:format("Compiling: ~s\n", [Name]), - CompRc = compile:file(Name, [{outdir, PrivDir}, report]), - io:format("Result: ~p\n",[CompRc]), - {ok, Mod} = CompRc, - - %% Load it. - io:format("Loading...\n",[]), - LoadRc = code:load_abs(filename:join(PrivDir, atom_to_list(Mod))), - {module,_Module} = LoadRc, - - %% Call it and verify result. - Term = {a, b}, - L = Mod:put_list(Term), - verify_packed_regs(L, Term, 600), + Mod = ?FUNCTION_NAME, + + %% Generate scrambled sequence. + Seq0 = [{erlang:phash2(I),I} || I <- lists:seq(0, 260)], + Seq = [I || {_,I} <- lists:sort(Seq0)], + + %% Generate a test modules that uses get_list/3 instructions + %% with high register numbers. + S0 = [begin + VarName = list_to_atom("V"++integer_to_list(V)), + {merl:var(VarName),V} + end || V <- Seq], + Vars = [V || {V,_} <- S0], + NewVars = [begin + VarName = list_to_atom("M"++integer_to_list(V)), + merl:var(VarName) + end || V <- Seq], + S = [?Q("_@Var = id(_@Value@)") || {Var,Value} <- S0], + Code = ?Q(["-module('@Mod@').\n" + "-export([f/0]).\n" + "f() ->\n" + "_@S,\n" + "_ = id(0),\n" + "L = [_@Vars],\n" + "_ = id(1),\n" + "[_@NewVars] = L,\n" %Test get_list/3. + "_ = id(2),\n" + "id([_@Vars,_@NewVars]).\n" + "id(I) -> I.\n"]), + merl:compile_and_load(Code), + CombinedSeq = Seq ++ Seq, + CombinedSeq = Mod:f(), + + %% Clean up. + true = code:delete(Mod), + false = code:purge(Mod), ok. -gen_packed_regs(0, Acc) -> - [Acc|"{A,0}].\n"]; -gen_packed_regs(N, Acc) -> - gen_packed_regs(N-1, [Acc,"{A,",integer_to_list(N)|"},\n"]). - -verify_packed_regs([], _, -1) -> ok; -verify_packed_regs([{Term, N}| T], Term, N) -> - verify_packed_regs(T, Term, N-1); -verify_packed_regs(L, Term, N) -> - ok = io:format("Expected [{~p, ~p}|T]; got\n~p\n", [Term, N, L]), - test_server:fail(). - buildo_mucho(Config) when is_list(Config) -> buildo_mucho_1(), ok. @@ -318,7 +318,7 @@ fconv(Config) when is_list(Config) -> do_fconv(Type) -> try do_fconv(Type, 1.0), - test_server:fail() + ct:fail(no_badarith) catch error:badarith -> ok @@ -346,3 +346,41 @@ do_select_val(X) -> Int when is_integer(Int) -> integer end. + +swap_temp_apply(_Config) -> + {swap_temp_applied,42} = do_swap_temp_apply(41), + not_an_integer = do_swap_temp_apply(not_an_integer), + ok. + +do_swap_temp_apply(Msg) -> + case swap_temp_apply_function(Msg) of + undefined -> Msg; + Type -> + %% The following sequence: + %% move {x,0} {x,2} + %% move {y,0} {x,0} + %% move {x,2} {y,0} + %% apply 1 + %% + %% Would be incorrectly transformed to: + %% swap {x,0} {y,0} + %% apply 1 + %% + %% ({x,1} is the module, {x,2} the function to be applied). + %% + %% If the instructions are to be transformed, the correct + %% transformation is: + %% + %% swap_temp {x,0} {y,0} {x,2} + %% apply 1 + Fields = ?MODULE:Type(Msg), + {Type,Fields} + end. + +swap_temp_apply_function(Int) when is_integer(Int) -> + swap_temp_applied; +swap_temp_apply_function(_) -> + undefined. + +swap_temp_applied(Int) -> + Int+1. |