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