aboutsummaryrefslogblamecommitdiffstats
path: root/erts/emulator/test/save_calls_SUITE.erl
blob: 3199fe9ca1d73f304cd7609eef29b8ca47ac5cdc (plain) (tree)
1
2
3
4
5


                   
                                                        
   










                                                                           





                          
                                           
 
                                                                  




                                                  
                                         
 
         
                                          
 



                                                                 










                                                                               





                              
 
                                                              
                                                     



                                  



                            























                                                                               




                                   





                                               
                  
                

        
                    

                                            

                                        
        
 
                 

                                                           
    
















                                                         
    

                                                        
                         

                                                    









                                                                













                                
              















                                     
                                          





                                       











                                                                       










                                              
                      










                         



                                     
        
 





                                              




                                                           


                                    



                                           













                                               



                                      
        
 







                        








                                        



                   
%%
%% %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, 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].

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) ->
    RPS1 = reds_per_sched(0),
    RPS2 = reds_per_sched(20),
    Diff = abs(RPS1 - RPS2),
    true = (Diff < (0.05 * RPS1)),
    ok.


reds_per_sched(SaveCalls) ->
    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)
    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() ->
    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() ->
    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.