1%% 2%% %CopyrightBegin% 3%% 4%% Copyright Ericsson AB 1999-2016. All Rights Reserved. 5%% 6%% Licensed under the Apache License, Version 2.0 (the "License"); 7%% you may not use this file except in compliance with the License. 8%% You may obtain a copy of the License at 9%% 10%% http://www.apache.org/licenses/LICENSE-2.0 11%% 12%% Unless required by applicable law or agreed to in writing, software 13%% distributed under the License is distributed on an "AS IS" BASIS, 14%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 15%% See the License for the specific language governing permissions and 16%% limitations under the License. 17%% 18%% %CopyrightEnd% 19%% 20 21-module(save_calls_SUITE). 22 23-include_lib("common_test/include/ct.hrl"). 24 25-export([all/0, suite/0, init_per_testcase/2,end_per_testcase/2]). 26 27-export([save_calls_1/1,dont_break_reductions/1]). 28 29-export([do_bopp/1, do_bipp/0, do_bepp/0]). 30 31suite() -> [{ct_hooks,[ts_install_cth]}]. 32 33all() -> 34 [save_calls_1, dont_break_reductions]. 35 36init_per_testcase(dont_break_reductions,Config) -> 37 %% Skip on --enable-native-libs as hipe rescedules after each 38 %% function call. 39 case erlang:system_info(hipe_architecture) of 40 undefined -> 41 Config; 42 Architecture -> 43 {lists, ListsBinary, _ListsFilename} = code:get_object_code(lists), 44 ChunkName = hipe_unified_loader:chunk_name(Architecture), 45 NativeChunk = beam_lib:chunks(ListsBinary, [ChunkName]), 46 case NativeChunk of 47 {ok,{_,[{_,Bin}]}} when is_binary(Bin) -> 48 {skip,"Does not work for --enable-native-libs"}; 49 {error, beam_lib, _} -> Config 50 end 51 end; 52init_per_testcase(_,Config) -> 53 Config. 54 55end_per_testcase(_,_Config) -> 56 ok. 57 58%% Check that save_calls dont break reduction-based scheduling 59dont_break_reductions(Config) when is_list(Config) -> 60 RPS1 = reds_per_sched(0), 61 RPS2 = reds_per_sched(20), 62 Diff = abs(RPS1 - RPS2), 63 true = (Diff < (0.2 * RPS1)), 64 ok. 65 66 67reds_per_sched(SaveCalls) -> 68 Parent = self(), 69 HowMany = 10000, 70 Pid = spawn(fun() -> 71 process_flag(save_calls,SaveCalls), 72 receive 73 go -> 74 carmichaels_below(HowMany), 75 Parent ! erlang:process_info(self(),reductions) 76 end 77 end), 78 TH = spawn(fun() -> trace_handler(0,Parent,Pid) end), 79 erlang:trace(Pid, true,[running,procs,{tracer,TH}]), 80 Pid ! go, 81 {Sched,Reds} = receive 82 {accumulated,X} -> 83 receive {reductions,Y} -> 84 {X,Y} 85 after 30000 -> 86 timeout 87 end 88 after 30000 -> 89 timeout 90 end, 91 Reds div Sched. 92 93 94 95trace_handler(Acc,Parent,Client) -> 96 receive 97 {trace,Client,out,_} -> 98 trace_handler(Acc+1,Parent,Client); 99 {trace,Client,exit,_} -> 100 Parent ! {accumulated, Acc}; 101 _ -> 102 trace_handler(Acc,Parent,Client) 103 after 10000 -> 104 ok 105 end. 106 107%% Test call saving. 108save_calls_1(Config) when is_list(Config) -> 109 case test_server:is_native(?MODULE) of 110 true -> {skipped,"Native code"}; 111 false -> save_calls_1() 112 end. 113 114save_calls_1() -> 115 erlang:process_flag(self(), save_calls, 0), 116 {last_calls, false} = process_info(self(), last_calls), 117 118 erlang:process_flag(self(), save_calls, 10), 119 {last_calls, _L1} = process_info(self(), last_calls), 120 ?MODULE:do_bipp(), 121 {last_calls, L2} = process_info(self(), last_calls), 122 L21 = lists:filter(fun is_local_function/1, L2), 123 case L21 of 124 [{?MODULE,do_bipp,0}, 125 timeout, 126 'send', 127 {?MODULE,do_bopp,1}, 128 'receive', 129 timeout, 130 {?MODULE,do_bepp,0}] -> 131 ok; 132 X -> 133 ct:fail({l21, X}) 134 end, 135 136 erlang:process_flag(self(), save_calls, 10), 137 {last_calls, L3} = process_info(self(), last_calls), 138 true = (L3 /= false), 139 L31 = lists:filter(fun is_local_function/1, L3), 140 [] = L31, 141 erlang:process_flag(self(), save_calls, 0), 142 143 %% Also check that it works on another process ... 144 Pid = spawn(fun () -> receive after infinity -> ok end end), 145 erlang:process_flag(Pid, save_calls, 10), 146 {last_calls, L4} = process_info(Pid, last_calls), 147 true = (L4 /= false), 148 L41 = lists:filter(fun is_local_function/1, L4), 149 [] = L41, 150 exit(Pid,kill), 151 ok. 152 153do_bipp() -> 154 do_bopp(0), 155 do_bapp(), 156 ?MODULE:do_bopp(0), 157 do_bopp(3), 158 apply(?MODULE, do_bepp, []). 159 160do_bapp() -> 161 self() ! heffaklump. 162 163do_bopp(T) -> 164 receive 165 X -> X 166 after T -> ok 167 end. 168 169do_bepp() -> 170 ok. 171 172is_local_function({?MODULE, _, _}) -> 173 true; 174is_local_function({_, _, _}) -> 175 false; 176is_local_function(_) -> 177 true. 178 179 180% Number crunching for reds test. 181carmichaels_below(N) -> 182 rand:seed(exsplus, {3172,9814,20125}), 183 carmichaels_below(1,N). 184 185carmichaels_below(N,N2) when N >= N2 -> 186 0; 187carmichaels_below(N,N2) -> 188 X = case fast_prime(N,10) of 189 false -> 0; 190 true -> 191 case fast_prime2(N,10) of 192 true -> 193 %io:format("Prime: ~p~n",[N]), 194 0; 195 false -> 196 io:format("Carmichael: ~p (dividable by ~p)~n", 197 [N,smallest_divisor(N)]), 198 1 199 end 200 end, 201 X+carmichaels_below(N+2,N2). 202 203expmod(_,E,_) when E == 0 -> 204 1; 205expmod(Base,Exp,Mod) when (Exp rem 2) == 0 -> 206 X = expmod(Base,Exp div 2,Mod), 207 (X*X) rem Mod; 208expmod(Base,Exp,Mod) -> 209 (Base * expmod(Base,Exp - 1,Mod)) rem Mod. 210 211uniform(N) -> 212 rand:uniform(N-1). 213 214fermat(N) -> 215 R = uniform(N), 216 expmod(R,N,N) == R. 217 218do_fast_prime(1,_) -> 219 true; 220do_fast_prime(_N,0) -> 221 true; 222do_fast_prime(N,Times) -> 223 case fermat(N) of 224 true -> 225 do_fast_prime(N,Times-1); 226 false -> 227 false 228 end. 229 230fast_prime(N,T) -> 231 do_fast_prime(N,T). 232 233expmod2(_,E,_) when E == 0 -> 234 1; 235expmod2(Base,Exp,Mod) when (Exp rem 2) == 0 -> 236 %% Uncomment the code below to simulate scheduling bug! 237 % case erlang:process_info(self(),last_calls) of 238 % {last_calls,false} -> ok; 239 % _ -> erlang:yield() 240 % end, 241 X = expmod2(Base,Exp div 2,Mod), 242 Y=(X*X) rem Mod, 243 if 244 Y == 1, X =/= 1, X =/= (Mod - 1) -> 245 0; 246 true -> 247 Y rem Mod 248 end; 249expmod2(Base,Exp,Mod) -> 250 (Base * expmod2(Base,Exp - 1,Mod)) rem Mod. 251 252miller_rabbin(N) -> 253 R = uniform(N), 254 expmod2(R,N,N) == R. 255 256do_fast_prime2(1,_) -> 257 true; 258do_fast_prime2(_N,0) -> 259 true; 260do_fast_prime2(N,Times) -> 261 case miller_rabbin(N) of 262 true -> 263 do_fast_prime2(N,Times-1); 264 false -> 265 false 266 end. 267 268fast_prime2(N,T) -> 269 do_fast_prime2(N,T). 270 271smallest_divisor(N) -> 272 find_divisor(N,2). 273 274find_divisor(N,TD) -> 275 if 276 TD*TD > N -> 277 N; 278 true -> 279 case divides(TD,N) of 280 true -> 281 TD; 282 false -> 283 find_divisor(N,TD+1) 284 end 285 end. 286 287divides(A,B) -> 288 (B rem A) == 0. 289