diff options
Diffstat (limited to 'erts/emulator/test/save_calls_SUITE.erl')
| -rw-r--r-- | erts/emulator/test/save_calls_SUITE.erl | 298 |
1 files changed, 144 insertions, 154 deletions
diff --git a/erts/emulator/test/save_calls_SUITE.erl b/erts/emulator/test/save_calls_SUITE.erl index ddf8b2d919..aae7651f6d 100644 --- a/erts/emulator/test/save_calls_SUITE.erl +++ b/erts/emulator/test/save_calls_SUITE.erl @@ -1,30 +1,28 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2013. All Rights Reserved. +%% Copyright Ericsson AB 1999-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/. -%% -%% 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. +%% 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 +%% +%% 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% %% -module(save_calls_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). --export([all/0, suite/0,groups/0, - init_per_suite/1, end_per_suite/1, - init_per_group/2,end_per_group/2, - init_per_testcase/2,end_per_testcase/2]). +-export([all/0, suite/0, init_per_testcase/2,end_per_testcase/2]). -export([save_calls_1/1,dont_break_reductions/1]). @@ -35,36 +33,21 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> [save_calls_1, dont_break_reductions]. -groups() -> - []. - -init_per_suite(Config) -> - Config. - -end_per_suite(_Config) -> - ok. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - init_per_testcase(dont_break_reductions,Config) -> %% Skip on --enable-native-libs as hipe rescedules after each %% function call. case erlang:system_info(hipe_architecture) of - undefined -> - Config; - Architecture -> - {lists, ListsBinary, _ListsFilename} = code:get_object_code(lists), - ChunkName = hipe_unified_loader:chunk_name(Architecture), - NativeChunk = beam_lib:chunks(ListsBinary, [ChunkName]), - case NativeChunk of - {ok,{_,[{_,Bin}]}} when is_binary(Bin) -> - {skip,"Does not work for --enable-native-libs"}; - {error, beam_lib, _} -> Config - end + undefined -> + Config; + Architecture -> + {lists, ListsBinary, _ListsFilename} = code:get_object_code(lists), + ChunkName = hipe_unified_loader:chunk_name(Architecture), + NativeChunk = beam_lib:chunks(ListsBinary, [ChunkName]), + case NativeChunk of + {ok,{_,[{_,Bin}]}} when is_binary(Bin) -> + {skip,"Does not work for --enable-native-libs"}; + {error, beam_lib, _} -> Config + end end; init_per_testcase(_,Config) -> Config. @@ -72,91 +55,99 @@ init_per_testcase(_,Config) -> end_per_testcase(_,_Config) -> ok. -dont_break_reductions(suite) -> - []; -dont_break_reductions(doc) -> - ["Check that save_calls dont break reduction-based scheduling"]; +%% Check that save_calls dont break reduction-based scheduling dont_break_reductions(Config) when is_list(Config) -> - ?line RPS1 = reds_per_sched(0), - ?line RPS2 = reds_per_sched(20), - ?line Diff = abs(RPS1 - RPS2), - ?line true = (Diff < (0.05 * RPS1)), + RPS1 = reds_per_sched(0), + RPS2 = reds_per_sched(20), + Diff = abs(RPS1 - RPS2), + true = (Diff < (0.2 * RPS1)), ok. reds_per_sched(SaveCalls) -> - ?line Parent = self(), - ?line HowMany = 10000, - ?line Pid = spawn(fun() -> - process_flag(save_calls,SaveCalls), - receive - go -> - carmichaels_below(HowMany), - Parent ! erlang:process_info(self(),reductions) - end - end), - ?line TH = spawn(fun() -> trace_handler(0,Parent,Pid) end), - ?line erlang:trace(Pid, true,[running,procs,{tracer,TH}]), - ?line Pid ! go, - ?line {Sched,Reds} = receive - {accumulated,X} -> - receive {reductions,Y} -> - {X,Y} - after 30000 -> - timeout - end - after 30000 -> - timeout - end, - ?line Reds div Sched. + Parent = self(), + HowMany = 10000, + Pid = spawn(fun() -> + process_flag(save_calls,SaveCalls), + receive + go -> + carmichaels_below(HowMany), + Parent ! erlang:process_info(self(),reductions) + end + end), + TH = spawn(fun() -> trace_handler(0,Parent,Pid) end), + erlang:trace(Pid, true,[running,procs,{tracer,TH}]), + Pid ! go, + {Sched,Reds} = receive + {accumulated,X} -> + receive {reductions,Y} -> + {X,Y} + after 30000 -> + timeout + end + after 30000 -> + timeout + end, + Reds div Sched. trace_handler(Acc,Parent,Client) -> receive - {trace,Client,out,_} -> - trace_handler(Acc+1,Parent,Client); - {trace,Client,exit,_} -> - Parent ! {accumulated, Acc}; - _ -> - trace_handler(Acc,Parent,Client) + {trace,Client,out,_} -> + trace_handler(Acc+1,Parent,Client); + {trace,Client,exit,_} -> + Parent ! {accumulated, Acc}; + _ -> + trace_handler(Acc,Parent,Client) after 10000 -> - ok + ok end. -save_calls_1(doc) -> "Test call saving."; +%% Test call saving. save_calls_1(Config) when is_list(Config) -> case test_server:is_native(?MODULE) of - true -> {skipped,"Native code"}; - false -> save_calls_1() + true -> {skipped,"Native code"}; + false -> save_calls_1() end. - + save_calls_1() -> - ?line erlang:process_flag(self(), save_calls, 0), - ?line {last_calls, false} = process_info(self(), last_calls), - - ?line erlang:process_flag(self(), save_calls, 10), - ?line {last_calls, _L1} = process_info(self(), last_calls), - ?line ?MODULE:do_bipp(), - ?line {last_calls, L2} = process_info(self(), last_calls), - ?line L21 = lists:filter(fun is_local_function/1, L2), - ?line case L21 of - [{?MODULE,do_bipp,0}, - timeout, - 'send', - {?MODULE,do_bopp,1}, - 'receive', - timeout, - {?MODULE,do_bepp,0}] -> - ok; - X -> - test_server:fail({l21, X}) - end, - - ?line erlang:process_flag(self(), save_calls, 10), - ?line {last_calls, L3} = process_info(self(), last_calls), - ?line L31 = lists:filter(fun is_local_function/1, L3), - ?line [] = L31, + erlang:process_flag(self(), save_calls, 0), + {last_calls, false} = process_info(self(), last_calls), + + erlang:process_flag(self(), save_calls, 10), + {last_calls, _L1} = process_info(self(), last_calls), + ?MODULE:do_bipp(), + {last_calls, L2} = process_info(self(), last_calls), + L21 = lists:filter(fun is_local_function/1, L2), + case L21 of + [{?MODULE,do_bipp,0}, + timeout, + 'send', + {?MODULE,do_bopp,1}, + 'receive', + timeout, + {?MODULE,do_bepp,0}] -> + ok; + X -> + ct:fail({l21, X}) + end, + + erlang:process_flag(self(), save_calls, 10), + {last_calls, L3} = process_info(self(), last_calls), + true = (L3 /= false), + L31 = lists:filter(fun is_local_function/1, L3), + [] = L31, + erlang:process_flag(self(), save_calls, 0), + + %% Also check that it works on another process ... + Pid = spawn(fun () -> receive after infinity -> ok end end), + erlang:process_flag(Pid, save_calls, 10), + {last_calls, L4} = process_info(Pid, last_calls), + true = (L4 /= false), + L41 = lists:filter(fun is_local_function/1, L4), + [] = L41, + exit(Pid,kill), ok. do_bipp() -> @@ -171,7 +162,7 @@ do_bapp() -> do_bopp(T) -> receive - X -> X + X -> X after T -> ok end. @@ -188,25 +179,25 @@ is_local_function(_) -> % Number crunching for reds test. carmichaels_below(N) -> - random:seed(3172,9814,20125), + rand:seed(exsplus, {3172,9814,20125}), carmichaels_below(1,N). carmichaels_below(N,N2) when N >= N2 -> 0; carmichaels_below(N,N2) -> X = case fast_prime(N,10) of - false -> 0; - true -> - case fast_prime2(N,10) of - true -> - %io:format("Prime: ~p~n",[N]), - 0; - false -> - io:format("Carmichael: ~p (dividable by ~p)~n", - [N,smallest_divisor(N)]), - 1 - end - end, + false -> 0; + true -> + case fast_prime2(N,10) of + true -> + %io:format("Prime: ~p~n",[N]), + 0; + false -> + io:format("Carmichael: ~p (dividable by ~p)~n", + [N,smallest_divisor(N)]), + 1 + end + end, X+carmichaels_below(N+2,N2). expmod(_,E,_) when E == 0 -> @@ -218,7 +209,7 @@ expmod(Base,Exp,Mod) -> (Base * expmod(Base,Exp - 1,Mod)) rem Mod. uniform(N) -> - random:uniform(N-1). + rand:uniform(N-1). fermat(N) -> R = uniform(N), @@ -230,30 +221,30 @@ do_fast_prime(_N,0) -> true; do_fast_prime(N,Times) -> case fermat(N) of - true -> - do_fast_prime(N,Times-1); - false -> - false + true -> + do_fast_prime(N,Times-1); + false -> + false end. - + fast_prime(N,T) -> do_fast_prime(N,T). expmod2(_,E,_) when E == 0 -> 1; expmod2(Base,Exp,Mod) when (Exp rem 2) == 0 -> -%% Uncomment the code below to simulate scheduling bug! -% case erlang:process_info(self(),last_calls) of -% {last_calls,false} -> ok; -% _ -> erlang:yield() -% end, + %% Uncomment the code below to simulate scheduling bug! + % case erlang:process_info(self(),last_calls) of + % {last_calls,false} -> ok; + % _ -> erlang:yield() + % end, X = expmod2(Base,Exp div 2,Mod), Y=(X*X) rem Mod, if - Y == 1, X =/= 1, X =/= (Mod - 1) -> - 0; - true -> - Y rem Mod + Y == 1, X =/= 1, X =/= (Mod - 1) -> + 0; + true -> + Y rem Mod end; expmod2(Base,Exp,Mod) -> (Base * expmod2(Base,Exp - 1,Mod)) rem Mod. @@ -268,12 +259,12 @@ do_fast_prime2(_N,0) -> true; do_fast_prime2(N,Times) -> case miller_rabbin(N) of - true -> - do_fast_prime2(N,Times-1); - false -> - false + true -> + do_fast_prime2(N,Times-1); + false -> + false end. - + fast_prime2(N,T) -> do_fast_prime2(N,T). @@ -282,17 +273,16 @@ smallest_divisor(N) -> find_divisor(N,TD) -> if - TD*TD > N -> - N; - true -> - case divides(TD,N) of - true -> - TD; - false -> - find_divisor(N,TD+1) - end + TD*TD > N -> + N; + true -> + case divides(TD,N) of + true -> + TD; + false -> + find_divisor(N,TD+1) + end end. divides(A,B) -> (B rem A) == 0. - |