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(busy_port_SUITE).
   21: 
   22: -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, 
   23: 	 init_per_group/2,end_per_group/2,end_per_testcase/2,
   24: 	 io_to_busy/1, message_order/1, send_3/1, 
   25: 	 system_monitor/1, no_trap_exit/1,
   26: 	 no_trap_exit_unlinked/1, trap_exit/1, multiple_writers/1,
   27: 	 hard_busy_driver/1, soft_busy_driver/1]).
   28: 
   29: -compile(export_all).
   30: 
   31: -include_lib("test_server/include/test_server.hrl").
   32: 
   33: %% Internal exports.
   34: -export([init/2]).
   35: 
   36: suite() -> [{ct_hooks,[ts_install_cth]}].
   37: 
   38: all() -> 
   39:     [io_to_busy, message_order, send_3, system_monitor,
   40:      no_trap_exit, no_trap_exit_unlinked, trap_exit,
   41:      multiple_writers, hard_busy_driver, soft_busy_driver,
   42:      scheduling_delay_busy,scheduling_delay_busy_nosuspend,
   43:      scheduling_busy_link].
   44: 
   45: groups() -> 
   46:     [].
   47: 
   48: init_per_suite(Config) ->
   49:     Config.
   50: 
   51: end_per_suite(_Config) ->
   52:     ok.
   53: 
   54: init_per_group(_GroupName, Config) ->
   55:     Config.
   56: 
   57: end_per_group(_GroupName, Config) ->
   58:     Config.
   59: 
   60: end_per_testcase(_Case, Config) when is_list(Config) ->
   61:     case whereis(busy_drv_server) of
   62: 	undefined ->
   63: 	    ok;
   64: 	Pid when is_pid(Pid) ->
   65: 	    Ref = monitor(process, Pid),
   66: 	    unlink(Pid),
   67: 	    exit(Pid, kill),
   68: 	    receive
   69: 		{'DOWN',Ref,process,Pid,_} ->
   70: 		    ok
   71: 	    end
   72:     end,
   73:     Config.
   74: 
   75: %% Tests I/O operations to a busy port, to make sure a suspended send
   76: %% operation is correctly restarted.  This used to crash Beam.
   77: 
   78: io_to_busy(suite) -> [];
   79: io_to_busy(Config) when is_list(Config) ->
   80:     ?line Dog = test_server:timetrap(test_server:seconds(30)),
   81: 
   82:     ?line start_busy_driver(Config),
   83:     ?line process_flag(trap_exit, true),
   84:     ?line Writer = fun_spawn(fun writer/0),
   85:     ?line Generator = fun_spawn(fun() -> generator(100, Writer) end),
   86:     ?line wait_for([Writer, Generator]),
   87: 
   88:     ?line test_server:timetrap_cancel(Dog),
   89:     ok.
   90: 
   91: generator(N, Writer) ->
   92:     generator(N, Writer, lists:duplicate(128, 42)).
   93: 
   94: generator(0, Writer, _Data) ->
   95:     Writer ! stop,
   96:     erlang:garbage_collect(),
   97:     receive after 2000 -> ok end,
   98: 
   99:     %% Calling process_info(Pid, current_function) on a suspended process
  100:     %% used to crash Beam.
  101:     {current_function, {erlang, send, 2}} =
  102: 	process_info(Writer, current_function),
  103:     unlock_slave();
  104: generator(N, Writer, Data) ->
  105:     Writer ! {exec, Data},
  106:     generator(N-1, Writer, [42|Data]).
  107: 
  108: writer() ->
  109:     {Owner, Port} = get_slave(),
  110:     Port ! {Owner, {connect, self()}},
  111:     X = {a, b, c, d},
  112:     forget({element(1, X), element(2, X), element(3, X), element(4, X)}),
  113:     writer_loop(Port).
  114: 
  115: writer_loop(Port) ->
  116:     receive
  117: 	{exec, Data} ->
  118: 	    Port ! {self(), {command, Data}},
  119: 	    writer_loop(Port);
  120: 	stop ->
  121: 	    erlang:garbage_collect()
  122:     end.
  123: 
  124: forget(_) ->
  125:     ok.
  126: 
  127: %% Test the interaction of busy ports and message sending.
  128: %% This used to cause the wrong message to be received.
  129: 
  130: message_order(suite) -> {req, dynamic_loading};
  131: message_order(Config) when is_list(Config) ->
  132:     ?line Dog = test_server:timetrap(test_server:seconds(10)),
  133: 
  134:     ?line start_busy_driver(Config),
  135:     ?line Self = self(),
  136:     ?line Busy = fun_spawn(fun () -> send_to_busy_1(Self) end),
  137:     ?line receive after 1000 -> ok end,
  138:     ?line Busy ! first,
  139:     ?line Busy ! second,
  140:     ?line receive after 1 -> ok end,
  141:     ?line unlock_slave(),
  142:     ?line Busy ! third,
  143:     ?line receive
  144: 	      {Busy, first} ->
  145: 		  ok;
  146: 	      Other ->
  147: 		  test_server:fail({unexpected_message, Other})
  148: 	  end,
  149: 
  150:     ?line test_server:timetrap_cancel(Dog),
  151:     ok.
  152: 
  153: send_to_busy_1(Parent) ->
  154:     {Owner, Slave} = get_slave(),
  155:     (catch port_command(Slave, "set_me_busy")),
  156:     (catch port_command(Slave, "hello")),
  157:     (catch port_command(Slave, "hello again")),
  158:     receive
  159: 	Message ->
  160: 	    Parent ! {self(), Message}
  161:     end.
  162: 
  163: %% Test the bif send/3
  164: send_3(suite) -> {req,dynamic_loading};
  165: send_3(doc) -> ["Test the BIF send/3"];
  166: send_3(Config) when is_list(Config) ->
  167:     ?line Dog = test_server:timetrap(test_server:seconds(10)),
  168:     %%
  169:     ?line start_busy_driver(Config),
  170:     ?line {Owner,Slave} = get_slave(),
  171:     ?line ok = erlang:send(Slave, {Owner,{command,"set busy"}}, 
  172: 			   [nosuspend]),
  173:     receive after 100 -> ok end, % ensure command reached port
  174:     ?line nosuspend = erlang:send(Slave, {Owner,{command,"busy"}},
  175: 				  [nosuspend]),
  176:     ?line unlock_slave(),
  177:     ?line ok = erlang:send(Slave, {Owner,{command,"not busy"}}, 
  178: 			   [nosuspend]),
  179:     ?line ok = command(stop),
  180:     %%
  181:     ?line test_server:timetrap_cancel(Dog),
  182:     ok.
  183: 
  184: %% Test the erlang:system_monitor(Pid, [busy_port])
  185: system_monitor(suite) -> {req,dynamic_loading};
  186: system_monitor(doc) -> ["Test erlang:system_monitor({Pid,[busy_port]})."];
  187: system_monitor(Config) when is_list(Config) ->
  188:     ?line Dog = test_server:timetrap(test_server:seconds(10)),
  189:     ?line Self = self(),
  190:     %%
  191:     ?line OldMonitor = erlang:system_monitor(Self, [busy_port]),
  192:     ?line {Self,[busy_port]} = erlang:system_monitor(),
  193:     ?line Void = make_ref(),
  194:     ?line start_busy_driver(Config),
  195:     ?line {Owner,Slave} = get_slave(),
  196:     ?line Master = command(get_master),
  197:     ?line Parent = self(),
  198:     ?line Busy = 
  199: 	spawn_link(
  200: 	  fun() ->
  201: 		  (catch port_command(Slave, "set busy")),
  202: 		  receive {Parent,alpha} -> ok end,
  203: 		  (catch port_command(Slave, "busy")),
  204: 		  (catch port_command(Slave, "free")),
  205: 		  Parent ! {self(),alpha},
  206: 		  command(lock),
  207: 		  receive {Parent,beta} -> ok end,
  208: 		  command({port_command,"busy"}),
  209: 		  command({port_command,"free"}),
  210: 		  Parent ! {self(),beta}
  211: 	  end),
  212:     ?line Void = rec(Void),
  213:     ?line Busy ! {self(),alpha},
  214:     ?line {monitor,Busy,busy_port,Slave} = rec(Void),
  215:     ?line unlock_slave(),
  216:     ?line {Busy,alpha} = rec(Void),
  217:     ?line Void = rec(Void),
  218:     ?line Busy ! {self(), beta},
  219:     ?line {monitor,Owner,busy_port,Slave} = rec(Void),
  220:     ?line port_command(Master, "u"),
  221:     ?line {Busy,beta} = rec(Void),
  222:     ?line Void = rec(Void),
  223:     ?line _NewMonitor = erlang:system_monitor(OldMonitor),
  224:     ?line OldMonitor = erlang:system_monitor(),
  225:     ?line OldMonitor = erlang:system_monitor(OldMonitor),
  226:     %%
  227:     ?line test_server:timetrap_cancel(Dog),
  228:     ok.
  229: 
  230: 
  231: 
  232: rec(Tag) ->
  233:     receive X -> X after 1000 -> Tag end.
  234: 
  235: 
  236: 
  237: 
  238: %% Assuming the following scenario,
  239: %%
  240: %%  +---------------+		       +-----------+
  241: %%  | process with  |		       |           |
  242: %%  | no trap_exit  |------------------| busy port |
  243: %%  | (suspended)   |		       |	   |
  244: %%  +---------------+		       +-----------+
  245: %%
  246: %% tests that the suspended process is killed if the port is killed.
  247: 
  248: no_trap_exit(suite) -> [];
  249: no_trap_exit(Config) when is_list(Config) ->
  250:     ?line Dog = test_server:timetrap(test_server:seconds(10)),
  251:     ?line process_flag(trap_exit, true),
  252:     ?line Pid = fun_spawn(fun no_trap_exit_process/3,
  253: 			  [self(), linked, Config]),
  254:     ?line receive
  255: 	      {Pid, port_created, Port} ->
  256: 		  io:format("Process ~w created port ~w", [Pid, Port]),
  257: 		  ?line exit(Port, die);
  258: 	      Other1 ->
  259: 		  test_server:fail({unexpected_message, Other1})
  260: 	  end,
  261:     ?line receive
  262: 	      {'EXIT', Pid, die} ->
  263: 		  ok;
  264: 	      Other2 ->
  265: 		  test_server:fail({unexpected_message, Other2})
  266: 	  end,
  267: 
  268:     ?line test_server:timetrap_cancel(Dog),
  269:     ok.
  270: 
  271: %% The same scenario as above, but the port has been explicitly
  272: %% unlinked from the process.
  273: 
  274: no_trap_exit_unlinked(suite) -> [];
  275: no_trap_exit_unlinked(Config) when is_list(Config) ->
  276:     ?line Dog = test_server:timetrap(test_server:seconds(10)),
  277:     ?line process_flag(trap_exit, true),
  278:     ?line Pid = fun_spawn(fun no_trap_exit_process/3,
  279: 			  [self(), unlink, Config]),
  280:     ?line receive
  281: 	      {Pid, port_created, Port} ->
  282: 		  io:format("Process ~w created port ~w", [Pid, Port]),
  283: 		  ?line exit(Port, die);
  284: 	      Other1 ->
  285: 		  test_server:fail({unexpected_message, Other1})
  286: 	  end,
  287:     ?line receive
  288: 	      {'EXIT', Pid, normal} ->
  289: 		  ok;
  290: 	      Other2 ->
  291: 		  test_server:fail({unexpected_message, Other2})
  292: 	  end,
  293:     ?line test_server:timetrap_cancel(Dog),
  294:     ok.
  295: 
  296: no_trap_exit_process(ResultTo, Link, Config) ->
  297:     ?line load_busy_driver(Config),
  298:     ?line _Master = open_port({spawn, "busy_drv master"}, [eof]),
  299:     ?line Slave = open_port({spawn, "busy_drv slave"}, [eof]),
  300:     ?line case Link of
  301: 	      linked -> ok;
  302: 	      unlink -> unlink(Slave)
  303: 	  end,
  304:     ?line (catch port_command(Slave, "lock port")),
  305:     ?line ResultTo ! {self(), port_created, Slave},
  306:     ?line (catch port_command(Slave, "suspend me")),
  307:     ok.
  308: 
  309: %% Assuming the following scenario,
  310: %%
  311: %%  +---------------+		       +-----------+
  312: %%  | process with  |		       |           |
  313: %%  | trap_exit     |------------------| busy port |
  314: %%  | (suspended)   |		       |	   |
  315: %%  +---------------+		       +-----------+
  316: %%
  317: %% tests that the suspended process is scheduled runnable and
  318: %% receives an 'EXIT' message if the port is killed.
  319: 
  320: trap_exit(suite) -> [];
  321: trap_exit(Config) when is_list(Config) ->
  322:     ?line Dog = test_server:timetrap(test_server:seconds(10)),
  323:     ?line Pid = fun_spawn(fun busy_port_exit_process/2, [self(), Config]),
  324:     ?line receive
  325: 	      {Pid, port_created, Port} ->
  326: 		  io:format("Process ~w created port ~w", [Pid, Port]),
  327: 		  ?line unlink(Pid),
  328: 		  ?line {status, suspended} = process_info(Pid, status),
  329: 		  ?line exit(Port, die);
  330: 	      Other1 ->
  331: 		  test_server:fail({unexpected_message, Other1})
  332: 	  end,
  333:     ?line receive
  334: 	      {Pid, ok} ->
  335: 		  ok;
  336: 	      Other2 ->
  337: 		  test_server:fail({unexpected_message, Other2})
  338: 	  end,
  339:     ?line test_server:timetrap_cancel(Dog),
  340:     ok.
  341: 
  342: busy_port_exit_process(ResultTo, Config) ->
  343:     ?line process_flag(trap_exit, true),
  344:     ?line load_busy_driver(Config),
  345:     ?line _Master = open_port({spawn, "busy_drv master"}, [eof]),
  346:     ?line Slave = open_port({spawn, "busy_drv slave"}, [eof]),
  347:     ?line (catch port_command(Slave, "lock port")),
  348:     ?line ResultTo ! {self(), port_created, Slave},
  349:     ?line (catch port_command(Slave, "suspend me")),
  350:     receive
  351: 	{'EXIT', Slave, die} ->
  352: 	    ResultTo ! {self(), ok};
  353: 	Other ->
  354: 	    ResultTo ! {self(), {unexpected_message, Other}}
  355:     end.
  356: 
  357: %% Tests that several processes suspended by a write to a busy port
  358: %% will start running as soon as the port becamomes ready.
  359: %% This should work even if some of the processes have terminated
  360: %% in the meantime.
  361: 
  362: multiple_writers(suite) -> [];
  363: multiple_writers(Config) when is_list(Config) ->
  364:     ?line Dog = test_server:timetrap(test_server:seconds(10)),
  365:     ?line start_busy_driver(Config),
  366:     ?line process_flag(trap_exit, true),
  367: 
  368:     %% Start the waiters and make sure they have blocked.
  369:     ?line W1 = fun_spawn(fun quick_writer/0),
  370:     ?line W2 = fun_spawn(fun quick_writer/0),
  371:     ?line W3 = fun_spawn(fun quick_writer/0),
  372:     ?line W4 = fun_spawn(fun quick_writer/0),
  373:     ?line W5 = fun_spawn(fun quick_writer/0),
  374:     ?line test_server:sleep(500),		% Make sure writers have blocked.
  375: 
  376:     %% Kill two of the processes.
  377:     exit(W1, kill),
  378:     receive {'EXIT', W1, killed} -> ok end,
  379:     exit(W3, kill),
  380:     receive {'EXIT', W3, killed} -> ok end,
  381: 
  382:     %% Unlock the port.  The surviving processes should be become runnable.
  383:     ?line unlock_slave(),
  384:     ?line wait_for([W2, W4, W5]),
  385:     
  386:     ?line test_server:timetrap_cancel(Dog),
  387:     ok.
  388: 
  389: quick_writer() ->
  390:     {Owner, Port} = get_slave(),
  391:     (catch port_command(Port, "port to busy")),
  392:     (catch port_command(Port, "lock me")),
  393:     ok.
  394: 
  395: hard_busy_driver(Config) when is_list(Config) ->
  396:     hs_test(Config, true).
  397: 
  398: soft_busy_driver(Config) when is_list(Config) ->
  399:     hs_test(Config, false).
  400: 
  401: hs_test(Config, HardBusy) when is_list(Config) ->
  402:     ?line DrvName = case HardBusy of
  403: 			true -> 'hard_busy_drv';
  404: 			false -> 'soft_busy_drv'
  405: 		    end,
  406:     ?line erl_ddll:start(),
  407:     ?line Path = ?config(data_dir, Config),
  408:     case erl_ddll:load_driver(Path, DrvName) of
  409: 	ok -> ok;
  410: 	{error, Error} ->
  411: 	    io:format("~s\n", [erl_ddll:format_error(Error)]),
  412: 	    ?line ?t:fail()
  413:     end,
  414: 
  415:     ?line Port = open_port({spawn, DrvName}, []),
  416:     
  417:     NotSuspended = fun (Proc) ->
  418: 			   chk_not_value({status,suspended},
  419: 					 process_info(Proc, status))
  420: 		   end,
  421:     NotBusyEnd = fun (Proc, Res, Time) ->
  422: 			 receive
  423: 			     {Port, caller, Proc} -> ok
  424: 			 after
  425: 			     500 -> exit(missing_caller_message)
  426: 			 end,
  427: 			 chk_value({return, true}, Res),
  428: 			 chk_range(0, Time, 100)
  429: 		 end,    
  430:     ForceEnd = fun (Proc, Res, Time) ->
  431: 		       case HardBusy of
  432: 			   false ->
  433: 			       NotBusyEnd(Proc, Res, Time);
  434: 			   true ->
  435: 			       chk_value({error, notsup}, Res),
  436: 			       chk_range(0, Time, 100),
  437: 			       receive
  438: 				   Msg -> exit({unexpected_msg, Msg})
  439: 			       after
  440: 				   500 -> ok
  441: 			       end
  442: 		       end
  443: 	       end,
  444:     BadArg = fun (_Proc, Res, Time) ->
  445: 		     chk_value({error, badarg}, Res),
  446: 		     chk_range(0, Time, 100)
  447: 	     end,
  448: 
  449:     %% Not busy
  450: 
  451:     %% Not busy; nosuspend option
  452:     ?line hs_busy_pcmd(Port, [nosuspend], NotSuspended, NotBusyEnd),
  453: 
  454:     %% Not busy; force option
  455:     ?line hs_busy_pcmd(Port, [force], NotSuspended, ForceEnd),
  456: 
  457:     %% Not busy; force and nosuspend option
  458:     ?line hs_busy_pcmd(Port, [force, nosuspend], NotSuspended, ForceEnd),
  459: 
  460:     %% Not busy; no option
  461:     ?line hs_busy_pcmd(Port, [], NotSuspended, NotBusyEnd),
  462: 
  463:     %% Not busy; bad option
  464:     ?line hs_busy_pcmd(Port, [bad_option], NotSuspended, BadArg),
  465: 
  466: 
  467:     %% Make busy
  468:     ?line erlang:port_control(Port, $B, []),
  469: 
  470: 
  471:     %% Busy; nosuspend option
  472:     ?line hs_busy_pcmd(Port, [nosuspend], NotSuspended,
  473: 		       fun (_Proc, Res, Time) ->
  474: 			       chk_value({return, false}, Res),
  475: 			       chk_range(0, Time, 100),
  476: 			       receive
  477: 				   Msg -> exit({unexpected_msg, Msg})
  478: 			       after
  479: 				   500 -> ok
  480: 			       end
  481: 		       end),
  482: 
  483:     %% Busy; force option
  484:     ?line hs_busy_pcmd(Port, [force], NotSuspended, ForceEnd),
  485: 
  486:     %% Busy; force and nosuspend option
  487:     ?line hs_busy_pcmd(Port, [force, nosuspend], NotSuspended, ForceEnd),
  488: 
  489:     %% Busy; bad option
  490:     ?line hs_busy_pcmd(Port, [bad_option], NotSuspended, BadArg),
  491: 
  492:     %% no option on busy port
  493:     ?line hs_busy_pcmd(Port, [],
  494: 		       fun (Proc) ->
  495: 			       receive after 1000 -> ok end,
  496: 			       chk_value({status,suspended},
  497: 					 process_info(Proc, status)),
  498: 
  499: 			       %% Make not busy
  500: 			       erlang:port_control(Port, $N, [])
  501: 		       end,
  502: 		       fun (_Proc, Res, Time) ->
  503: 			       chk_value({return, true}, Res),
  504: 			       chk_range(1000, Time, 2000)
  505: 		       end),
  506: 
  507:     ?line true = erlang:port_close(Port),
  508:     ?line ok = erl_ddll:unload_driver(DrvName),
  509:     ?line ok = erl_ddll:stop(),
  510:     ?line ok.
  511: 
  512: hs_busy_pcmd(Prt, Opts, StartFun, EndFun) ->
  513:     Tester = self(),
  514:     P = spawn_link(fun () ->
  515: 			   erlang:yield(),
  516: 			   Tester ! {self(), doing_port_command},
  517: 			   Start = now(),
  518: 			   Res = try {return,
  519: 				      port_command(Prt, [], Opts)}
  520: 				 catch Exception:Error -> {Exception, Error}
  521: 				 end,
  522: 			   End = now(),
  523: 			   Time = round(timer:now_diff(End, Start)/1000),
  524: 			   Tester ! {self(), port_command_result, Res, Time}
  525: 		   end),
  526:     receive
  527: 	{P, doing_port_command} ->
  528: 	    ok
  529:     end,
  530:     StartFun(P),
  531:     receive
  532: 	{P, port_command_result, Res, Time} ->
  533: 	    EndFun(P, Res, Time)
  534:     end.
  535: 
  536: scheduling_delay_busy(Config) ->
  537:     
  538:     Scenario = 
  539: 	[{1,{spawn,[{var,drvname},undefined]}},
  540: 	 {2,{call,[{var,1},open_port]}},
  541: 	 {3,{spawn,[{var,2},{var,1}]}},
  542: 	 {0,{ack,[{var,1},{busy,1,250}]}},
  543: 	 {0,{cast,[{var,3},{command,2}]}},
  544: 	 [{0,{cast,[{var,3},{command,I}]}} 
  545: 	  || I <- lists:seq(3,50)],
  546: 	 {0,{cast,[{var,3},take_control]}},
  547: 	 {0,{cast,[{var,1},{new_owner,{var,3}}]}},
  548: 	 {0,{cast,[{var,3},close]}},
  549: 	 {0,{timer,sleep,[300]}},
  550: 	 {0,{erlang,port_command,[{var,2},<<$N>>,[force]]}},
  551: 	 [{0,{cast,[{var,1},{command,I}]}} 
  552: 	  || I <- lists:seq(101,127)]
  553: 	 ,{10,{call,[{var,3},get_data]}}
  554: 	 ],
  555: 
  556:     Validation = [{seq,10,lists:seq(1,50)}],
  557: 
  558:     port_scheduling(Scenario,Validation,?config(data_dir,Config)).
  559: 
  560: scheduling_delay_busy_nosuspend(Config) ->
  561: 
  562:     Scenario = 
  563: 	[{1,{spawn,[{var,drvname},undefined]}},
  564: 	 {2,{call,[{var,1},open_port]}},
  565: 	 {0,{cast,[{var,1},{command,1,100}]}},
  566: 	 {0,{cast,[{var,1},{busy,2}]}},
  567: 	 {0,{timer,sleep,[200]}}, % ensure reached port
  568: 	 {10,{call,[{var,1},{command,3,[nosuspend]}]}},
  569: 	 {0,{timer,sleep,[200]}},
  570: 	 {0,{erlang,port_command,[{var,2},<<$N>>,[force]]}},
  571: 	 {0,{cast,[{var,1},close]}},
  572: 	 {20,{call,[{var,1},get_data]}}
  573: 	 ],
  574: 
  575:     Validation = [{eq,10,nosuspend},{seq,20,[1,2]}],
  576: 
  577:     port_scheduling(Scenario,Validation,?config(data_dir,Config)).
  578: 
  579: scheduling_busy_link(Config) ->
  580:     
  581:     Scenario = 
  582: 	[{1,{spawn,[{var,drvname},undefined]}},
  583: 	 {2,{call,[{var,1},open_port]}},
  584: 	 {3,{spawn,[{var,2},{var,1}]}},
  585: 	 {0,{cast,[{var,1},unlink]}},
  586: 	 {0,{cast,[{var,1},{busy,1}]}},
  587: 	 {0,{cast,[{var,1},{command,2}]}},
  588: 	 {0,{cast,[{var,1},link]}},
  589: 	 {0,{timer,sleep,[1000]}},
  590: 	 {0,{ack,[{var,3},take_control]}},
  591: 	 {0,{cast,[{var,1},{new_owner,{var,3}}]}},
  592: 	 {0,{cast,[{var,3},close]}},
  593: 	 {10,{call,[{var,3},get_data]}},
  594: 	 {20,{call,[{var,1},get_exit]}}
  595: 	 ],
  596: 
  597:     Validation = [{seq,10,[1]},
  598: 		  {seq,20,[{'EXIT',noproc}]}],
  599: 
  600:     port_scheduling(Scenario,Validation,?config(data_dir,Config)).
  601: 
  602: process_init(DrvName,Owner) ->
  603:     process_flag(trap_exit,true),
  604:     process_loop(DrvName,Owner, {[],[]}).
  605: 
  606: process_loop(DrvName,undefined,Data) when is_list(DrvName) ->
  607:     process_loop(DrvName,[binary],Data);
  608: process_loop(DrvName,PortOpts,Data) when is_list(DrvName) ->
  609:     receive
  610: 	{call,open_port,P} ->
  611: 	    Port = open_port({spawn, DrvName}, PortOpts),
  612: 	    send(P,Port),
  613: 	    process_loop(Port,self(),Data)
  614:     end;
  615: process_loop(Port,undefined,Data) ->
  616:     receive
  617: 	{cast,{new_owner,Pid}} ->
  618: 	    pal("NewOwner: ~p",[Pid]),
  619: 	    process_loop(Port,Pid,Data)
  620:     end;
  621: process_loop(Port,Owner,{Data,Exit} = DE) ->
  622:     receive
  623: 	{Port,connected} ->
  624: 	    pal("Connected",[]),
  625: 	    process_loop(Port,undefined,DE);	
  626: 	{Port,{data,NewData}} ->
  627: 	    pal("Got: ~p",[NewData]),
  628: 	    receive
  629: 		{Port,closed} ->
  630: 		    process_loop(Port,Owner,{Data ++ [NewData],Exit})
  631: 	    after 2000 ->
  632: 		    exit(did_not_get_port_close)
  633: 	    end;
  634: 	{'EXIT',Port,Reason} = Exit ->
  635: 	    pal("Exit: ~p",[Exit]),
  636: 	    process_loop(Port,Owner,{Data, Exit ++ [[{'EXIT',Reason}]]});
  637: 	{'EXIT',_Port,_Reason} = Exit ->
  638: 	    pal("Exit: ~p",[Exit]);
  639: 	{call,Msg,P} ->
  640: 	    case handle_msg(Msg,Port,Owner,DE) of
  641: 		{Reply,NewOwner,NewData} ->
  642: 		    send(P,Reply),
  643: 		    process_loop(Port,NewOwner,NewData);
  644: 		Reply ->
  645: 		    send(P,Reply),
  646: 		    process_loop(Port,Owner,DE)
  647: 	    end;
  648: 	{ack,Msg,P} ->
  649: 	    send(P,ok),
  650: 	    case handle_msg(Msg,Port,Owner,DE) of
  651: 		{_Reply,NewOwner,NewData} ->
  652: 		    process_loop(Port,NewOwner,NewData);
  653: 		_Reply ->
  654: 		    process_loop(Port,Owner,DE)
  655: 	    end;
  656: 	{cast,Msg} when is_atom(Msg) orelse element(1,Msg) /= new_owner ->
  657: 	    case handle_msg(Msg,Port,Owner,DE) of
  658: 		{_Reply,NewOwner,NewData} ->
  659: 		    process_loop(Port,NewOwner,NewData);
  660: 		_ ->
  661: 		    process_loop(Port,Owner,DE)
  662: 	    end
  663:     end.
  664: 
  665: handle_msg({busy,Value,Delay},Port,Owner,_Data) ->
  666:     pal("Long busy: ~p",[Value]),
  667:     send(Port,{Owner,{command,<<$L,Value:32,(round(Delay/100))>>}});
  668: handle_msg({busy,Value},Port,Owner,_Data)  ->
  669:     pal("Busy: ~p",[Value]),
  670:     send(Port,{Owner,{command,<<$B,Value:32>>}});
  671: handle_msg({command,Value},Port,Owner,_Data)  ->
  672:     pal("Short: ~p",[Value]),
  673:     send(Port,{Owner,{command,<<$C,Value:32>>}});
  674: handle_msg({command,Value,Delay},Port,Owner,_Data) when is_integer(Delay) ->
  675:     pal("Long: ~p",[Value]),
  676:     send(Port,{Owner,{command,<<$D,Value:32,(round(Delay/100))>>}});
  677: handle_msg({command,Value,Opts},Port,Owner,_Data)  ->
  678:     pal("Short Opt: ~p",[Value]),
  679:     send(Port,{Owner,{command,<<$C,Value:32>>}},Opts);
  680: handle_msg({command,Value,Opts,Delay},Port,Owner,_Data)  ->
  681:     pal("Long Opt: ~p",[Value]),
  682:     send(Port,{Owner,{command,<<$D,Value:32,(round(Delay/100))>>}},Opts);
  683: handle_msg(take_control,Port,Owner,Data)  ->
  684:     pal("Connect: ~p",[self()]),
  685:     send(Port,{Owner, {connect, self()}}),
  686:     {undefined,self(),Data};
  687: handle_msg(unlink,Port,_Owner,_Data) ->
  688:     pal("Unlink:",[]),
  689:     erlang:unlink(Port);
  690: handle_msg(link,Port,_Owner,_Data) ->
  691:     pal("Link:",[]),
  692:     erlang:link(Port);
  693: handle_msg(close,Port,Owner,_Data)  ->
  694:     pal("Close",[]),
  695:     send(Port,{Owner,close});
  696: handle_msg(get_data,Port,_Owner,{[],_Exit})  ->
  697:     %% Wait for data if it has not arrived yet
  698:     receive
  699: 	{Port,{data,Data}} ->
  700: 	    Data
  701:     after 2000 ->
  702: 	    pal("~p",[erlang:process_info(self())]),
  703: 	    exit(did_not_get_port_data)
  704:     end;
  705: handle_msg(get_data,_Port,Owner,{Data,Exit})  ->
  706:     pal("GetData",[]),
  707:     {hd(Data),Owner,{tl(Data),Exit}};
  708: handle_msg(get_exit,Port,_Owner,{_Data,[]})  ->
  709:     %% Wait for exit if it has not arrived yet
  710:     receive
  711: 	{'EXIT',Port,Reason} ->
  712: 	    [{'EXIT',Reason}]
  713:     after 2000 ->
  714: 	    pal("~p",[erlang:process_info(self())]),
  715: 	    exit(did_not_get_port_exit)
  716:     end;
  717: handle_msg(get_exit,_Port,Owner,{Data,Exit}) ->
  718:     {hd(Exit),Owner,{Data,tl(Exit)}}.
  719: 
  720:     
  721: 
  722: call(Pid,Msg) ->
  723:     pal("call(~p,~p)",[Pid,Msg]),
  724:     send(Pid,{call,Msg,self()}),
  725:     receive
  726: 	Ret ->
  727: 	    Ret
  728:     end.
  729: ack(Pid,Msg) ->
  730:     pal("ack(~p,~p)",[Pid,Msg]),
  731:     send(Pid,{ack,Msg,self()}),
  732:     receive
  733: 	Ret ->
  734: 	    Ret
  735:     end.
  736: 
  737: cast(Pid,Msg) ->
  738:     pal("cast(~p,~p)",[Pid,Msg]),
  739:     send(Pid,{cast,Msg}).
  740: 
  741: send(Pid,Msg) ->
  742:     erlang:send(Pid,Msg).
  743: send(Prt,Msg,Opts) ->
  744:     erlang:send(Prt,Msg,Opts).
  745: 
  746: 
  747: port_scheduling(Scenario,Validation,Path) ->
  748:     DrvName = "scheduling_drv",
  749:     erl_ddll:start(),
  750:     case erl_ddll:load_driver(Path, DrvName) of
  751: 	ok -> ok;
  752: 	{error, Error} ->
  753: 	    io:format("~s\n", [erl_ddll:format_error(Error)]),
  754: 	    ?line ?t:fail()
  755:     end,
  756: 
  757:     Data = run_scenario(lists:flatten(Scenario),[{drvname,DrvName}]),
  758:     ok = validate_scenario(Data,Validation).
  759: 
  760: 
  761: run_scenario([{V,{Module,Cmd,Args}}|T],Vars) ->
  762:     Res = run_command(Module,Cmd,
  763: 		      replace_args(Args,Vars)),
  764:     run_scenario(T,[{V,Res}|Vars]);
  765: run_scenario([{V,{Cmd,Args}}|T],Vars) ->
  766:     run_scenario([{V,{?MODULE,Cmd,Args}}|T],Vars);
  767: run_scenario([],Vars) ->
  768:     Vars.
  769: 
  770: run_command(_M,spawn,{Args,Opts}) ->
  771:     Pid = spawn_opt(fun() -> apply(?MODULE,process_init,Args) end,[link|Opts]),
  772:     pal("spawn(~p): ~p",[Args,Pid]),
  773:     Pid;
  774: run_command(M,spawn,Args) ->
  775:     run_command(M,spawn,{Args,[]});
  776: run_command(Mod,Func,Args) ->
  777:     erlang:display({{Mod,Func,Args},now()}),
  778:     apply(Mod,Func,Args).
  779: 
  780: validate_scenario(Data,[{print,Var}|T]) ->
  781:     pal("Val: ~p",[proplists:get_value(Var,Data)]),
  782:     validate_scenario(Data,T);
  783: validate_scenario(Data,[{eq,Var,Value}|T]) ->
  784:     case proplists:get_value(Var,Data) of
  785: 	Value ->
  786: 	    validate_scenario(Data,T);
  787: 	Else ->
  788: 	    exit({eq_return,Value,Else})
  789:     end;
  790: validate_scenario(Data,[{neq,Var,Value}|T]) ->
  791:     case proplists:get_value(Var,Data) of
  792: 	Value ->
  793: 	    exit({neq_return,Value});
  794: 	_Else ->
  795: 	    validate_scenario(Data,T)
  796:     end;
  797: validate_scenario(Data,[{seq,Var,Seq}|T]) ->
  798:     try
  799: 	validate_sequence(proplists:get_value(Var,Data),Seq)
  800:     catch _:{validate_sequence,NotFound} ->
  801: 	    exit({validate_sequence,NotFound,Data})
  802:     end,
  803:     validate_scenario(Data,T);
  804: validate_scenario(_,[]) ->
  805:     ok.
  806: 
  807: validate_sequence(Data,Validation) when is_binary(Data) ->
  808:     validate_sequence(binary_to_list(Data),Validation);	    
  809: validate_sequence([H|R],[H|T]) ->
  810:     validate_sequence(R,T);
  811: validate_sequence([_|R],Seq) ->
  812:     validate_sequence(R,Seq);
  813: validate_sequence(_,[]) ->
  814:     ok;
  815: validate_sequence([],NotFound) ->
  816:     exit({validate_sequence,NotFound}).
  817: 
  818: replace_args({var,Var},Vars) ->
  819:     proplists:get_value(Var,Vars);
  820: replace_args([H|T],Vars) ->
  821:     [replace_args(H,Vars)|replace_args(T,Vars)];
  822: replace_args([],_Vars) ->
  823:     [];
  824: replace_args(Tuple,Vars) when is_tuple(Tuple) ->
  825:     list_to_tuple(replace_args(tuple_to_list(Tuple),Vars));
  826: replace_args(Else,_Vars) ->
  827:     Else.
  828: 
  829: pal(_F,_A) -> ok.
  830: %pal(Format,Args) ->
  831: %    ct:pal("~p "++Format,[self()|Args]).
  832: %    erlang:display(lists:flatten(io_lib:format("~p "++Format,[self()|Args]))).
  833: 			
  834: 
  835: %%% Utilities.
  836: 
  837: chk_range(Min, Val, Max) when Min =< Val, Val =< Max ->
  838:     ok;
  839: chk_range(Min, Val, Max) ->
  840:     exit({bad_range, Min, Val, Max}).
  841: 
  842: chk_value(Exp, Exp) ->
  843:     ok;
  844: chk_value(Exp, Val) ->
  845:     exit({unexpected_value, Val, expected, Exp}).
  846: 
  847: chk_not_value(NotExp, NotExp) ->
  848:     exit({unexpected_not_value, NotExp});
  849: chk_not_value(_, _) ->
  850:     ok.
  851: 
  852: wait_for([]) ->
  853:     ok;
  854: wait_for(Pids) ->
  855:     io:format("Waiting for ~p", [Pids]),
  856:     receive
  857: 	{'EXIT', Pid, normal} ->
  858: 	    wait_for(lists:delete(Pid, Pids));
  859: 	Other ->
  860: 	    test_server:fail({bad_exit, Other})
  861:     end.
  862: 
  863: fun_spawn(Fun) ->
  864:     fun_spawn(Fun, []).
  865: 
  866: fun_spawn(Fun, Args) ->
  867:     spawn_link(erlang, apply, [Fun, Args]).
  868: 
  869: %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  870: %% These routines provide a port which will become busy when the
  871: %% the first message is sent to it.  The unlock_slave/0 function can
  872: %% be called (from another process) to make the port non-busy.
  873: %%
  874: %% Typical usage:
  875: %%
  876: %% start_busy_driver(Config)		Load driver; start server.
  877: %%
  878: %% 		        P r o c e s s   O n e
  879: %% {Owner, Port} = get_slave()	O	Obtain port and its owner.
  880: %% Port ! {Owner, {command, List}}	Send to port (will not block
  881: %%					but port will become busy).
  882: %% Port ! {Owner, {command, List}}	Will block the process.
  883: %%
  884: %% 		        P r o c e s s   T w o
  885: %% unlock_slave()			Set port to non-busy.  Process One
  886: %%				        will continue executing.  Further
  887: %%					writes to the port will not block.
  888: %%
  889: %% Any process can call busy_drv:lock() to lock the port again.
  890: %%
  891: %% Note: This module must be used in an installed test suite (outside of
  892: %% clearcase).
  893: %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  894: 
  895: load_busy_driver(Config) when is_list(Config) ->
  896:     ?line DataDir = ?config(data_dir, Config),
  897:     ?line erl_ddll:start(),
  898:     case erl_ddll:load_driver(DataDir, "busy_drv") of
  899: 	ok -> ok;
  900: 	{error, Error} ->
  901: 	    io:format("~s\n", [erl_ddll:format_error(Error)]),
  902: 	    ?line ?t:fail()
  903:     end.
  904: 
  905: %%% Interface functions.
  906: 
  907: start_busy_driver(Config) when is_list(Config) ->
  908:     ?line Pid = spawn_link(?MODULE, init, [Config, self()]),
  909:     ?line receive
  910: 	      {Pid, started} ->
  911: 		  ok;
  912: 	      Other ->
  913: 		  test_server:fail({unexpected_message, Other})
  914: 	  end.
  915: 
  916: unlock_slave() ->
  917:     command(unlock).
  918: 
  919: get_slave() ->
  920:     ?line command(get_slave).
  921: 
  922: %% Internal functions.
  923: 
  924: command(Msg) ->
  925:     ?line whereis(busy_drv_server) ! {self(), Msg},
  926:     ?line receive
  927: 	      {busy_drv_reply, Reply} ->
  928: 		  Reply
  929:     end.
  930: 
  931: %%% Server.
  932: 
  933: init(Config, ReplyTo) ->
  934:     register(busy_drv_server, self()),
  935:     load_busy_driver(Config),
  936:     Driver = "busy_drv",
  937:     Master = open_port({spawn, Driver++" master"}, []),
  938:     Slave = open_port({spawn, Driver++" slave"}, []),
  939:     ReplyTo ! {self(), started},
  940:     loop(Master, Slave).
  941: 
  942: loop(Master, Slave) ->
  943:     receive
  944: 	{Pid, get_master} ->
  945: 	    Pid ! {busy_drv_reply, Master},
  946: 	    loop(Master, Slave);
  947: 	{Pid, get_slave} ->
  948: 	    Pid ! {busy_drv_reply, {self(), Slave}},
  949: 	    loop(Master, Slave);
  950: 	{Pid, unlock} ->
  951: 	    port_command(Master, "u"),
  952: 	    Pid ! {busy_drv_reply, ok},
  953: 	    loop(Master, Slave);
  954: 	{Pid, lock} ->
  955: 	    port_command(Master, "l"),
  956: 	    Pid ! {busy_drv_reply, ok},
  957: 	    loop(Master, Slave);
  958: 	{Pid, {port_command,Data}} ->
  959: 	    erlang:port_command(Slave, Data),
  960: 	    Pid ! {busy_drv_reply, ok},
  961: 	    loop(Master, Slave);
  962: 	{Pid, stop} ->
  963: 	    Pid ! {busy_drv_reply, ok}
  964:     end.