1: %%
    2: %% %CopyrightBegin%
    3: %%
    4: %% Copyright Ericsson AB 1997-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(trace_SUITE).
   21: 
   22: %%%
   23: %%% Tests the trace BIF.
   24: %%%
   25: 
   26: -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, 
   27: 	 init_per_group/2,end_per_group/2, receive_trace/1, self_send/1,
   28: 	 timeout_trace/1, send_trace/1,
   29: 	 procs_trace/1, dist_procs_trace/1,
   30: 	 suspend/1, mutual_suspend/1, suspend_exit/1, suspender_exit/1,
   31: 	 suspend_system_limit/1, suspend_opts/1, suspend_waiting/1,
   32: 	 new_clear/1, existing_clear/1,
   33: 	 set_on_spawn/1, set_on_first_spawn/1, cpu_timestamp/1,
   34: 	 system_monitor_args/1, more_system_monitor_args/1,
   35: 	 system_monitor_long_gc_1/1, system_monitor_long_gc_2/1, 
   36: 	 system_monitor_large_heap_1/1, system_monitor_large_heap_2/1,
   37: 	 system_monitor_long_schedule/1,
   38: 	 bad_flag/1, trace_delivered/1]).
   39: 
   40: -include_lib("test_server/include/test_server.hrl").
   41: 
   42: %%% Internal exports
   43: -export([process/1]).
   44: 
   45: suite() -> [{ct_hooks,[ts_install_cth]}].
   46: 
   47: all() -> 
   48:     [cpu_timestamp, receive_trace, self_send, timeout_trace,
   49:      send_trace, procs_trace, dist_procs_trace, suspend,
   50:      mutual_suspend, suspend_exit, suspender_exit,
   51:      suspend_system_limit, suspend_opts, suspend_waiting,
   52:      new_clear, existing_clear, set_on_spawn,
   53:      set_on_first_spawn, system_monitor_args,
   54:      more_system_monitor_args, system_monitor_long_gc_1,
   55:      system_monitor_long_gc_2, system_monitor_large_heap_1,
   56:       system_monitor_long_schedule,
   57:      system_monitor_large_heap_2, bad_flag, trace_delivered].
   58: 
   59: groups() -> 
   60:     [].
   61: 
   62: init_per_suite(Config) ->
   63:     Config.
   64: 
   65: end_per_suite(_Config) ->
   66:     ok.
   67: 
   68: init_per_group(_GroupName, Config) ->
   69:     Config.
   70: 
   71: end_per_group(_GroupName, Config) ->
   72:     Config.
   73: 
   74: 
   75: 
   76: %% No longer testing anything, just reporting whether cpu_timestamp
   77: %% is enabled or not.
   78: cpu_timestamp(Config) when is_list(Config) ->
   79:     ?line Dog = test_server:timetrap(test_server:seconds(5)),
   80: 
   81:     %% Test whether cpu_timestamp is implemented on this platform.
   82:     ?line Works = try erlang:trace(all, true, [cpu_timestamp]) of
   83: 		      _ ->
   84: 			  ?line erlang:trace(all, false, [cpu_timestamp]),
   85: 			  true
   86: 		  catch
   87: 		      error:badarg -> false
   88: 		  end,
   89: 
   90:     ?line test_server:timetrap_cancel(Dog),
   91:     {comment,case Works of
   92: 		 false -> "cpu_timestamp is NOT implemented/does not work";
   93: 		 true -> "cpu_timestamp works"
   94: 	     end}.
   95: 
   96: 
   97: %% Tests that trace(Pid, How, ['receive']) works.
   98: 
   99: receive_trace(Config) when is_list(Config) ->
  100:     ?line Dog = test_server:timetrap(test_server:seconds(5)),
  101:     ?line Receiver = fun_spawn(fun receiver/0),
  102:     ?line process_flag(trap_exit, true),
  103: 
  104:     %% Trace the process; make sure that we receive the trace messages.
  105:     ?line 1 = erlang:trace(Receiver, true, ['receive']),
  106:     ?line Hello = {hello, world},
  107:     ?line Receiver ! Hello,
  108:     ?line {trace, Receiver, 'receive', Hello} = receive_first(),
  109:     ?line Hello2 = {hello, again, world},
  110:     ?line Receiver ! Hello2,
  111:     ?line {trace, Receiver, 'receive', Hello2} = receive_first(),
  112:     ?line receive_nothing(),
  113: 
  114:     %% Another process should not be able to trace Receiver.
  115:     ?line Intruder = fun_spawn(fun() -> erlang:trace(Receiver, true, ['receive']) end),
  116:     ?line {'EXIT', Intruder, {badarg, _}} = receive_first(),
  117: 
  118:     %% Untrace the process; we should not receive anything.
  119:     ?line 1 = erlang:trace(Receiver, false, ['receive']),
  120:     ?line Receiver ! {hello, there},
  121:     ?line Receiver ! any_garbage,
  122:     ?line receive_nothing(),
  123: 
  124:     %% Done.
  125:     ?line test_server:timetrap_cancel(Dog),
  126:     ok.
  127: 
  128: self_send(doc) -> ["Test that traces are generated for messages sent ",
  129: 		    "and received to/from self()."];
  130: self_send(Config) when is_list(Config) ->
  131:     ?line Dog = test_server:timetrap(test_server:seconds(5)),
  132:     ?line Fun =
  133: 	fun(Self, Parent) -> receive
  134: 			   go_ahead ->
  135: 				     self() ! from_myself,
  136: 				     Self(Self, Parent);
  137: 			   from_myself ->
  138: 				     Parent ! done
  139: 		       end
  140: 	end,
  141:     ?line Self = self(),
  142:     ?line SelfSender = fun_spawn(Fun, [Fun, Self]),
  143:     ?line erlang:trace(SelfSender, true, ['receive', 'send']),
  144:     ?line SelfSender ! go_ahead,
  145:     ?line receive {trace, SelfSender, 'receive', go_ahead} -> ok end,
  146:     ?line receive {trace, SelfSender, 'receive', from_myself} -> ok end,
  147:     ?line receive
  148: 	      {trace,SelfSender,send,from_myself,SelfSender} -> ok
  149: 	  end,
  150:     ?line receive {trace,SelfSender,send,done,Self} -> ok end,
  151:     ?line receive done -> ok end,
  152: 
  153:     ?line test_server:timetrap_cancel(Dog),
  154:     ok.
  155: 
  156: %% Test that we can receive timeout traces.
  157: timeout_trace(Config) when is_list(Config) ->
  158:     ?line Dog = test_server:timetrap(test_server:seconds(5)),
  159: 
  160:     ?line Process = fun_spawn(fun process/0),
  161:     ?line 1 = erlang:trace(Process, true, ['receive']),
  162:     ?line Process ! timeout_please,
  163:     ?line {trace, Process, 'receive', timeout_please} = receive_first(),
  164:     ?line {trace, Process, 'receive', timeout} = receive_first(),
  165:     ?line receive_nothing(),
  166: 
  167:     ?line test_server:timetrap_cancel(Dog),
  168:     ok.
  169: 
  170: %% Tests that trace(Pid, How, [send]) works.
  171: 
  172: send_trace(Config) when is_list(Config) ->
  173:     ?line Dog = test_server:timetrap(test_server:seconds(5)),
  174:     ?line process_flag(trap_exit, true),
  175:     ?line Sender = fun_spawn(fun sender/0),
  176:     ?line Receiver = fun_spawn(fun receiver/0),
  177: 
  178:     %% Check that a message sent to another process is traced.
  179:     ?line 1 = erlang:trace(Sender, true, [send]),
  180:     ?line Sender ! {send_please, Receiver, to_receiver},
  181:     ?line {trace, Sender, send, to_receiver, Receiver} = receive_first(),
  182:     ?line receive_nothing(),
  183: 
  184:     %% Check that a message sent to this process is traced.
  185:     ?line Sender ! {send_please, self(), to_myself},
  186:     ?line receive to_myself -> ok end,
  187:     ?line Self = self(),
  188:     ?line {trace, Sender, send, to_myself, Self} = receive_first(),
  189:     ?line receive_nothing(),
  190: 
  191:     %% Another process should not be able to trace Sender.
  192:     ?line Intruder = fun_spawn(fun() -> erlang:trace(Sender, true, [send]) end),
  193:     ?line {'EXIT', Intruder, {badarg, _}} = receive_first(),
  194: 
  195:     %% Untrace the sender process and make sure that we receive no more
  196:     %% trace messages.
  197:     ?line 1 = erlang:trace(Sender, false, [send]),
  198:     ?line Sender ! {send_please, Receiver, to_receiver},
  199:     ?line Sender ! {send_please, self(), to_myself_again},
  200:     ?line receive to_myself_again -> ok end,
  201:     ?line receive_nothing(),
  202:     
  203:     %% Done.
  204:     ?line test_server:timetrap_cancel(Dog),
  205:     ok.
  206: 
  207: %% Test trace(Pid, How, [procs]).
  208: procs_trace(Config) when is_list(Config) ->
  209:     ?line Dog = test_server:timetrap(test_server:seconds(5)),
  210:     ?line Name = list_to_atom(atom_to_list(?MODULE)++"_procs_trace"),
  211:     ?line Self = self(),
  212:     ?line process_flag(trap_exit, true),
  213:     %%
  214:     ?line Proc1 = spawn_link(?MODULE, process, [Self]),
  215:     ?line io:format("Proc1 = ~p ~n", [Proc1]),
  216:     ?line Proc2 = spawn(?MODULE, process, [Self]),
  217:     ?line io:format("Proc2 = ~p ~n", [Proc2]),
  218:     %%
  219:     ?line 1 = erlang:trace(Proc1, true, [procs]),
  220:     ?line MFA = {?MODULE, process, [Self]},
  221:     %%
  222:     %% spawn, link
  223:     ?line Proc1 ! {spawn_link_please, Self, MFA},
  224:     ?line Proc3 = receive {spawned, Proc1, P3} -> P3 end,
  225:     ?line {trace, Proc1, spawn, Proc3, MFA} = receive_first(),
  226:     ?line io:format("Proc3 = ~p ~n", [Proc3]),
  227:     ?line {trace, Proc1, link, Proc3} = receive_first(),
  228:     ?line receive_nothing(),
  229:     %%
  230:     %% getting_unlinked by exit()
  231:     ?line Proc1 ! {trap_exit_please, true},
  232:     ?line Reason3 = make_ref(),
  233:     ?line Proc1 ! {send_please, Proc3, {exit_please, Reason3}},
  234:     ?line receive {Proc1, {'EXIT', Proc3, Reason3}} -> ok end,
  235:     ?line {trace, Proc1, getting_unlinked, Proc3} = receive_first(),
  236:     ?line Proc1 ! {trap_exit_please, false},
  237:     ?line receive_nothing(),
  238:     %%
  239:     %% link
  240:     ?line Proc1 ! {link_please, Proc2},
  241:     ?line {trace, Proc1, link, Proc2} = receive_first(),
  242:     ?line receive_nothing(),
  243:     %%
  244:     %% unlink
  245:     ?line Proc1 ! {unlink_please, Proc2},
  246:     ?line {trace, Proc1, unlink, Proc2} = receive_first(),
  247:     ?line receive_nothing(),
  248:     %%
  249:     %% getting_linked
  250:     ?line Proc2 ! {link_please, Proc1},
  251:     ?line {trace, Proc1, getting_linked, Proc2} = receive_first(),
  252:     ?line receive_nothing(),
  253:     %%
  254:     %% getting_unlinked
  255:     ?line Proc2 ! {unlink_please, Proc1},
  256:     ?line {trace, Proc1, getting_unlinked, Proc2} = receive_first(),
  257:     ?line receive_nothing(),
  258:     %%
  259:     %% register
  260:     ?line true = register(Name, Proc1),
  261:     ?line {trace, Proc1, register, Name} = receive_first(),
  262:     ?line receive_nothing(),
  263:     %%
  264:     %% unregister
  265:     ?line true = unregister(Name),
  266:     ?line {trace, Proc1, unregister, Name} = receive_first(),
  267:     ?line receive_nothing(),
  268:     %%
  269:     %% exit (with registered name, due to link)
  270:     ?line Reason4 = make_ref(),
  271:     ?line Proc1 ! {spawn_link_please, Self, MFA},
  272:     ?line Proc4 = receive {spawned, Proc1, P4} -> P4 end,
  273:     ?line {trace, Proc1, spawn, Proc4, MFA} = receive_first(),
  274:     ?line io:format("Proc4 = ~p ~n", [Proc4]),
  275:     ?line {trace, Proc1, link, Proc4} = receive_first(),
  276:     ?line Proc1 ! {register_please, Name, Proc1},
  277:     ?line {trace, Proc1, register, Name} = receive_first(),
  278:     ?line Proc4 ! {exit_please, Reason4},
  279:     ?line receive {'EXIT', Proc1, Reason4} -> ok end,
  280:     ?line {trace, Proc1, exit, Reason4} = receive_first(),
  281:     ?line {trace, Proc1, unregister, Name} = receive_first(),
  282:     ?line receive_nothing(),
  283:     %%
  284:     %% exit (not linked to tracing process)
  285:     ?line 1 = erlang:trace(Proc2, true, [procs]),
  286:     ?line Reason2 = make_ref(),
  287:     ?line Proc2 ! {exit_please, Reason2},
  288:     ?line {trace, Proc2, exit, Reason2} = receive_first(),
  289:     ?line receive_nothing(),
  290:     %%
  291:     %% Done.
  292:     ?line test_server:timetrap_cancel(Dog),
  293:     ok.
  294: 
  295: 
  296: dist_procs_trace(Config) when is_list(Config) ->
  297:     ?line Dog = test_server:timetrap(test_server:seconds(15)),
  298:     ?line OtherName = atom_to_list(?MODULE)++"_dist_procs_trace",
  299:     ?line {ok, OtherNode} = start_node(OtherName),
  300:     ?line Self = self(),
  301:     ?line process_flag(trap_exit, true),
  302:     %%
  303:     ?line Proc1 = spawn_link(?MODULE, process, [Self]),
  304:     ?line io:format("Proc1 = ~p ~n", [Proc1]),
  305:     ?line Proc2 = spawn(OtherNode, ?MODULE, process, [Self]),
  306:     ?line io:format("Proc2 = ~p ~n", [Proc2]),
  307:     %%
  308:     ?line 1 = erlang:trace(Proc1, true, [procs]),
  309:     ?line MFA = {?MODULE, process, [Self]},
  310:     %%
  311:     %% getting_unlinked by exit()
  312:     ?line Proc1 ! {spawn_link_please, Self, OtherNode, MFA},
  313:     ?line Proc1 ! {trap_exit_please, true},
  314:     ?line Proc3 = receive {spawned, Proc1, P3} -> P3 end,
  315:     ?line io:format("Proc3 = ~p ~n", [Proc3]),
  316:     ?line {trace, Proc1, getting_linked, Proc3} = receive_first(),
  317:     ?line Reason3 = make_ref(),
  318:     ?line Proc1 ! {send_please, Proc3, {exit_please, Reason3}},
  319:     ?line receive {Proc1, {'EXIT', Proc3, Reason3}} -> ok end,
  320:     ?line {trace, Proc1, getting_unlinked, Proc3} = receive_first(),
  321:     ?line Proc1 ! {trap_exit_please, false},
  322:     ?line receive_nothing(),
  323:     %%
  324:     %% link
  325:     ?line Proc1 ! {link_please, Proc2},
  326:     ?line {trace, Proc1, link, Proc2} = receive_first(),
  327:     ?line receive_nothing(),
  328:     %%
  329:     %% unlink
  330:     ?line Proc1 ! {unlink_please, Proc2},
  331:     ?line {trace, Proc1, unlink, Proc2} = receive_first(),
  332:     ?line receive_nothing(),
  333:     %%
  334:     %% getting_linked
  335:     ?line Proc2 ! {link_please, Proc1},
  336:     ?line {trace, Proc1, getting_linked, Proc2} = receive_first(),
  337:     ?line receive_nothing(),
  338:     %%
  339:     %% getting_unlinked
  340:     ?line Proc2 ! {unlink_please, Proc1},
  341:     ?line {trace, Proc1, getting_unlinked, Proc2} = receive_first(),
  342:     ?line receive_nothing(),
  343:     %%
  344:     %% exit (with registered name, due to link)
  345:     ?line Name = list_to_atom(OtherName),
  346:     ?line Reason2 = make_ref(),
  347:     ?line Proc1 ! {link_please, Proc2},
  348:     ?line {trace, Proc1, link, Proc2} = receive_first(),
  349:     ?line Proc1 ! {register_please, Name, Proc1},
  350:     ?line {trace, Proc1, register, Name} = receive_first(),
  351:     ?line Proc2 ! {exit_please, Reason2},
  352:     ?line receive {'EXIT', Proc1, Reason2} -> ok end,
  353:     ?line {trace, Proc1, exit, Reason2} = receive_first(),
  354:     ?line {trace, Proc1, unregister, Name} = receive_first(),
  355:     ?line receive_nothing(),
  356:     %%
  357:     %% Done.
  358:     ?line true = stop_node(OtherNode),
  359:     ?line test_server:timetrap_cancel(Dog),
  360:     ok.
  361: 
  362: 
  363: 
  364: 
  365: %% Tests trace(Pid, How, [set_on_spawn]).
  366: 
  367: set_on_spawn(Config) when is_list(Config) ->
  368:     ?line Dog = test_server:timetrap(test_server:seconds(5)),
  369:     ?line Listener = fun_spawn(fun process/0),
  370: 
  371:     %% Create and trace a process with the set_on_spawn flag.
  372:     %% Make sure it is traced.
  373:     ?line Father_SOS = fun_spawn(fun process/0),
  374:     ?line 1 = erlang:trace(Father_SOS, true, [send, set_on_spawn]),
  375:     ?line true = is_send_traced(Father_SOS, Listener, sos_father),
  376: 
  377:     %% Have the process spawn of two children and test that they
  378:     %% are traced.
  379:     ?line [Child1, Child2] = spawn_children(Father_SOS, 2),
  380:     ?line true = is_send_traced(Child1, Listener, child1),
  381:     ?line true = is_send_traced(Child2, Listener, child2),
  382: 
  383:     %% Second generation.
  384:     [Child11, Child12] = spawn_children(Child1, 2),
  385:     ?line true = is_send_traced(Child11, Listener, child11),
  386:     ?line true = is_send_traced(Child12, Listener, child12),
  387: 
  388:     %% Done.
  389:     ?line test_server:timetrap_cancel(Dog),
  390:     ok.
  391: 
  392: %% Tests trace(Pid, How, [set_on_first_spawn]).
  393: 
  394: set_on_first_spawn(Config) when is_list(Config) ->
  395:     ?line Dog = test_server:timetrap(test_server:seconds(10)),
  396:     ?line Listener = fun_spawn(fun process/0),
  397: 
  398:     %% Create and trace a process with the set_on_first_spawn flag.
  399:     %% Make sure it is traced.
  400:     ?line Parent = fun_spawn(fun process/0),
  401:     ?line 1 = erlang:trace(Parent, true, [send, set_on_first_spawn]),
  402:     ?line is_send_traced(Parent, Listener, sos_father),
  403: 
  404:     %% Have the process spawn off three children and test that the
  405:     %% first is traced.
  406:     ?line [Child1, Child2, Child3] = spawn_children(Parent, 3),
  407:     ?line true = is_send_traced(Child1, Listener, child1),
  408:     ?line false = is_send_traced(Child2, Listener, child2),
  409:     ?line false = is_send_traced(Child3, Listener, child3),
  410:     ?line receive_nothing(),
  411: 
  412:     %% Done.
  413:     ?line test_server:timetrap_cancel(Dog),
  414:     ok.
  415: 
  416: 
  417: system_monitor_args(doc) ->
  418:     ["Tests arguments to erlang:system_monitor/0-2)"];
  419: system_monitor_args(Config) when is_list(Config) ->
  420:     ?line Dog = test_server:timetrap(test_server:seconds(5)),
  421:     ?line Self = self(),
  422:     %%
  423:     ?line OldMonitor = erlang:system_monitor(undefined),
  424:     ?line undefined = erlang:system_monitor(Self, [{long_gc,0}]),
  425:     ?line MinT = case erlang:system_monitor() of
  426: 		     {Self,[{long_gc,T}]} when is_integer(T), T > 0 -> T;
  427: 		     Other1 -> test_server:fault(Other1)
  428: 		 end,
  429:     ?line {Self,[{long_gc,MinT}]} = erlang:system_monitor(),
  430:     ?line {Self,[{long_gc,MinT}]} = 
  431: 	erlang:system_monitor({Self,[{large_heap,0}]}),
  432:     ?line MinN = case erlang:system_monitor() of
  433: 		  {Self,[{large_heap,N}]} when is_integer(N), N > 0 -> N;
  434: 		  Other2 -> test_server:fault(Other2)
  435: 	      end,
  436:     ?line {Self,[{large_heap,MinN}]} = erlang:system_monitor(),
  437:     ?line {Self,[{large_heap,MinN}]} = 
  438: 	erlang:system_monitor(Self, [busy_port]),
  439:     ?line {Self,[busy_port]} = erlang:system_monitor(),
  440:     ?line {Self,[busy_port]} = 
  441: 	erlang:system_monitor({Self,[busy_dist_port]}),
  442:     ?line {Self,[busy_dist_port]} = erlang:system_monitor(),
  443:     ?line All = lists:sort([busy_port,busy_dist_port,
  444: 			    {long_gc,1},{large_heap,65535}]),
  445:     ?line {Self,[busy_dist_port]} = erlang:system_monitor(Self, All),
  446:     ?line {Self,A1} = erlang:system_monitor(),
  447:     ?line All = lists:sort(A1),
  448:     ?line {Self,A1} = erlang:system_monitor(Self, []),
  449:     ?line Pid = spawn(fun () -> receive {Self,die} -> exit(die) end end),
  450:     ?line Mref = erlang:monitor(process, Pid),
  451:     ?line undefined = erlang:system_monitor(Pid, All),
  452:     ?line {Pid,A2} = erlang:system_monitor(),
  453:     ?line All = lists:sort(A2),
  454:     ?line Pid ! {Self,die},
  455:     ?line receive {'DOWN',Mref,_,_,_} -> ok end,
  456:     ?line undefined = erlang:system_monitor(OldMonitor),
  457:     ?line erlang:yield(),
  458:     ?line OldMonitor = erlang:system_monitor(),
  459:     %%
  460:     ?line {'EXIT',{badarg,_}} = (catch erlang:system_monitor(atom)),
  461:     ?line {'EXIT',{badarg,_}} = (catch erlang:system_monitor({})),
  462:     ?line {'EXIT',{badarg,_}} = (catch erlang:system_monitor({1})),
  463:     ?line {'EXIT',{badarg,_}} = (catch erlang:system_monitor({1,2,3})),
  464:     ?line {'EXIT',{badarg,_}} = 
  465: 	(catch erlang:system_monitor({Self,atom})),
  466:     ?line {'EXIT',{badarg,_}} = 
  467: 	(catch erlang:system_monitor(atom, atom)),
  468:     ?line {'EXIT',{badarg,_}} = 
  469: 	(catch erlang:system_monitor({Self,[busy_port|busy_dist_port]})),
  470:     ?line {'EXIT',{badarg,_}} = 
  471: 	(catch erlang:system_monitor(Self, [{long_gc,-1}])),
  472:     ?line {'EXIT',{badarg,_}} = 
  473: 	(catch erlang:system_monitor({Self,[{long_gc,atom}]})),
  474:     ?line {'EXIT',{badarg,_}} = 
  475: 	(catch erlang:system_monitor(Self,[{large_heap,-1}])),
  476:     ?line {'EXIT',{badarg,_}} = 
  477: 	(catch erlang:system_monitor({Self,[{large_heap,atom}]})),
  478:     %% Done.
  479:     ?line test_server:timetrap_cancel(Dog),
  480:     ok.
  481: 
  482: 
  483: more_system_monitor_args(doc) ->
  484:     ["Tests arguments to erlang:system_monitor/0-2)"];
  485: more_system_monitor_args(Config) when is_list(Config) ->
  486:     ?line Dog = test_server:timetrap(test_server:seconds(5)),
  487:     
  488:     ?line try_l(64000),
  489:     ?line try_l(16#7ffffff),
  490:     ?line try_l(16#3fffffff),
  491:     ?line try_l(16#7fffffff),
  492:     ?line try_l(16#ffffffff),
  493: 
  494:     %% Done.
  495:     ?line test_server:timetrap_cancel(Dog),
  496:     ok.
  497: 
  498: try_l(Val) ->
  499:     Self = self(),
  500:     Arbitrary1 = 77777,
  501:     Arbitrary2 = 88888,
  502: 
  503:     ?line erlang:system_monitor(undefined),
  504: 
  505:     ?line undefined = erlang:system_monitor(Self, [{long_gc,Val},{large_heap,Arbitrary1}]),
  506: 
  507:     ?line {Self,Comb0} = erlang:system_monitor(Self, [{long_gc,Arbitrary2},{large_heap,Val}]),
  508:     ?line [{large_heap,Arbitrary1},{long_gc,Val}] = lists:sort(Comb0),
  509: 
  510:     ?line {Self,Comb1} = erlang:system_monitor(undefined),
  511:     ?line [{large_heap,Val},{long_gc,Arbitrary2}] = lists:sort(Comb1).
  512: 
  513: monitor_sys(Parent) ->
  514:     receive 
  515: 	{monitor,Pid,long_schedule,Data} when is_pid(Pid) -> 
  516: 	    io:format("Long schedule of ~w: ~w~n",[Pid,Data]),
  517: 	    Parent ! {Pid,Data},
  518: 	    monitor_sys(Parent);
  519: 	{monitor,Port,long_schedule,Data} when is_port(Port) -> 
  520: 	    {name,Name} = erlang:port_info(Port,name),
  521: 	    io:format("Long schedule of ~w (~p): ~w~n",[Port,Name,Data]),
  522: 	    Parent ! {Port,Data},
  523: 	    monitor_sys(Parent);
  524: 	Other ->
  525: 	    erlang:display(Other)
  526:     end.
  527: 
  528: start_monitor() ->
  529:     Parent = self(),
  530:     Mpid = spawn_link(fun() -> monitor_sys(Parent) end),
  531:     erlang:system_monitor(Mpid,[{long_schedule,100}]),
  532:     erlang:yield(), % Need to be rescheduled for the trace to take
  533:     ok.
  534: 
  535: system_monitor_long_schedule(suite) ->
  536:     [];
  537: system_monitor_long_schedule(doc) ->
  538:     ["Tests erlang:system_monitor(Pid, [{long_schedule,Time}])"];
  539: system_monitor_long_schedule(Config) when is_list(Config) ->
  540:     Path = ?config(data_dir, Config),
  541:     erl_ddll:start(),
  542:     case (catch load_driver(Path, slow_drv)) of
  543: 	ok ->
  544: 	    do_system_monitor_long_schedule();
  545: 	_Error ->
  546: 	    {skip, "Unable to load slow_drv (windows or no usleep()?)"}
  547:     end.
  548: do_system_monitor_long_schedule() ->
  549:     start_monitor(),
  550:     Port = open_port({spawn_driver,slow_drv}, []),
  551:     "ok" = erlang:port_control(Port,0,[]),
  552:     Self = self(),
  553:     receive
  554: 	{Self,L} when is_list(L) ->
  555: 	    ok
  556:     after 1000 ->
  557: 	    ?t:fail(no_trace_of_pid)
  558:     end,
  559:     "ok" = erlang:port_control(Port,1,[]),
  560:     "ok" = erlang:port_control(Port,2,[]),
  561:     receive
  562: 	{Port,LL} when is_list(LL) ->
  563: 	    ok
  564:     after 1000 ->
  565: 	    ?t:fail(no_trace_of_port)
  566:     end,
  567:     port_close(Port),
  568:     erlang:system_monitor(undefined),
  569:     ok.
  570: 
  571: 
  572: -define(LONG_GC_SLEEP, 670).
  573: 
  574: system_monitor_long_gc_1(suite) ->
  575:     [];
  576: system_monitor_long_gc_1(doc) ->
  577:     ["Tests erlang:system_monitor(Pid, [{long_gc,Time}])"];
  578: system_monitor_long_gc_1(Config) when is_list(Config) ->
  579:     erts_debug:set_internal_state(available_internal_state, true),
  580:     try 
  581: 	case erts_debug:get_internal_state(force_heap_frags) of
  582: 	    true ->
  583: 		{skip,"emulator with FORCE_HEAP_FRAGS defined"};
  584: 	    false ->
  585: 		%% Add ?LONG_GC_SLEEP ms to all gc
  586: 		?line erts_debug:set_internal_state(test_long_gc_sleep,
  587: 						    ?LONG_GC_SLEEP),
  588: 		?line LoadFun = fun () -> 
  589: 					garbage_collect(),
  590: 					self() 
  591: 				end,
  592: 		?line long_gc(LoadFun, false)
  593: 	end
  594:     after
  595: 	erts_debug:set_internal_state(test_long_gc_sleep, 0),
  596: 	erts_debug:set_internal_state(available_internal_state, false)	
  597:     end.
  598: 
  599: system_monitor_long_gc_2(suite) ->
  600:     [];
  601: system_monitor_long_gc_2(doc) ->
  602:     ["Tests erlang:system_monitor(Pid, [{long_gc,Time}])"];
  603: system_monitor_long_gc_2(Config) when is_list(Config) ->
  604:     erts_debug:set_internal_state(available_internal_state, true),
  605:     try
  606: 	case erts_debug:get_internal_state(force_heap_frags) of
  607: 	    true ->
  608: 		{skip,"emulator with FORCE_HEAP_FRAGS defined"};
  609: 	    false ->
  610: 		%% Add ?LONG_GC_SLEEP ms to all gc
  611: 		?line erts_debug:set_internal_state(test_long_gc_sleep,
  612: 						    ?LONG_GC_SLEEP),
  613: 		?line Parent = self(),
  614: 		?line LoadFun =
  615: 		    fun () ->
  616: 			    Ref = make_ref(),
  617: 			    Pid = 
  618: 				spawn_link(
  619: 				  fun () ->
  620: 					  garbage_collect(),
  621: 					  Parent ! {Ref, self()}
  622: 				  end),
  623: 			    receive {Ref, Pid} -> Pid end
  624: 		    end,
  625: 		?line long_gc(LoadFun, true),
  626: 		?line long_gc(LoadFun, true),
  627: 		?line long_gc(LoadFun, true)
  628: 	end
  629:     after
  630: 	erts_debug:set_internal_state(test_long_gc_sleep, 0),
  631: 	erts_debug:set_internal_state(available_internal_state, false)
  632:     end.
  633: 
  634: long_gc(LoadFun, ExpectMonMsg) ->
  635:     ?line Self = self(),
  636:     ?line Time = 1,
  637:     ?line OldMonitor = erlang:system_monitor(Self, [{long_gc,Time}]),
  638:     ?line Pid = LoadFun(),
  639:     ?line Ref = erlang:trace_delivered(Pid),
  640:     ?line receive {trace_delivered, Pid, Ref} -> ok end,
  641:     ?line {Self,[{long_gc,Time}]} = erlang:system_monitor(OldMonitor),
  642:     ?line case {long_gc_check(Pid, Time, undefined), ExpectMonMsg} of
  643: 	      {ok, true} when Pid =/= Self ->
  644: 		  ok;
  645: 	      {ok, false} ->
  646: 		  ?line ?t:fail(unexpected_system_monitor_message_received);
  647: 	      {undefined, false} ->
  648: 		  ok;
  649: 	      {undefined, true} ->
  650: 		  ?line ?t:fail(no_system_monitor_message_received)
  651: 	  end.
  652: 
  653: long_gc_check(Pid, Time, Result) ->
  654:     receive
  655: 	{monitor,Pid,long_gc,L} = Monitor ->
  656: 	    case lists:foldl(
  657: 		   fun (_, error) ->
  658: 			   error;
  659: 		       ({timeout,T}, N) when is_integer(T),
  660: 					     Time =< T, T =< 10*?LONG_GC_SLEEP ->
  661: 			   %% OTP-7622. The time T must be within reasonable limits
  662: 			   %% for the test to pass.
  663: 			   N-1;
  664: 		       ({heap_size,_}, N) ->
  665: 			   N-1;
  666: 		       ({old_heap_size,_}, N) ->
  667: 			   N-1;
  668: 		       ({stack_size,_}, N) ->
  669: 			   N-1;
  670: 		       ({mbuf_size,_}, N) ->
  671: 			   N-1;
  672: 		       ({heap_block_size,_}, N) ->
  673: 			   N-1;
  674: 		       ({old_heap_block_size,_}, N) ->
  675: 			   N-1;
  676: 		       (_, _) ->
  677: 			   error
  678: 		   end, 7, L) of
  679: 		0 ->
  680: 		    long_gc_check(Pid, Time, ok);
  681: 		error ->
  682: 		    {error,Monitor}
  683: 	    end;
  684: 	{monitor,_,long_gc,_} ->
  685: 	    long_gc_check(Pid, Time, Result);
  686: 	Other ->
  687: 	    {error,Other}
  688:     after 0 ->
  689: 	    Result
  690:     end.
  691: 
  692: system_monitor_large_heap_1(suite) ->
  693:     [];
  694: system_monitor_large_heap_1(doc) ->
  695:     ["Tests erlang:system_monitor(Pid, [{large_heap,Size}])"];
  696: system_monitor_large_heap_1(Config) when is_list(Config) ->
  697:     ?line LoadFun =
  698: 	fun (Size) -> 
  699: 		List = seq(1,2*Size),
  700: 		garbage_collect(),
  701: 		true = lists:prefix([1], List),
  702: 		self() 
  703: 	end,
  704:     ?line large_heap(LoadFun, false).
  705: 
  706: system_monitor_large_heap_2(suite) ->
  707:     [];
  708: system_monitor_large_heap_2(doc) ->
  709:     ["Tests erlang:system_monitor(Pid, [{large_heap,Size}])"];
  710: system_monitor_large_heap_2(Config) when is_list(Config) ->
  711:     ?line Parent = self(),
  712:     ?line LoadFun =
  713: 	fun (Size) ->
  714: 		Ref = make_ref(),
  715: 		Pid = 
  716: 		    spawn_opt(fun () ->
  717: 				      garbage_collect(),
  718: 				      Parent ! {Ref, self()}
  719: 			      end,
  720: 			      [link, {min_heap_size, 2*Size}]),
  721: 		receive {Ref, Pid} -> Pid end
  722: 	end,
  723:     ?line large_heap(LoadFun, true).
  724: 
  725: large_heap(LoadFun, ExpectMonMsg) ->
  726:     ?line Dog = test_server:timetrap(test_server:seconds(20)),
  727:     %%
  728:     ?line Size = 65535,
  729:     ?line Self = self(),
  730:     ?line NewMonitor = {Self,[{large_heap,Size}]},
  731:     ?line OldMonitor = erlang:system_monitor(NewMonitor),
  732:     ?line Pid = LoadFun(Size),
  733:     ?line Ref = erlang:trace_delivered(Pid),
  734:     ?line receive {trace_delivered, Pid, Ref} -> ok end,
  735:     ?line {Self,[{large_heap,Size}]} = erlang:system_monitor(OldMonitor),
  736:     ?line case {large_heap_check(Pid, Size, undefined), ExpectMonMsg} of
  737: 	      {ok, true} when Pid =/= Self ->
  738: 		  ?line ok;
  739: 	      {ok, false} ->
  740: 		  ?line ?t:fail(unexpected_system_monitor_message_received);
  741: 	      {undefined, false} ->
  742: 		  ?line ok;
  743: 	      {undefined, true} ->
  744: 		  ?line ?t:fail(no_system_monitor_message_received)
  745: 	  end,
  746:     %%
  747:     ?line test_server:timetrap_cancel(Dog),
  748:     ok.
  749: 
  750: large_heap_check(Pid, Size, Result) ->
  751:     receive
  752: 	{monitor,Pid,large_heap,L} = Monitor ->
  753: 	    case lists:foldl(
  754: 		   fun (_, error) ->
  755: 			   error;
  756: 		       ({heap_size,_}, N) ->
  757: 			   N-1;
  758: 		       ({old_heap_size,_}, N) ->
  759: 			   N-1;
  760: 		       ({stack_size,_}, N) ->
  761: 			   N-1;
  762: 		       ({mbuf_size,_}, N) ->
  763: 			   N-1;
  764: 		       ({heap_block_size,_}, N) ->
  765: 			   N-1;
  766: 		       ({old_heap_block_size,_}, N) ->
  767: 			   N-1;
  768: 		       (_, _) ->
  769: 			   error
  770: 		   end, 6, L) of
  771: 		0 ->
  772: 		    large_heap_check(Pid, Size, ok);
  773: 		error ->
  774: 		    {error,Monitor}
  775: 	    end;
  776: 	{monitor,_,large_heap,_} ->
  777: 	    large_heap_check(Pid, Size, Result);
  778: 	Other ->
  779: 	    {error,Other}
  780:     after 0 ->
  781: 	    Result
  782:     end.
  783: 
  784: seq(N, M) ->
  785:     seq(N, M, []).
  786: 
  787: seq(M, M, R) ->
  788:     lists:reverse(R);
  789: seq(N, M, R) ->
  790:     seq(N+1, M, [N|R]).
  791: 
  792: 
  793: is_send_traced(Pid, Listener, Msg) ->
  794:     Pid ! {send_please, Listener, Msg},
  795:     receive
  796: 	Any ->
  797: 	    {trace, Pid, send, Msg, Listener} = Any,
  798: 	    true
  799:     after 1000 ->
  800: 	    false
  801:     end.
  802: 
  803: %% This procedure assumes that the Parent process is send traced.
  804: 
  805: spawn_children(Parent, Number) ->
  806:     spawn_children(Parent, Number, []).
  807: 
  808: spawn_children(_Parent, 0, Result) ->
  809:     lists:reverse(Result);
  810: spawn_children(Parent, Number, Result) ->
  811:     Self = self(),
  812:     Parent ! {spawn_please, Self, fun process/0},
  813:     Child = 
  814: 	receive
  815: 	    {trace, Parent, send, {spawned, Pid}, Self} -> Pid
  816: 	end,
  817:     receive
  818: 	{spawned, Child} ->
  819: 	    spawn_children(Parent, Number-1, [Child|Result])
  820:     end.
  821: 
  822: suspend(doc) -> "Test erlang:suspend/1 and erlang:resume/1.";
  823: suspend(Config) when is_list(Config) ->
  824:     ?line Dog = test_server:timetrap(test_server:minutes(2)),
  825: 
  826:     ?line Worker = fun_spawn(fun worker/0),
  827:     %% Suspend a process and test that it is suspended.
  828:     ?line ok = do_suspend(Worker, 10000),
  829: 
  830:     %% Done.
  831:     ?line test_server:timetrap_cancel(Dog),
  832:     ok.
  833: 
  834: do_suspend(_Pid, 0) ->
  835:     ?line ok;
  836: do_suspend(Pid, N) ->
  837:     %% Suspend a process and test that it is suspended.
  838:     ?line true = erlang:suspend_process(Pid),
  839:     ?line {status, suspended} = process_info(Pid, status),
  840: 
  841:     %% Unsuspend the process and make sure it starts working.
  842:     ?line true = erlang:resume_process(Pid),
  843:     ?line case process_info(Pid, status) of
  844: 	      {status, runnable} -> ?line ok;
  845: 	      {status, running} -> ?line ok;
  846: 	      {status, garbage_collecting} -> ?line ok;
  847: 	      ST -> ?line ?t:fail(ST)
  848: 	  end,
  849:     ?line erlang:yield(),
  850:     ?line do_suspend(Pid, N-1).
  851: 
  852: 
  853: 
  854: mutual_suspend(doc) ->
  855:     [];
  856: mutual_suspend(suite) ->
  857:     [];
  858: mutual_suspend(Config) when is_list(Config) ->
  859:     ?line TimeoutSecs = 5*60,
  860:     ?line Dog = test_server:timetrap(test_server:minutes(TimeoutSecs)),
  861:     ?line Parent = self(),
  862:     ?line Fun = fun () ->
  863: 			receive
  864: 			    {go, Pid} ->
  865: 				do_mutual_suspend(Pid, 100000)
  866: 			end,
  867: 			Parent ! {done, self()},
  868: 			receive after infinity -> ok end
  869: 		end,
  870:     ?line P1 = spawn_link(Fun),
  871:     ?line P2 = spawn_link(Fun),
  872:     ?line T1 = erlang:start_timer((TimeoutSecs - 5)*1000, self(), oops),
  873:     ?line T2 = erlang:start_timer((TimeoutSecs - 5)*1000, self(), oops),
  874:     ?line P1 ! {go, P2},
  875:     ?line P2 ! {go, P1},
  876:     ?line Res1 = receive
  877: 		    {done, P1} -> done;
  878: 		    {timeout,T1,_} -> timeout
  879: 		end,
  880:     ?line Res2 = receive
  881: 		     {done, P2} -> done;
  882: 		     {timeout,T2,_} -> timeout
  883: 		 end,
  884:     ?line P1S = process_info(P1, status),
  885:     ?line P2S = process_info(P2, status),
  886:     ?line ?t:format("P1S=~p P2S=~p", [P1S, P2S]),
  887:     ?line false = {status, suspended} == P1S,
  888:     ?line false = {status, suspended} == P2S,
  889:     ?line unlink(P1), exit(P1, bang),
  890:     ?line unlink(P2), exit(P2, bang),
  891:     ?line done = Res1,
  892:     ?line done = Res2,
  893:     %% Done.
  894:     ?line test_server:timetrap_cancel(Dog),
  895:     ?line ok.
  896:     
  897: do_mutual_suspend(_Pid, 0) ->
  898:     ?line ok;
  899: do_mutual_suspend(Pid, N) ->
  900:     %% Suspend a process and test that it is suspended.
  901:     ?line true = erlang:suspend_process(Pid),
  902:     ?line {status, suspended} = process_info(Pid, status),
  903:     %% Unsuspend the process.
  904:     ?line true = erlang:resume_process(Pid),
  905:     ?line do_mutual_suspend(Pid, N-1).		
  906: 
  907: suspend_exit(doc) ->
  908:     [];
  909: suspend_exit(suite) ->
  910:     [];
  911: suspend_exit(Config) when is_list(Config) ->
  912:     ?line Dog = test_server:timetrap(test_server:minutes(2)),
  913:     ?line random:seed(4711,17,4711),
  914:     ?line do_suspend_exit(5000),
  915:     ?line test_server:timetrap_cancel(Dog),
  916:     ?line ok.
  917: 
  918: do_suspend_exit(0) ->
  919:     ?line ok;
  920: do_suspend_exit(N) ->
  921:     ?line Work = random:uniform(50),
  922:     ?line Parent = self(),
  923:     ?line {Suspendee, Mon2}
  924: 	= spawn_monitor(fun () ->
  925: 				suspend_exit_work(Work),
  926: 				exit(normal)
  927: 			end),
  928:     ?line {Suspender, Mon1}
  929: 	= spawn_monitor(
  930: 	    fun () ->
  931: 		    suspend_exit_work(Work div 2),
  932: 		    Parent ! {doing_suspend, self()},
  933: 		    case catch erlang:suspend_process(Suspendee) of
  934: 			{'EXIT', _} ->
  935: 			    ok;
  936: 			true ->
  937: 			    ?line erlang:resume_process(Suspendee)
  938: 		    end
  939: 	    end),
  940:     ?line receive
  941: 	      {doing_suspend, Suspender} ->
  942: 		  case N rem 2 of
  943: 		      0 -> exit(Suspender, bang);
  944: 		      1 -> ok
  945: 		  end
  946: 	  end,
  947:     ?line receive {'DOWN', Mon1, process, Suspender, _} -> ok end,
  948:     ?line receive {'DOWN', Mon2, process, Suspendee, _} -> ok end,
  949:     ?line do_suspend_exit(N-1).
  950: 				 
  951: 
  952: 
  953:  
  954: suspend_exit_work(0) ->
  955:     ok;
  956: suspend_exit_work(N) ->
  957:     process_info(self()),
  958:     suspend_exit_work(N-1).
  959: 
  960: -define(CHK_SUSPENDED(P,B), chk_suspended(P, B, ?LINE)).
  961: 
  962: chk_suspended(P, Bool, Line) ->
  963:     {Bool, Line} = {({status, suspended} == process_info(P, status)), Line}.
  964: 
  965: suspender_exit(doc) ->
  966:     [];
  967: suspender_exit(suite) ->
  968:     [];
  969: suspender_exit(Config) when is_list(Config) ->
  970:     ?line Dog = test_server:timetrap(test_server:minutes(3)),
  971:     ?line P1 = spawn_link(fun () -> receive after infinity -> ok end end),
  972:     ?line {'EXIT', _} = (catch erlang:resume_process(P1)),
  973:     ?line {P2, M2} = spawn_monitor(
  974: 		       fun () ->
  975: 			       ?CHK_SUSPENDED(P1, false),
  976: 			       erlang:suspend_process(P1),
  977: 			       ?CHK_SUSPENDED(P1, true),
  978: 			       erlang:suspend_process(P1),
  979: 			       erlang:suspend_process(P1),
  980: 			       erlang:suspend_process(P1),
  981: 			       ?CHK_SUSPENDED(P1, true),
  982: 			       erlang:resume_process(P1),
  983: 			       erlang:resume_process(P1),
  984: 			       erlang:resume_process(P1),
  985: 			       ?CHK_SUSPENDED(P1, true),
  986: 			       erlang:resume_process(P1),
  987: 			       ?CHK_SUSPENDED(P1, false),
  988: 			       erlang:suspend_process(P1),
  989: 			       erlang:suspend_process(P1),
  990: 			       erlang:suspend_process(P1),
  991: 			       ?CHK_SUSPENDED(P1, true),
  992: 			       exit(bang)
  993: 		 end),
  994:     ?line receive
  995: 	      {'DOWN', M2,process,P2,R2} ->
  996: 		  ?line bang = R2,
  997: 		  ?line ?CHK_SUSPENDED(P1, false)
  998: 	  end,
  999:     ?line Parent = self(),
 1000:     ?line {P3, M3} = spawn_monitor(
 1001: 		       fun () ->
 1002: 			       erlang:suspend_process(P1),
 1003: 			       ?CHK_SUSPENDED(P1, true),
 1004: 			       Parent ! self(),
 1005: 			       receive after infinity -> ok end
 1006: 		       end),
 1007:     ?line {P4, M4} = spawn_monitor(
 1008: 		       fun () ->
 1009: 			       erlang:suspend_process(P1),
 1010: 			       ?CHK_SUSPENDED(P1, true),
 1011: 			       Parent ! self(),
 1012: 			       receive after infinity -> ok end
 1013: 		       end),
 1014:     ?line {P5, M5} = spawn_monitor(
 1015: 		       fun () ->
 1016: 			       erlang:suspend_process(P1),
 1017: 			       ?CHK_SUSPENDED(P1, true),
 1018: 			       Parent ! self(),
 1019: 			       receive after infinity -> ok end
 1020: 		       end),
 1021:     ?line {P6, M6} = spawn_monitor(
 1022: 		       fun () ->
 1023: 			       erlang:suspend_process(P1),
 1024: 			       ?CHK_SUSPENDED(P1, true),
 1025: 			       Parent ! self(),
 1026: 			       receive after infinity -> ok end
 1027: 		       end),
 1028:     ?line {P7, M7} = spawn_monitor(
 1029: 		       fun () ->
 1030: 			       erlang:suspend_process(P1),
 1031: 			       ?CHK_SUSPENDED(P1, true),
 1032: 			       Parent ! self(),
 1033: 			       receive after infinity -> ok end
 1034: 		       end),
 1035:     ?line receive P3 -> ok end,
 1036:     ?line receive P4 -> ok end,
 1037:     ?line receive P5 -> ok end,
 1038:     ?line receive P6 -> ok end,
 1039:     ?line receive P7 -> ok end,
 1040:     ?line ?CHK_SUSPENDED(P1, true),
 1041:     ?line exit(P3, bang),
 1042:     ?line receive
 1043: 	      {'DOWN',M3,process,P3,R3} ->
 1044: 		  ?line bang = R3,
 1045: 		  ?line ?CHK_SUSPENDED(P1, true)
 1046: 	  end,
 1047:     ?line exit(P4, bang),
 1048:     ?line receive
 1049: 	      {'DOWN',M4,process,P4,R4} ->
 1050: 		  ?line bang = R4,
 1051: 		  ?line ?CHK_SUSPENDED(P1, true)
 1052: 	  end,
 1053:     ?line exit(P5, bang),
 1054:     ?line receive
 1055: 	      {'DOWN',M5,process,P5,R5} ->
 1056: 		  ?line bang = R5,
 1057: 		  ?line ?CHK_SUSPENDED(P1, true)
 1058: 	  end,
 1059:     ?line exit(P6, bang),
 1060:     ?line receive
 1061: 	      {'DOWN',M6,process,P6,R6} ->
 1062: 		  ?line bang = R6,
 1063: 		  ?line ?CHK_SUSPENDED(P1, true)
 1064: 	  end,
 1065:     ?line exit(P7, bang),
 1066:     ?line receive
 1067: 	      {'DOWN',M7,process,P7,R7} ->
 1068: 		  ?line bang = R7,
 1069: 		  ?line ?CHK_SUSPENDED(P1, false)
 1070: 	  end,
 1071:     ?line unlink(P1),
 1072:     ?line exit(P1, bong),
 1073:     ?line test_server:timetrap_cancel(Dog),
 1074:     ?line ok.
 1075: 			 
 1076: suspend_system_limit(doc) ->			 
 1077:     [];
 1078: suspend_system_limit(suite) ->
 1079:     [];
 1080: suspend_system_limit(Config) when is_list(Config) ->
 1081:     case os:getenv("ERL_EXTREME_TESTING") of
 1082: 	"true" ->
 1083: 	    ?line Dog = test_server:timetrap(test_server:minutes(3*60)),
 1084: 	    ?line P = spawn_link(fun () -> receive after infinity -> ok end end),
 1085: 	    ?line suspend_until_system_limit(P),
 1086: 	    ?line unlink(P),
 1087: 	    ?line exit(P, bye),
 1088: 	    ?line test_server:timetrap_cancel(Dog),
 1089: 	    ?line ok;
 1090: 	_ ->
 1091: 	    {skip, "Takes too long time for normal testing"}
 1092:     end.
 1093: 
 1094: suspend_until_system_limit(P) ->
 1095:     ?line suspend_until_system_limit(P, 0, 0).
 1096: 
 1097: suspend_until_system_limit(P, N, M) ->
 1098:     NewM = case M of
 1099: 	       1 ->
 1100: 		   ?line ?CHK_SUSPENDED(P, true), 2;
 1101: 	       1000000 ->
 1102: 		   erlang:display(N), 1;
 1103: 	       _ ->
 1104: 		   M+1
 1105: 	   end,
 1106:     ?line case catch erlang:suspend_process(P) of
 1107: 	      true ->
 1108: 		  suspend_until_system_limit(P, N+1, NewM);
 1109: 	      {'EXIT', R} when R == system_limit;
 1110: 			       element(1, R) == system_limit ->
 1111: 		  ?line ?t:format("system limit at ~p~n", [N]),
 1112: 		  ?line resume_from_system_limit(P, N, 0);
 1113: 	      Error ->
 1114: 		  ?line ?t:fail(Error)
 1115: 	  end.
 1116: 
 1117: resume_from_system_limit(P, 0, _) ->
 1118:     ?line ?CHK_SUSPENDED(P, false),
 1119:     ?line {'EXIT', _} = (catch erlang:resume_process(P)),
 1120:     ?line ok;
 1121: resume_from_system_limit(P, N, M) ->
 1122:     ?line NewM = case M of
 1123: 		     1 ->
 1124: 			 ?line ?CHK_SUSPENDED(P, true), 2;
 1125: 		     1000000 ->
 1126: 			 erlang:display(N), 1;
 1127: 		     _ ->
 1128: 			 M+1
 1129: 		 end,
 1130:     ?line erlang:resume_process(P),
 1131:     ?line resume_from_system_limit(P, N-1, NewM).
 1132: 
 1133: -record(susp_info, {async = 0,
 1134: 		    dbl_async = 0,
 1135: 		    synced = 0,
 1136: 		    async_once = 0}).
 1137: 
 1138: suspend_opts(doc) ->
 1139:     [];
 1140: suspend_opts(suite) ->
 1141:     [];
 1142: suspend_opts(Config) when is_list(Config) ->
 1143:     ?line Dog = test_server:timetrap(test_server:minutes(3)),
 1144:     ?line Self = self(),
 1145:     ?line wait_for_empty_runq(10),
 1146:     ?line Tok = spawn_link(fun () ->
 1147: 				   Self ! self(),
 1148: 				   tok_trace_loop(Self, 0, 1000000000)
 1149: 			   end),
 1150:     ?line TC = 1000,
 1151:     ?line receive Tok -> ok end,
 1152:     ?line SF = fun (N, #susp_info {async = A,
 1153: 				   dbl_async = AA,
 1154: 				   synced = S,
 1155: 				   async_once = AO} = Acc) ->
 1156: 		       ?line erlang:suspend_process(Tok, [asynchronous]),
 1157: 		       ?line Res = case {suspend_count(Tok), N rem 4} of
 1158: 				       {0, 2} ->
 1159: 					   ?line erlang:suspend_process(Tok,
 1160: 									[asynchronous]),
 1161: 					   case suspend_count(Tok) of
 1162: 					       2 ->
 1163: 						   ?line erlang:resume_process(Tok),
 1164: 						   ?line Acc#susp_info{async = A+1};
 1165: 					       0 ->
 1166: 						   ?line erlang:resume_process(Tok),
 1167: 						   ?line Acc#susp_info{async = A+1,
 1168: 								       dbl_async = AA+1}
 1169: 					   end;
 1170: 				       {0, 1} ->
 1171: 					   ?line erlang:suspend_process(Tok,
 1172: 									[asynchronous,
 1173: 									 unless_suspending]),
 1174: 					   case suspend_count(Tok) of
 1175: 					       1 ->
 1176: 						   ?line Acc#susp_info{async = A+1};
 1177: 					       0 ->
 1178: 						   ?line Acc#susp_info{async = A+1,
 1179: 								       async_once = AO+1}
 1180: 					   end;
 1181: 				       {0, 0} ->
 1182: 					   ?line erlang:suspend_process(Tok,
 1183: 									[unless_suspending]),
 1184: 					   ?line 1 = suspend_count(Tok),
 1185: 					   ?line Acc#susp_info{async = A+1,
 1186: 							       synced = S+1};
 1187: 				       {0, _} ->
 1188: 					   ?line Acc#susp_info{async = A+1};
 1189: 				       _ ->
 1190: 					   Acc
 1191: 				   end,
 1192: 		       ?line erlang:resume_process(Tok),
 1193: 		       ?line erlang:yield(),
 1194: 		       ?line Res
 1195: 	       end,
 1196:     ?line SI = repeat_acc(SF, TC, #susp_info{}),
 1197:     ?line erlang:suspend_process(Tok, [asynchronous]),
 1198:     %% Verify that it eventually suspends
 1199:     ?line WaitTime0 = 10,
 1200:     ?line WaitTime1 = case {erlang:system_info(debug_compiled),
 1201: 			    erlang:system_info(lock_checking)} of
 1202: 			  {false, false} ->
 1203: 			      WaitTime0;
 1204: 			  {false, true} ->
 1205: 			      WaitTime0*5;
 1206: 			  _ ->
 1207: 			      WaitTime0*10
 1208: 		      end,
 1209:     ?line WaitTime = case {erlang:system_info(schedulers_online),
 1210: 			   erlang:system_info(logical_processors)} of
 1211: 			 {Schdlrs, CPUs} when is_integer(CPUs),
 1212: 					      Schdlrs =< CPUs ->
 1213: 			     WaitTime1;
 1214: 			 _ ->
 1215: 			     WaitTime1*10
 1216: 		     end,
 1217:     ?line receive after WaitTime -> ok end,
 1218:     ?line 1 = suspend_count(Tok),
 1219:     ?line erlang:suspend_process(Tok, [asynchronous]),
 1220:     ?line 2 = suspend_count(Tok),
 1221:     ?line erlang:suspend_process(Tok, [asynchronous]),
 1222:     ?line 3 = suspend_count(Tok),
 1223:     ?line erlang:suspend_process(Tok),
 1224:     ?line 4 = suspend_count(Tok),
 1225:     ?line erlang:suspend_process(Tok),
 1226:     ?line 5 = suspend_count(Tok),
 1227:     ?line erlang:suspend_process(Tok, [unless_suspending]),
 1228:     ?line 5 = suspend_count(Tok),
 1229:     ?line erlang:suspend_process(Tok, [unless_suspending,
 1230: 				       asynchronous]),
 1231:     ?line 5 = suspend_count(Tok),
 1232:     ?line erlang:resume_process(Tok),
 1233:     ?line erlang:resume_process(Tok),
 1234:     ?line erlang:resume_process(Tok),
 1235:     ?line erlang:resume_process(Tok),
 1236:     ?line 1 = suspend_count(Tok),
 1237:     ?line ?t:format("Main suspends: ~p~n"
 1238: 		    "Main async: ~p~n"
 1239: 		    "Double async: ~p~n"
 1240: 		    "Async once: ~p~n"
 1241: 		    "Synced: ~p~n",
 1242: 		    [TC,
 1243: 		     SI#susp_info.async,
 1244: 		     SI#susp_info.dbl_async,
 1245: 		     SI#susp_info.async_once,
 1246: 		     SI#susp_info.synced]),
 1247:     ?line case erlang:system_info(schedulers_online) of
 1248: 	      1 ->
 1249: 		  ?line ok;
 1250: 	      _ ->
 1251: 		  ?line true = SI#susp_info.async =/= 0
 1252: 	  end,
 1253:     ?line unlink(Tok),
 1254:     ?line exit(Tok, bang),
 1255:     ?line test_server:timetrap_cancel(Dog),
 1256:     ?line ok.
 1257: 
 1258: suspend_count(Suspendee) ->
 1259:     suspend_count(self(), Suspendee).
 1260: 
 1261: suspend_count(Suspender, Suspendee) ->
 1262:     {suspending, SList} = process_info(Suspender, suspending),
 1263:     
 1264:     case lists:keysearch(Suspendee, 1, SList) of
 1265: 	{value, {_Suspendee, 0, 0}} ->
 1266: 	    ?line ?t:fail({bad_suspendee_list, SList});
 1267: 	{value, {Suspendee, Count, 0}} when is_integer(Count), Count > 0 ->
 1268: 	    {status, suspended} = process_info(Suspendee, status),
 1269: 	    Count;
 1270: 	{value, {Suspendee, 0, Outstanding}} when is_integer(Outstanding),
 1271: 	                                          Outstanding > 0 ->
 1272: 	    0;
 1273: 	false ->
 1274: 	    0;
 1275: 	Error ->
 1276: 	    ?line ?t:fail({bad_suspendee_list, Error, SList})
 1277:     end.
 1278:     
 1279: repeat_acc(Fun, N, Acc) ->
 1280:     repeat_acc(Fun, 0, N, Acc).
 1281: 
 1282: repeat_acc(_Fun, N, N, Acc) ->
 1283:     Acc;
 1284: repeat_acc(Fun, N, M, Acc) ->
 1285:     repeat_acc(Fun, N+1, M, Fun(N, Acc)).
 1286: 		   
 1287: %% Tests that waiting process can be suspended
 1288: %% (bug in R2D and earlier; see OTP-1488).
 1289: 
 1290: suspend_waiting(doc) -> "Test that a waiting process can be suspended.";
 1291: suspend_waiting(Config) when is_list(Config) ->
 1292:     ?line Dog = test_server:timetrap(test_server:seconds(5)),
 1293: 
 1294:     ?line Process = fun_spawn(fun process/0),
 1295:     ?line receive after 1 -> ok end,
 1296:     ?line true = erlang:suspend_process(Process),
 1297:     ?line {status, suspended} = process_info(Process, status),
 1298: 
 1299:     %% Done.
 1300:     ?line test_server:timetrap_cancel(Dog),
 1301:     ok.
 1302: 
 1303: 
 1304: 
 1305: new_clear(doc) ->
 1306:     "Test that erlang:trace(new, true, ...) is cleared when tracer dies.";
 1307: new_clear(Config) when is_list(Config) ->
 1308:     ?line Dog = test_server:timetrap(test_server:seconds(5)),
 1309: 
 1310:     ?line Tracer = spawn(fun receiver/0),
 1311:     ?line 0 = erlang:trace(new, true, [send, {tracer, Tracer}]),
 1312:     ?line {flags, [send]} = erlang:trace_info(new, flags),
 1313:     ?line {tracer, Tracer} = erlang:trace_info(new, tracer),
 1314:     ?line Mref = erlang:monitor(process, Tracer),
 1315:     ?line true = exit(Tracer, done),
 1316:     receive
 1317: 	{'DOWN',Mref,_,_,_} -> ok
 1318:     end,
 1319:     ?line {flags, []} = erlang:trace_info(new, flags),
 1320:     ?line {tracer, []} = erlang:trace_info(new, tracer),
 1321: 
 1322:     %% Done.
 1323:     ?line test_server:timetrap_cancel(Dog),
 1324: 
 1325:     ok.
 1326: 
 1327: 
 1328: 
 1329: existing_clear(doc) ->
 1330:     "Test that erlang:trace(all, false, ...) works without tracer.";
 1331: existing_clear(Config) when is_list(Config) ->
 1332:     ?line Dog = test_server:timetrap(test_server:seconds(5)),
 1333:     ?line Self = self(),
 1334: 
 1335:     ?line Tracer = fun_spawn(fun receiver/0),
 1336:     ?line N = erlang:trace(existing, true, [send, {tracer, Tracer}]),
 1337:     ?line {flags, [send]} = erlang:trace_info(Self, flags),
 1338:     ?line {tracer, Tracer} = erlang:trace_info(Self, tracer),
 1339:     ?line M = erlang:trace(all, false, [all]),
 1340:     ?line io:format("Started trace on ~p processes and stopped on ~p~n", 
 1341: 		    [N, M]),
 1342:     ?line {flags, []} = erlang:trace_info(Self, flags),
 1343:     ?line {tracer, []} = erlang:trace_info(Self, tracer),
 1344:     ?line M = N + 1, % Since trace could not be enabled on the tracer.
 1345: 
 1346:     %% Done.
 1347:     ?line test_server:timetrap_cancel(Dog),
 1348:     ok.
 1349: 
 1350: bad_flag(doc) -> "Test that an invalid flag cause badarg";
 1351: bad_flag(suite) -> [];
 1352: bad_flag(Config) when is_list(Config) ->
 1353:     %% A bad flag could deadlock the SMP emulator in erts-5.5
 1354:     ?line {'EXIT', {badarg, _}} = (catch erlang:trace(new,
 1355: 						      true,
 1356: 						      [not_a_valid_flag])),
 1357:     ?line ok.
 1358: 
 1359: trace_delivered(doc) -> "Test erlang:trace_delivered/1";
 1360: trace_delivered(suite) -> [];
 1361: trace_delivered(Config) when is_list(Config) ->
 1362:     ?line Dog = test_server:timetrap(test_server:seconds(60)),
 1363:     ?line TokLoops = 10000,
 1364:     ?line Go = make_ref(),
 1365:     ?line Parent = self(),
 1366:     ?line Tok = spawn(fun () ->
 1367: 			      receive Go -> gone end,
 1368: 			      tok_trace_loop(Parent, 0, TokLoops)
 1369: 		      end),
 1370:     ?line 1 = erlang:trace(Tok, true, [procs]),
 1371:     ?line Mon = erlang:monitor(process, Tok),
 1372:     ?line NoOfTraceMessages = 4*TokLoops + 1,
 1373:     ?line io:format("Expect a total of ~p trace messages~n",
 1374: 		    [NoOfTraceMessages]),
 1375:     ?line Tok ! Go,
 1376:     ?line NoOfTraceMessages = drop_trace_until_down(Tok, Mon),
 1377:     ?line receive
 1378: 	      Msg ->
 1379: 		  ?line ?t:fail({unexpected_message, Msg})
 1380: 	  after 1000 ->
 1381: 		  ?line test_server:timetrap_cancel(Dog),
 1382: 		  ?line ok
 1383: 	  end.
 1384: 
 1385: drop_trace_until_down(Proc, Mon) ->
 1386:     drop_trace_until_down(Proc, Mon, false, 0, 0).
 1387: 
 1388: drop_trace_until_down(Proc, Mon, TDRef, N, D) ->
 1389:     case receive Msg -> Msg end of
 1390: 	{trace_delivered, Proc, TDRef} ->
 1391: 	    io:format("~p trace messages on 'DOWN'~n", [D]),
 1392: 	    io:format("Got a total of ~p trace messages~n", [N]),
 1393: 	    N;
 1394: 	{'DOWN', Mon, process, Proc, _} ->
 1395: 	    Ref = erlang:trace_delivered(Proc),
 1396: 	    drop_trace_until_down(Proc, Mon, Ref, N, N);
 1397: 	Trace when is_tuple(Trace),
 1398: 		   element(1, Trace) == trace,
 1399: 		   element(2, Trace) == Proc ->
 1400: 	    drop_trace_until_down(Proc, Mon, TDRef, N+1, D)
 1401:     end.
 1402: 
 1403: tok_trace_loop(_, N, N) ->
 1404:     ok;
 1405: tok_trace_loop(Parent, N, M) ->
 1406:     Name = 'A really stupid name which I will unregister at once',
 1407:     link(Parent),
 1408:     register(Name, self()),
 1409:     unregister(Name),
 1410:     unlink(Parent),
 1411:     tok_trace_loop(Parent, N+1, M).
 1412: 
 1413: %% Waits for and returns the first message in the message queue.
 1414: 
 1415: receive_first() ->
 1416:     receive
 1417: 	Any -> Any
 1418:     end.
 1419: 
 1420: %% Ensures that there is no message in the message queue.
 1421: 
 1422: receive_nothing() ->
 1423:     receive
 1424: 	Any ->
 1425: 	    test_server:fail({unexpected_message, Any})
 1426:     after 200 ->
 1427: 	    ok
 1428:     end.
 1429: 
 1430: 
 1431: %%% Models for various kinds of processes.
 1432: 
 1433: process(Dest) ->
 1434:     receive
 1435: 	{send_please, To, What} ->
 1436: 	    To ! What,
 1437: 	    process(Dest);
 1438: 	{spawn_link_please, ReplyTo, {M, F, A}} ->
 1439: 	    Pid = spawn_link(M, F, A),
 1440: 	    ReplyTo ! {spawned, self(), Pid},
 1441: 	    process(Dest);
 1442: 	{spawn_link_please, ReplyTo, Node, {M, F, A}} ->
 1443: 	    Pid = spawn_link(Node, M, F, A),
 1444: 	    ReplyTo ! {spawned, self(), Pid},
 1445: 	    process(Dest);
 1446: 	{link_please, Pid} ->
 1447: 	    link(Pid),
 1448: 	    process(Dest);
 1449: 	{unlink_please, Pid} ->
 1450: 	    unlink(Pid),
 1451: 	    process(Dest);
 1452: 	{register_please, Name, Pid} ->
 1453: 	    register(Name, Pid),
 1454: 	    process(Dest);
 1455: 	{unregister_please, Name} ->
 1456: 	    unregister(Name),
 1457: 	    process(Dest);
 1458: 	{exit_please, Reason} ->
 1459: 	    exit(Reason);
 1460: 	{trap_exit_please, State} ->
 1461: 	    process_flag(trap_exit, State),
 1462: 	    process(Dest);
 1463: 	Other ->
 1464: 	    Dest ! {self(), Other},
 1465: 	    process(Dest)
 1466:     after 3000 ->
 1467: 	    exit(timeout)
 1468:     end.
 1469: 
 1470: 
 1471: %% A smart process template.
 1472: 
 1473: process() ->
 1474:     receive
 1475: 	{spawn_please, ReplyTo, Fun} ->
 1476: 	    Pid = fun_spawn(Fun),
 1477: 	    ReplyTo ! {spawned, Pid},
 1478: 	    process();
 1479: 	{send_please, To, What} ->
 1480: 	    To ! What,
 1481: 	    process();
 1482: 	timeout_please ->
 1483: 	    receive after 1 -> process() end;
 1484: 	_Other ->
 1485: 	    process()
 1486:     end.
 1487: 
 1488: 
 1489: %% Sends messages when ordered to.
 1490: 
 1491: sender() ->
 1492:     receive
 1493: 	{send_please, To, What} ->
 1494: 	    To ! What,
 1495: 	    sender()
 1496:     end.
 1497: 
 1498: 
 1499: %% Just consumes messages from its message queue.
 1500: 
 1501: receiver() ->
 1502:     receive
 1503: 	_Any -> receiver()
 1504:     end.
 1505: 
 1506: %% Works as long as it receives CPU time.  Will always be RUNNABLE.
 1507: 
 1508: worker() ->
 1509:     worker(0).
 1510: 
 1511: worker(Number) ->
 1512:     worker(Number+1).
 1513: 
 1514: fun_spawn(Fun) ->
 1515:     spawn_link(erlang, apply, [Fun, []]).
 1516: 
 1517: fun_spawn(Fun, Args) ->
 1518:     spawn_link(erlang, apply, [Fun, Args]).
 1519: 
 1520: 
 1521: start_node(Name) ->
 1522:     Pa = filename:dirname(code:which(?MODULE)),
 1523:     Cookie = atom_to_list(erlang:get_cookie()),
 1524:     test_server:start_node(Name, slave, 
 1525: 			   [{args, "-setcookie " ++ Cookie ++" -pa " ++ Pa}]).
 1526: 
 1527: stop_node(Node) ->
 1528:     test_server:stop_node(Node).
 1529: 
 1530: 
 1531: wait_for_empty_runq(DeadLine) ->
 1532:     case statistics(run_queue) of
 1533: 	0 -> true;
 1534: 	RQLen ->
 1535: 	    erlang:display("Waiting for empty run queue"),
 1536: 	    MSDL = DeadLine*1000,
 1537: 	    wait_for_empty_runq(MSDL, MSDL, RQLen)
 1538:     end.
 1539: 
 1540: wait_for_empty_runq(DeadLine, Left, RQLen) when Left =< 0 ->
 1541:     issue_non_empty_runq_warning(DeadLine, RQLen),
 1542:     false;
 1543: wait_for_empty_runq(DeadLine, Left, _RQLen) ->
 1544:     Wait = 10,
 1545:     UntilDeadLine = Left - Wait,
 1546:     receive after Wait -> ok end,
 1547:     case statistics(run_queue) of
 1548: 	0 ->
 1549: 	    erlang:display("Waited for "
 1550: 			   ++ integer_to_list(DeadLine
 1551: 					      - UntilDeadLine)
 1552: 			   ++ " ms for empty run queue."),
 1553: 	    true;
 1554: 	NewRQLen ->
 1555: 	    wait_for_empty_runq(DeadLine,
 1556: 				UntilDeadLine,
 1557: 				NewRQLen)
 1558:     end.
 1559: 
 1560: issue_non_empty_runq_warning(DeadLine, RQLen) ->
 1561:     PIs = lists:foldl(
 1562: 	    fun (P, Acc) ->
 1563: 		    case process_info(P,
 1564: 				      [status,
 1565: 				       initial_call,
 1566: 				       current_function,
 1567: 				       registered_name,
 1568: 				       reductions,
 1569: 				       message_queue_len]) of
 1570: 			[{status, Runnable} | _] = PI when Runnable /= waiting,
 1571: 							   Runnable /= suspended ->
 1572: 			    [[{pid, P} | PI] | Acc];
 1573: 			_ ->
 1574: 			    Acc
 1575: 		    end
 1576: 	    end,
 1577: 	    [],
 1578: 	    processes()),
 1579:     ?t:format("WARNING: Unexpected runnable processes in system (waited ~p sec).~n"
 1580: 	      "         Run queue length: ~p~n"
 1581: 	      "         Self: ~p~n"
 1582: 	      "         Processes info: ~p~n",
 1583: 	      [DeadLine div 1000, RQLen, self(), PIs]),
 1584:     receive after 1000 -> ok end.
 1585: 
 1586: load_driver(Dir, Driver) ->
 1587:     case erl_ddll:load_driver(Dir, Driver) of
 1588: 	ok -> ok;
 1589: 	{error, Error} = Res ->
 1590: 	    io:format("~s\n", [erl_ddll:format_error(Error)]),
 1591: 	    Res
 1592:     end.