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