1: %%
    2: %% %CopyrightBegin%
    3: %% 
    4: %% Copyright Ericsson AB 2004-2011. 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(old_scheduler_SUITE).
   21: 
   22: -include_lib("test_server/include/test_server.hrl").
   23: 
   24: -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, 
   25: 	 init_per_group/2,end_per_group/2, 
   26: 	 init_per_testcase/2, end_per_testcase/2]).
   27: -export([equal/1, many_low/1, few_low/1, max/1, high/1]).
   28: 
   29: -define(default_timeout, ?t:minutes(11)).
   30: 
   31: suite() -> [{ct_hooks,[ts_install_cth]}].
   32: 
   33: all() -> 
   34:     case catch erlang:system_info(modified_timing_level) of
   35: 	Level when is_integer(Level) ->
   36: 	    {skipped,
   37: 	     "Modified timing (level " ++
   38: 		 integer_to_list(Level) ++
   39: 		 ") is enabled. Testcases gets messed "
   40: 	     "up by modfied timing."};
   41: 	_ -> [equal, many_low, few_low, max, high]
   42:     end.
   43: 
   44: groups() -> 
   45:     [].
   46: 
   47: init_per_suite(Config) ->
   48:     Config.
   49: 
   50: end_per_suite(_Config) ->
   51:     ok.
   52: 
   53: init_per_group(_GroupName, Config) ->
   54:     Config.
   55: 
   56: end_per_group(_GroupName, Config) ->
   57:     Config.
   58: 
   59: 
   60: %%-----------------------------------------------------------------------------------
   61: %% TEST SUITE DESCRIPTION
   62: %%
   63: %% The test case function spawns two controlling processes: Starter and Receiver.
   64: %% Starter spawns a number of prio A and a number of prio B test processes. Each
   65: %% test process loops for a number of times, sends a report to the Receiver, then
   66: %% loops again. For each report, the Receiver increases a counter that corresponds
   67: %% to the priority of the sender. After a certain amount of time, the Receiver
   68: %% sends the collected data to the main test process and waits for the test case
   69: %% to terminate. From this data, it's possible to calculate the average run time
   70: %% relationship between the prio A and B test processes.
   71: %%
   72: %% Note that in order to be able to run tests with high or max prio test processes, 
   73: %% the main test process and the Receiver needs to run at max prio, or they will
   74: %% be starved by the test processes. The controlling processes must not wait for
   75: %% messages from a normal (or low) prio process while max or high prio test processes
   76: %% are running (which happens e.g. if an io function is called).
   77: %%-----------------------------------------------------------------------------------
   78: 
   79: init_per_testcase(_Case, Config) ->
   80:     ?line Dog = test_server:timetrap(?default_timeout),
   81:     %% main test process needs max prio
   82:     ?line Prio = process_flag(priority, max),
   83:     ?line MS = erlang:system_flag(multi_scheduling, block),
   84:     [{prio,Prio},{watchdog,Dog},{multi_scheduling, MS}|Config].
   85: 
   86: end_per_testcase(_Case, Config) ->
   87:     erlang:system_flag(multi_scheduling, unblock),
   88:     Dog=?config(watchdog, Config),
   89:     Prio=?config(prio, Config),
   90:     process_flag(priority, Prio),
   91:     test_server:timetrap_cancel(Dog),
   92:     ok.
   93: 
   94: ok(Config) when is_list(Config) ->
   95:     case ?config(multi_scheduling, Config) of
   96: 	blocked ->
   97: 	    {comment,
   98: 	     "Multi-scheduling blocked during test. This testcase was not "
   99: 	     "written to work with multiple schedulers."};
  100: 	_ -> ok
  101:     end.
  102: 
  103: %% Run equal number of low and normal prio processes.
  104: 
  105: equal(suite) -> [];
  106: equal(doc) -> [];
  107: equal(Config) when is_list(Config) ->
  108:     ?line Self = self(),
  109: 
  110:     %% specify number of test processes to run
  111:     Normal = {normal,500},
  112:     Low    = {low,500},
  113: 
  114:     %% specify time of test (in seconds)
  115:     Time = 30,
  116: 
  117:     %% start controllers
  118:     ?line Receiver = 
  119: 	spawn(fun() -> receiver(now(), Time, Self, Normal, Low) end),
  120:     ?line Starter =
  121: 	spawn(fun() -> starter(Normal, Low, Receiver) end),
  122: 
  123:     %% receive test data from Receiver
  124:     ?line {NRs,NAvg,LRs,LAvg,Ratio} = 
  125: 	receive
  126: 	    {Receiver,Res} -> Res
  127: 	end,
  128: 
  129:     %% stop controllers and test processes
  130:     ?line exit(Starter, kill),
  131:     ?line exit(Receiver, kill),
  132: 
  133:     io:format("Reports: ~w normal (~w/proc), ~w low (~w/proc). Ratio: ~w~n", 
  134: 	      [NRs,NAvg,LRs,LAvg,Ratio]),
  135: 
  136:     %% runtime ratio between normal and low should be ~8
  137:     if Ratio < 7.5 ; Ratio > 8.5 ->	
  138: 	    ?t:fail({bad_ratio,Ratio});
  139:        true ->
  140: 	    ok(Config)
  141:     end.
  142: 
  143: 
  144: %% Run many low and few normal prio processes.
  145: 
  146: many_low(suite) -> [];
  147: many_low(doc) -> [];
  148: many_low(Config) when is_list(Config) ->
  149:     ?line Self = self(),
  150:     Normal = {normal,1},
  151:     Low    = {low,1000},
  152: 
  153:     %% specify time of test (in seconds)
  154:     Time = 30,
  155: 
  156:     ?line Receiver = 
  157: 	spawn(fun() -> receiver(now(), Time, Self, Normal, Low) end),
  158:     ?line Starter =
  159: 	spawn(fun() -> starter(Normal, Low, Receiver) end),
  160:     ?line {NRs,NAvg,LRs,LAvg,Ratio} = 
  161: 	receive
  162: 	    {Receiver,Res} -> Res
  163: 	end,
  164:     ?line exit(Starter, kill),
  165:     ?line exit(Receiver, kill),
  166:     io:format("Reports: ~w normal (~w/proc), ~w low (~w/proc). Ratio: ~w~n", 
  167: 	      [NRs,NAvg,LRs,LAvg,Ratio]),
  168:     if Ratio < 7.5 ; Ratio > 8.5 ->
  169: 	    ?t:fail({bad_ratio,Ratio});
  170:        true ->
  171: 	    ok(Config)
  172:     end.
  173: 
  174: 
  175: %% Run few low and many normal prio processes.
  176: 
  177: few_low(suite) -> [];
  178: few_low(doc) -> [];
  179: few_low(Config) when is_list(Config) ->
  180:     ?line Self = self(),
  181:     Normal = {normal,1000},
  182:     Low    = {low,1},
  183: 
  184:     %% specify time of test (in seconds)
  185:     Time = 30,
  186: 
  187:     ?line Receiver = 
  188: 	spawn(fun() -> receiver(now(), Time, Self, Normal, Low) end),
  189:     ?line Starter =
  190: 	spawn(fun() -> starter(Normal, Low, Receiver) end),
  191:     ?line {NRs,NAvg,LRs,LAvg,Ratio} = 
  192: 	receive
  193: 	    {Receiver,Res} -> Res
  194: 	end,
  195:     ?line exit(Starter, kill),
  196:     ?line exit(Receiver, kill),
  197:     io:format("Reports: ~w normal (~w/proc), ~w low (~w/proc). Ratio: ~w~n", 
  198: 	      [NRs,NAvg,LRs,LAvg,Ratio]),
  199:     if Ratio < 7.0 ; Ratio > 8.5 ->
  200: 	    ?t:fail({bad_ratio,Ratio});
  201:        true ->
  202: 	    ok(Config)
  203:     end.
  204: 
  205: 
  206: %% Run max prio processes and verify they get at least as much 
  207: %% runtime as high, normal and low.
  208: 
  209: max(suite) -> [];
  210: max(doc) -> [];
  211: max(Config) when is_list(Config) ->
  212:     max = process_flag(priority, max),		% should already be max (init_per_tc)
  213:     ?line Self = self(),
  214:     Max    = {max,2},
  215:     High   = {high,2},
  216:     Normal = {normal,100},
  217:     Low    = {low,100},
  218: 
  219:     %% specify time of test (in seconds)
  220:     Time = 30,
  221: 
  222:     ?line Receiver1 = 
  223: 	spawn(fun() -> receiver(now(), Time, Self, Max, High) end),
  224:     ?line Starter1 =
  225: 	spawn(fun() -> starter(Max, High, Receiver1) end),
  226:     ?line {M1Rs,M1Avg,HRs,HAvg,Ratio1} = 
  227: 	receive
  228: 	    {Receiver1,Res1} -> Res1
  229: 	end,
  230:     ?line exit(Starter1, kill),
  231:     ?line exit(Receiver1, kill),
  232:     io:format("Reports: ~w max (~w/proc), ~w high (~w/proc). Ratio: ~w~n", 
  233: 	      [M1Rs,M1Avg,HRs,HAvg,Ratio1]),
  234:     if Ratio1 < 1.0 ->
  235: 	    ?t:fail({bad_ratio,Ratio1});
  236:        true ->
  237: 	    ok(Config)
  238:     end,
  239: 
  240:     ?line Receiver2 = 
  241: 	spawn(fun() -> receiver(now(), Time, Self, Max, Normal) end),
  242:     ?line Starter2 =
  243: 	spawn(fun() -> starter(Max, Normal, Receiver2) end),
  244:     ?line {M2Rs,M2Avg,NRs,NAvg,Ratio2} = 
  245: 	receive
  246: 	    {Receiver2,Res2} -> Res2
  247: 	end,
  248:     ?line exit(Starter2, kill),
  249:     ?line exit(Receiver2, kill),
  250:     io:format("Reports: ~w max (~w/proc), ~w normal (~w/proc). Ratio: ~w~n", 
  251: 	      [M2Rs,M2Avg,NRs,NAvg,Ratio2]),
  252:     if Ratio2 < 1.0 ->
  253: 	    ?t:fail({bad_ratio,Ratio2});
  254:        true ->
  255: 	    ok
  256:     end,
  257: 
  258:     ?line Receiver3 = 
  259: 	spawn(fun() -> receiver(now(), Time, Self, Max, Low) end),
  260:     ?line Starter3 =
  261: 	spawn(fun() -> starter(Max, Low, Receiver3) end),
  262:     ?line {M3Rs,M3Avg,LRs,LAvg,Ratio3} = 
  263: 	receive
  264: 	    {Receiver3,Res3} -> Res3
  265: 	end,
  266:     ?line exit(Starter3, kill),
  267:     ?line exit(Receiver3, kill),
  268:     io:format("Reports: ~w max (~w/proc), ~w low (~w/proc). Ratio: ~w~n", 
  269: 	      [M3Rs,M3Avg,LRs,LAvg,Ratio3]),
  270:     if Ratio3 < 1.0 ->
  271: 	    ?t:fail({bad_ratio,Ratio3});
  272:        true ->
  273: 	    ok(Config)
  274:     end.
  275: 
  276: 
  277: %% Run high prio processes and verify they get at least as much 
  278: %% runtime as normal and low.
  279: 
  280: high(suite) -> [];
  281: high(doc) -> [];
  282: high(Config) when is_list(Config) ->
  283:     max = process_flag(priority, max),		% should already be max (init_per_tc)
  284:     ?line Self = self(),
  285:     High   = {high,2},
  286:     Normal = {normal,100},
  287:     Low    = {low,100},
  288: 
  289:     %% specify time of test (in seconds)
  290:     Time = 30,
  291: 
  292:     ?line Receiver1 = 
  293: 	spawn(fun() -> receiver(now(), Time, Self, High, Normal) end),
  294:     ?line Starter1 =
  295: 	spawn(fun() -> starter(High, Normal, Receiver1) end),
  296:     ?line {H1Rs,H1Avg,NRs,NAvg,Ratio1} = 
  297: 	receive
  298: 	    {Receiver1,Res1} -> Res1
  299: 	end,
  300:     ?line exit(Starter1, kill),
  301:     ?line exit(Receiver1, kill),
  302:     io:format("Reports: ~w high (~w/proc), ~w normal (~w/proc). Ratio: ~w~n", 
  303: 	      [H1Rs,H1Avg,NRs,NAvg,Ratio1]),
  304:     if Ratio1 < 1.0 ->
  305: 	    ?t:fail({bad_ratio,Ratio1});
  306:        true ->
  307: 	    ok
  308:     end,
  309: 
  310:     ?line Receiver2 = 
  311: 	spawn(fun() -> receiver(now(), Time, Self, High, Low) end),
  312:     ?line Starter2 =
  313: 	spawn(fun() -> starter(High, Low, Receiver2) end),
  314:     ?line {H2Rs,H2Avg,LRs,LAvg,Ratio2} = 
  315: 	receive
  316: 	    {Receiver2,Res2} -> Res2
  317: 	end,
  318:     ?line exit(Starter2, kill),
  319:     ?line exit(Receiver2, kill),
  320:     io:format("Reports: ~w high (~w/proc), ~w low (~w/proc). Ratio: ~w~n", 
  321: 	      [H2Rs,H2Avg,LRs,LAvg,Ratio2]),
  322:     if Ratio2 < 1.0 ->
  323: 	    ?t:fail({bad_ratio,Ratio2});
  324:        true ->
  325: 	    ok(Config)
  326:     end.
  327: 
  328: 
  329: %%-----------------------------------------------------------------------------------
  330: %% Controller processes and help functions
  331: %%-----------------------------------------------------------------------------------
  332: 
  333: receiver(T0, TimeSec, Main, {P1,P1N}, {P2,P2N}) ->
  334:     %% prio should be max so that mailbox doesn't overflow
  335:     process_flag(priority, max),
  336:     receiver(T0, TimeSec*1000, Main, P1,P1N,0, P2,P2N,0, 100000).
  337: 
  338: %% uncomment lines below to get life sign (debug)
  339: receiver(T0, Time, Main, P1,P1N,P1Rs, P2,P2N,P2Rs, 0) ->
  340: %    T = elapsed_ms(T0, now()),
  341: %    erlang:display({round(T/1000),P1Rs,P2Rs}),
  342:     receiver(T0, Time, Main, P1,P1N,P1Rs, P2,P2N,P2Rs, 100000);
  343: 
  344: receiver(T0, Time, Main, P1,P1N,P1Rs, P2,P2N,P2Rs, C) ->
  345:     Remain = Time - elapsed_ms(T0, now()),	% test time remaining
  346:     Remain1 = if Remain < 0 ->
  347: 		      0;
  348: 		 true ->
  349: 		      Remain
  350: 	      end,
  351:     {P1Rs1,P2Rs1} = 
  352: 	receive
  353: 	    {_Pid,P1} ->			% report from a P1 process
  354: 		{P1Rs+1,P2Rs};
  355: 	    {_Pid,P2} ->			% report from a P2 process
  356: 		{P1Rs,P2Rs+1}
  357: 	after Remain1 ->
  358: 		{P1Rs,P2Rs}
  359: 	end,
  360:     if Remain > 0 ->				% keep going
  361: 	    receiver(T0, Time, Main, P1,P1N,P1Rs1, P2,P2N,P2Rs1, C-1);
  362:        true ->					% finish
  363: 	    %% calculate results and send to main test process
  364: 	    P1Avg = P1Rs1/P1N,
  365: 	    P2Avg = P2Rs1/P2N,
  366: 	    Ratio = if P2Avg < 1.0 -> P1Avg;
  367: 		       true -> P1Avg/P2Avg
  368: 		    end,
  369: 	    Main ! {self(),{P1Rs1,round(P1Avg),P2Rs1,round(P2Avg),Ratio}},
  370: 	    flush_loop()
  371:     end.
  372: 
  373: starter({P1,P1N}, {P2,P2N}, Receiver) ->
  374:     %% start N1 processes with prio P1
  375:     start_p(P1, P1N, Receiver),
  376:     %% start N2 processes with prio P2
  377:     start_p(P2, P2N, Receiver),
  378:     erlang:display({started,P1N+P2N}),
  379:     flush_loop().
  380: 
  381: start_p(_, 0, _) ->
  382:     ok;
  383: start_p(Prio, N, Receiver) ->
  384:     spawn_link(fun() -> p(Prio, Receiver) end),
  385:     start_p(Prio, N-1, Receiver).
  386: 
  387: p(Prio, Receiver) ->
  388:     %% set process priority
  389:     process_flag(priority, Prio),
  390:     p_loop(0, Prio, Receiver).
  391: 
  392: p_loop(100, Prio, Receiver) ->
  393:     receive after 0 -> ok end,
  394:     %% if Receiver gone, we're done
  395:     case is_process_alive(Receiver) of
  396: 	false -> exit(bye);
  397: 	true -> ok
  398:     end,
  399:     %% send report
  400:     Receiver ! {self(),Prio},
  401:     p_loop(0, Prio, Receiver);
  402: 
  403: p_loop(N, Prio, Receiver) ->
  404:     p_loop(N+1, Prio, Receiver).
  405:     		       
  406: 
  407: flush_loop() ->
  408:     receive _ ->
  409: 	    ok
  410:     end,
  411:     flush_loop().
  412: 
  413: elapsed_ms({_MS0,S0,MuS0},{_MS1,S1,MuS1}) ->
  414:     round(((S1-S0)*1000)+((MuS1-MuS0)/1000)).