%%
%% %CopyrightBegin%
%%
%% Copyright Ericsson AB 1999-2013. All Rights Reserved.
%%
%% 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("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([save_calls_1/1,dont_break_reductions/1]).
-export([do_bopp/1, do_bipp/0, do_bepp/0]).
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
end;
init_per_testcase(_,Config) ->
Config.
end_per_testcase(_,_Config) ->
ok.
%% 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)),
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.
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)
after 10000 ->
ok
end.
%% 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()
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 ->
ct: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,
ok.
do_bipp() ->
do_bopp(0),
do_bapp(),
?MODULE:do_bopp(0),
do_bopp(3),
apply(?MODULE, do_bepp, []).
do_bapp() ->
self() ! heffaklump.
do_bopp(T) ->
receive
X -> X
after T -> ok
end.
do_bepp() ->
ok.
is_local_function({?MODULE, _, _}) ->
true;
is_local_function({_, _, _}) ->
false;
is_local_function(_) ->
true.
% Number crunching for reds test.
carmichaels_below(N) ->
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,
X+carmichaels_below(N+2,N2).
expmod(_,E,_) when E == 0 ->
1;
expmod(Base,Exp,Mod) when (Exp rem 2) == 0 ->
X = expmod(Base,Exp div 2,Mod),
(X*X) rem Mod;
expmod(Base,Exp,Mod) ->
(Base * expmod(Base,Exp - 1,Mod)) rem Mod.
uniform(N) ->
rand:uniform(N-1).
fermat(N) ->
R = uniform(N),
expmod(R,N,N) == R.
do_fast_prime(1,_) ->
true;
do_fast_prime(_N,0) ->
true;
do_fast_prime(N,Times) ->
case fermat(N) of
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,
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
end;
expmod2(Base,Exp,Mod) ->
(Base * expmod2(Base,Exp - 1,Mod)) rem Mod.
miller_rabbin(N) ->
R = uniform(N),
expmod2(R,N,N) == R.
do_fast_prime2(1,_) ->
true;
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
end.
fast_prime2(N,T) ->
do_fast_prime2(N,T).
smallest_divisor(N) ->
find_divisor(N,2).
find_divisor(N,TD) ->
if
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.
