1 ------------------------------------------------------------------------------
3 -- GNAT LIBRARY COMPONENTS --
5 -- G N A T . E X P E C T --
9 -- Copyright (C) 2002-2007, AdaCore --
11 -- GNAT is free software; you can redistribute it and/or modify it under --
12 -- terms of the GNU General Public License as published by the Free Soft- --
13 -- ware Foundation; either version 2, or (at your option) any later ver- --
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
16 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
17 -- for more details. You should have received a copy of the GNU General --
18 -- Public License distributed with GNAT; see file COPYING. If not, write --
19 -- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
20 -- Boston, MA 02110-1301, USA. --
22 -- As a special exception, if other files instantiate generics from this --
23 -- unit, or you link this unit with other files to produce an executable, --
24 -- this unit does not by itself cause the resulting executable to be --
25 -- covered by the GNU General Public License. This exception does not --
26 -- however invalidate any other reasons why the executable file might be --
27 -- covered by the GNU Public License. --
29 -- GNAT was originally developed by the GNAT team at New York University. --
30 -- Extensive contributions were provided by Ada Core Technologies Inc. --
32 ------------------------------------------------------------------------------
34 -- This is the VMS version
36 with System; use System;
37 with Ada.Calendar; use Ada.Calendar;
40 with GNAT.OS_Lib; use GNAT.OS_Lib;
41 with GNAT.Regpat; use GNAT.Regpat;
43 with Ada.Unchecked_Deallocation;
45 package body GNAT.Expect is
47 type Array_Of_Pd is array (Positive range <>) of Process_Descriptor_Access;
49 Save_Input : File_Descriptor;
50 Save_Output : File_Descriptor;
51 Save_Error : File_Descriptor;
53 procedure Expect_Internal
54 (Descriptors : in out Array_Of_Pd;
55 Result : out Expect_Match;
57 Full_Buffer : Boolean);
58 -- Internal function used to read from the process Descriptor.
60 -- Three outputs are possible:
61 -- Result=Expect_Timeout, if no output was available before the timeout
63 -- Result=Expect_Full_Buffer, if Full_Buffer is True and some characters
64 -- had to be discarded from the internal buffer of Descriptor.
65 -- Result=<integer>, indicates how many characters were added to the
66 -- internal buffer. These characters are from indexes
67 -- Descriptor.Buffer_Index - Result + 1 .. Descriptor.Buffer_Index
68 -- Process_Died is raised if the process is no longer valid.
70 procedure Reinitialize_Buffer
71 (Descriptor : in out Process_Descriptor'Class);
72 -- Reinitialize the internal buffer.
73 -- The buffer is deleted up to the end of the last match.
75 procedure Free is new Ada.Unchecked_Deallocation
76 (Pattern_Matcher, Pattern_Matcher_Access);
78 procedure Call_Filters
79 (Pid : Process_Descriptor'Class;
81 Filter_On : Filter_Type);
82 -- Call all the filters that have the appropriate type.
83 -- This function does nothing if the filters are locked
85 ------------------------------
86 -- Target dependent section --
87 ------------------------------
89 function Dup (Fd : File_Descriptor) return File_Descriptor;
90 pragma Import (C, Dup, "decc$dup");
92 procedure Dup2 (Old_Fd, New_Fd : File_Descriptor);
93 pragma Import (C, Dup2, "decc$dup2");
95 procedure Kill (Pid : Process_Id; Sig_Num : Integer);
96 pragma Import (C, Kill, "decc$kill");
98 function Create_Pipe (Pipe : not null access Pipe_Type) return Integer;
99 pragma Import (C, Create_Pipe, "__gnat_pipe");
102 (Fds : System.Address;
105 Is_Set : System.Address) return Integer;
106 pragma Import (C, Poll, "__gnat_expect_poll");
107 -- Check whether there is any data waiting on the file descriptor
108 -- Out_fd, and wait if there is none, at most Timeout milliseconds
109 -- Returns -1 in case of error, 0 if the timeout expired before
110 -- data became available.
112 -- Out_Is_Set is set to 1 if data was available, 0 otherwise.
114 function Waitpid (Pid : Process_Id) return Integer;
115 pragma Import (C, Waitpid, "__gnat_waitpid");
116 -- Wait for a specific process id, and return its exit code
122 function "+" (S : String) return GNAT.OS_Lib.String_Access is
124 return new String'(S);
132 (P : GNAT.Regpat.Pattern_Matcher) return Pattern_Matcher_Access
135 return new GNAT.Regpat.Pattern_Matcher'(P);
143 (Descriptor : in out Process_Descriptor;
144 Filter : Filter_Function;
145 Filter_On : Filter_Type := Output;
146 User_Data : System.Address := System.Null_Address;
147 After : Boolean := False)
149 Current : Filter_List := Descriptor.Filters;
153 while Current /= null and then Current.Next /= null loop
154 Current := Current.Next;
157 if Current = null then
158 Descriptor.Filters :=
159 new Filter_List_Elem'
160 (Filter => Filter, Filter_On => Filter_On,
161 User_Data => User_Data, Next => null);
164 new Filter_List_Elem'
165 (Filter => Filter, Filter_On => Filter_On,
166 User_Data => User_Data, Next => null);
170 Descriptor.Filters :=
171 new Filter_List_Elem'
172 (Filter => Filter, Filter_On => Filter_On,
173 User_Data => User_Data, Next => Descriptor.Filters);
181 procedure Call_Filters
182 (Pid : Process_Descriptor'Class;
184 Filter_On : Filter_Type)
186 Current_Filter : Filter_List;
189 if Pid.Filters_Lock = 0 then
190 Current_Filter := Pid.Filters;
192 while Current_Filter /= null loop
193 if Current_Filter.Filter_On = Filter_On then
194 Current_Filter.Filter
195 (Pid, Str, Current_Filter.User_Data);
198 Current_Filter := Current_Filter.Next;
208 (Descriptor : in out Process_Descriptor;
209 Status : out Integer)
212 Close (Descriptor.Input_Fd);
214 if Descriptor.Error_Fd /= Descriptor.Output_Fd then
215 Close (Descriptor.Error_Fd);
218 Close (Descriptor.Output_Fd);
220 -- ??? Should have timeouts for different signals
222 if Descriptor.Pid > 0 then -- see comment in Send_Signal
223 Kill (Descriptor.Pid, Sig_Num => 9);
226 GNAT.OS_Lib.Free (Descriptor.Buffer);
227 Descriptor.Buffer_Size := 0;
229 -- Check process id (see comment in Send_Signal)
231 if Descriptor.Pid > 0 then
232 Status := Waitpid (Descriptor.Pid);
234 raise Invalid_Process;
238 procedure Close (Descriptor : in out Process_Descriptor) is
241 Close (Descriptor, Status);
249 (Descriptor : in out Process_Descriptor;
250 Result : out Expect_Match;
252 Timeout : Integer := 10000;
253 Full_Buffer : Boolean := False)
257 Expect (Descriptor, Result, Never_Match, Timeout, Full_Buffer);
259 Expect (Descriptor, Result, Compile (Regexp), Timeout, Full_Buffer);
264 (Descriptor : in out Process_Descriptor;
265 Result : out Expect_Match;
267 Matched : out GNAT.Regpat.Match_Array;
268 Timeout : Integer := 10000;
269 Full_Buffer : Boolean := False)
272 pragma Assert (Matched'First = 0);
275 (Descriptor, Result, Never_Match, Matched, Timeout, Full_Buffer);
278 (Descriptor, Result, Compile (Regexp), Matched, Timeout,
284 (Descriptor : in out Process_Descriptor;
285 Result : out Expect_Match;
286 Regexp : GNAT.Regpat.Pattern_Matcher;
287 Timeout : Integer := 10000;
288 Full_Buffer : Boolean := False)
290 Matched : GNAT.Regpat.Match_Array (0 .. 0);
293 Expect (Descriptor, Result, Regexp, Matched, Timeout, Full_Buffer);
297 (Descriptor : in out Process_Descriptor;
298 Result : out Expect_Match;
299 Regexp : GNAT.Regpat.Pattern_Matcher;
300 Matched : out GNAT.Regpat.Match_Array;
301 Timeout : Integer := 10000;
302 Full_Buffer : Boolean := False)
305 Descriptors : Array_Of_Pd := (1 => Descriptor'Unrestricted_Access);
306 Try_Until : constant Time := Clock + Duration (Timeout) / 1000.0;
307 Timeout_Tmp : Integer := Timeout;
310 pragma Assert (Matched'First = 0);
311 Reinitialize_Buffer (Descriptor);
314 -- First, test if what is already in the buffer matches (This is
315 -- required if this package is used in multi-task mode, since one of
316 -- the tasks might have added something in the buffer, and we don't
317 -- want other tasks to wait for new input to be available before
318 -- checking the regexps).
321 (Regexp, Descriptor.Buffer (1 .. Descriptor.Buffer_Index), Matched);
323 if Descriptor.Buffer_Index >= 1 and then Matched (0).First /= 0 then
325 Descriptor.Last_Match_Start := Matched (0).First;
326 Descriptor.Last_Match_End := Matched (0).Last;
330 -- Else try to read new input
332 Expect_Internal (Descriptors, N, Timeout_Tmp, Full_Buffer);
334 if N = Expect_Timeout or else N = Expect_Full_Buffer then
339 -- Calculate the timeout for the next turn
341 -- Note that Timeout is, from the caller's perspective, the maximum
342 -- time until a match, not the maximum time until some output is
343 -- read, and thus cannot be reused as is for Expect_Internal.
345 if Timeout /= -1 then
346 Timeout_Tmp := Integer (Try_Until - Clock) * 1000;
348 if Timeout_Tmp < 0 then
349 Result := Expect_Timeout;
355 -- Even if we had the general timeout above, we have to test that the
356 -- last test we read from the external process didn't match.
359 (Regexp, Descriptor.Buffer (1 .. Descriptor.Buffer_Index), Matched);
361 if Matched (0).First /= 0 then
363 Descriptor.Last_Match_Start := Matched (0).First;
364 Descriptor.Last_Match_End := Matched (0).Last;
370 (Descriptor : in out Process_Descriptor;
371 Result : out Expect_Match;
372 Regexps : Regexp_Array;
373 Timeout : Integer := 10000;
374 Full_Buffer : Boolean := False)
376 Patterns : Compiled_Regexp_Array (Regexps'Range);
377 Matched : GNAT.Regpat.Match_Array (0 .. 0);
380 for J in Regexps'Range loop
381 Patterns (J) := new Pattern_Matcher'(Compile (Regexps (J).all));
384 Expect (Descriptor, Result, Patterns, Matched, Timeout, Full_Buffer);
386 for J in Regexps'Range loop
392 (Descriptor : in out Process_Descriptor;
393 Result : out Expect_Match;
394 Regexps : Compiled_Regexp_Array;
395 Timeout : Integer := 10000;
396 Full_Buffer : Boolean := False)
398 Matched : GNAT.Regpat.Match_Array (0 .. 0);
401 Expect (Descriptor, Result, Regexps, Matched, Timeout, Full_Buffer);
405 (Result : out Expect_Match;
406 Regexps : Multiprocess_Regexp_Array;
407 Timeout : Integer := 10000;
408 Full_Buffer : Boolean := False)
410 Matched : GNAT.Regpat.Match_Array (0 .. 0);
413 Expect (Result, Regexps, Matched, Timeout, Full_Buffer);
417 (Descriptor : in out Process_Descriptor;
418 Result : out Expect_Match;
419 Regexps : Regexp_Array;
420 Matched : out GNAT.Regpat.Match_Array;
421 Timeout : Integer := 10000;
422 Full_Buffer : Boolean := False)
424 Patterns : Compiled_Regexp_Array (Regexps'Range);
427 pragma Assert (Matched'First = 0);
429 for J in Regexps'Range loop
430 Patterns (J) := new Pattern_Matcher'(Compile (Regexps (J).all));
433 Expect (Descriptor, Result, Patterns, Matched, Timeout, Full_Buffer);
435 for J in Regexps'Range loop
441 (Descriptor : in out Process_Descriptor;
442 Result : out Expect_Match;
443 Regexps : Compiled_Regexp_Array;
444 Matched : out GNAT.Regpat.Match_Array;
445 Timeout : Integer := 10000;
446 Full_Buffer : Boolean := False)
449 Descriptors : Array_Of_Pd := (1 => Descriptor'Unrestricted_Access);
452 pragma Assert (Matched'First = 0);
454 Reinitialize_Buffer (Descriptor);
457 -- First, test if what is already in the buffer matches (This is
458 -- required if this package is used in multi-task mode, since one of
459 -- the tasks might have added something in the buffer, and we don't
460 -- want other tasks to wait for new input to be available before
461 -- checking the regexps).
463 if Descriptor.Buffer /= null then
464 for J in Regexps'Range loop
467 Descriptor.Buffer (1 .. Descriptor.Buffer_Index),
470 if Matched (0) /= No_Match then
471 Result := Expect_Match (J);
472 Descriptor.Last_Match_Start := Matched (0).First;
473 Descriptor.Last_Match_End := Matched (0).Last;
479 Expect_Internal (Descriptors, N, Timeout, Full_Buffer);
481 if N = Expect_Timeout or else N = Expect_Full_Buffer then
489 (Result : out Expect_Match;
490 Regexps : Multiprocess_Regexp_Array;
491 Matched : out GNAT.Regpat.Match_Array;
492 Timeout : Integer := 10000;
493 Full_Buffer : Boolean := False)
496 Descriptors : Array_Of_Pd (Regexps'Range);
499 pragma Assert (Matched'First = 0);
501 for J in Descriptors'Range loop
502 Descriptors (J) := Regexps (J).Descriptor;
503 Reinitialize_Buffer (Regexps (J).Descriptor.all);
507 -- First, test if what is already in the buffer matches (This is
508 -- required if this package is used in multi-task mode, since one of
509 -- the tasks might have added something in the buffer, and we don't
510 -- want other tasks to wait for new input to be available before
511 -- checking the regexps).
513 for J in Regexps'Range loop
514 Match (Regexps (J).Regexp.all,
515 Regexps (J).Descriptor.Buffer
516 (1 .. Regexps (J).Descriptor.Buffer_Index),
519 if Matched (0) /= No_Match then
520 Result := Expect_Match (J);
521 Regexps (J).Descriptor.Last_Match_Start := Matched (0).First;
522 Regexps (J).Descriptor.Last_Match_End := Matched (0).Last;
527 Expect_Internal (Descriptors, N, Timeout, Full_Buffer);
529 if N = Expect_Timeout or else N = Expect_Full_Buffer then
536 ---------------------
537 -- Expect_Internal --
538 ---------------------
540 procedure Expect_Internal
541 (Descriptors : in out Array_Of_Pd;
542 Result : out Expect_Match;
544 Full_Buffer : Boolean)
546 Num_Descriptors : Integer;
547 Buffer_Size : Integer := 0;
551 type File_Descriptor_Array is
552 array (Descriptors'Range) of File_Descriptor;
553 Fds : aliased File_Descriptor_Array;
555 type Integer_Array is array (Descriptors'Range) of Integer;
556 Is_Set : aliased Integer_Array;
559 for J in Descriptors'Range loop
560 Fds (J) := Descriptors (J).Output_Fd;
562 if Descriptors (J).Buffer_Size = 0 then
563 Buffer_Size := Integer'Max (Buffer_Size, 4096);
566 Integer'Max (Buffer_Size, Descriptors (J).Buffer_Size);
571 Buffer : aliased String (1 .. Buffer_Size);
572 -- Buffer used for input. This is allocated only once, not for
573 -- every iteration of the loop
576 -- Loop until we match or we have a timeout
580 Poll (Fds'Address, Fds'Length, Timeout, Is_Set'Address);
582 case Num_Descriptors is
592 Result := Expect_Timeout;
598 for J in Descriptors'Range loop
599 if Is_Set (J) = 1 then
600 Buffer_Size := Descriptors (J).Buffer_Size;
602 if Buffer_Size = 0 then
606 N := Read (Descriptors (J).Output_Fd, Buffer'Address,
609 -- Error or End of file
612 -- ??? Note that ddd tries again up to three times
613 -- in that case. See LiterateA.C:174
617 -- If there is no limit to the buffer size
619 if Descriptors (J).Buffer_Size = 0 then
622 Tmp : String_Access := Descriptors (J).Buffer;
626 Descriptors (J).Buffer :=
627 new String (1 .. Tmp'Length + N);
628 Descriptors (J).Buffer (1 .. Tmp'Length) :=
630 Descriptors (J).Buffer
631 (Tmp'Length + 1 .. Tmp'Length + N) :=
634 Descriptors (J).Buffer_Index :=
635 Descriptors (J).Buffer'Last;
638 Descriptors (J).Buffer :=
640 Descriptors (J).Buffer.all :=
642 Descriptors (J).Buffer_Index := N;
647 -- Add what we read to the buffer
649 if Descriptors (J).Buffer_Index + N - 1 >
650 Descriptors (J).Buffer_Size
652 -- If the user wants to know when we have
653 -- read more than the buffer can contain.
656 Result := Expect_Full_Buffer;
660 -- Keep as much as possible from the buffer,
661 -- and forget old characters.
663 Descriptors (J).Buffer
664 (1 .. Descriptors (J).Buffer_Size - N) :=
665 Descriptors (J).Buffer
666 (N - Descriptors (J).Buffer_Size +
667 Descriptors (J).Buffer_Index + 1 ..
668 Descriptors (J).Buffer_Index);
669 Descriptors (J).Buffer_Index :=
670 Descriptors (J).Buffer_Size - N;
673 -- Keep what we read in the buffer
675 Descriptors (J).Buffer
676 (Descriptors (J).Buffer_Index + 1 ..
677 Descriptors (J).Buffer_Index + N) :=
679 Descriptors (J).Buffer_Index :=
680 Descriptors (J).Buffer_Index + N;
683 -- Call each of the output filter with what we
687 (Descriptors (J).all, Buffer (1 .. N), Output);
689 Result := Expect_Match (N);
703 function Expect_Out (Descriptor : Process_Descriptor) return String is
705 return Descriptor.Buffer (1 .. Descriptor.Last_Match_End);
708 ----------------------
709 -- Expect_Out_Match --
710 ----------------------
712 function Expect_Out_Match (Descriptor : Process_Descriptor) return String is
714 return Descriptor.Buffer
715 (Descriptor.Last_Match_Start .. Descriptor.Last_Match_End);
716 end Expect_Out_Match;
723 (Descriptor : in out Process_Descriptor;
724 Timeout : Integer := 0)
726 Buffer_Size : constant Integer := 8192;
727 Num_Descriptors : Integer;
729 Is_Set : aliased Integer;
730 Buffer : aliased String (1 .. Buffer_Size);
733 -- Empty the current buffer
735 Descriptor.Last_Match_End := Descriptor.Buffer_Index;
736 Reinitialize_Buffer (Descriptor);
738 -- Read everything from the process to flush its output
742 Poll (Descriptor.Output_Fd'Address, 1, Timeout, Is_Set'Address);
744 case Num_Descriptors is
751 -- Timeout => End of flush
760 N := Read (Descriptor.Output_Fd, Buffer'Address,
773 ------------------------
774 -- Get_Command_Output --
775 ------------------------
777 function Get_Command_Output
779 Arguments : GNAT.OS_Lib.Argument_List;
781 Status : not null access Integer;
782 Err_To_Out : Boolean := False) return String
786 Process : Process_Descriptor;
788 Output : String_Access := new String (1 .. 1024);
789 -- Buffer used to accumulate standard output from the launched
790 -- command, expanded as necessary during execution.
793 -- Index of the last used character within Output
797 (Process, Command, Arguments, Err_To_Out => Err_To_Out);
799 if Input'Length > 0 then
800 Send (Process, Input);
803 GNAT.OS_Lib.Close (Get_Input_Fd (Process));
806 Result : Expect_Match;
809 -- This loop runs until the call to Expect raises Process_Died
812 Expect (Process, Result, ".+");
815 NOutput : String_Access;
816 S : constant String := Expect_Out (Process);
817 pragma Assert (S'Length > 0);
820 -- Expand buffer if we need more space
822 if Last + S'Length > Output'Last then
823 NOutput := new String (1 .. 2 * Output'Last);
824 NOutput (Output'Range) := Output.all;
827 -- Here if current buffer size is OK
833 NOutput (Last + 1 .. Last + S'Length) := S;
834 Last := Last + S'Length;
841 Close (Process, Status.all);
849 S : constant String := Output (1 .. Last);
854 end Get_Command_Output;
860 function Get_Error_Fd
861 (Descriptor : Process_Descriptor) return GNAT.OS_Lib.File_Descriptor
864 return Descriptor.Error_Fd;
871 function Get_Input_Fd
872 (Descriptor : Process_Descriptor) return GNAT.OS_Lib.File_Descriptor
875 return Descriptor.Input_Fd;
882 function Get_Output_Fd
883 (Descriptor : Process_Descriptor) return GNAT.OS_Lib.File_Descriptor
886 return Descriptor.Output_Fd;
894 (Descriptor : Process_Descriptor) return Process_Id
897 return Descriptor.Pid;
904 procedure Interrupt (Descriptor : in out Process_Descriptor) is
905 SIGINT : constant := 2;
907 Send_Signal (Descriptor, SIGINT);
914 procedure Lock_Filters (Descriptor : in out Process_Descriptor) is
916 Descriptor.Filters_Lock := Descriptor.Filters_Lock + 1;
919 ------------------------
920 -- Non_Blocking_Spawn --
921 ------------------------
923 procedure Non_Blocking_Spawn
924 (Descriptor : out Process_Descriptor'Class;
926 Args : GNAT.OS_Lib.Argument_List;
927 Buffer_Size : Natural := 4096;
928 Err_To_Out : Boolean := False)
931 -------------------------
932 -- Reinitialize_Buffer --
933 -------------------------
935 procedure Reinitialize_Buffer
936 (Descriptor : in out Process_Descriptor'Class)
939 if Descriptor.Buffer_Size = 0 then
941 Tmp : String_Access := Descriptor.Buffer;
946 (1 .. Descriptor.Buffer_Index - Descriptor.Last_Match_End);
949 Descriptor.Buffer.all := Tmp
950 (Descriptor.Last_Match_End + 1 .. Descriptor.Buffer_Index);
955 Descriptor.Buffer_Index := Descriptor.Buffer'Last;
959 (1 .. Descriptor.Buffer_Index - Descriptor.Last_Match_End) :=
961 (Descriptor.Last_Match_End + 1 .. Descriptor.Buffer_Index);
963 if Descriptor.Buffer_Index > Descriptor.Last_Match_End then
964 Descriptor.Buffer_Index :=
965 Descriptor.Buffer_Index - Descriptor.Last_Match_End;
967 Descriptor.Buffer_Index := 0;
971 Descriptor.Last_Match_Start := 0;
972 Descriptor.Last_Match_End := 0;
973 end Reinitialize_Buffer;
979 procedure Remove_Filter
980 (Descriptor : in out Process_Descriptor;
981 Filter : Filter_Function)
983 Previous : Filter_List := null;
984 Current : Filter_List := Descriptor.Filters;
987 while Current /= null loop
988 if Current.Filter = Filter then
989 if Previous = null then
990 Descriptor.Filters := Current.Next;
992 Previous.Next := Current.Next;
997 Current := Current.Next;
1006 (Descriptor : in out Process_Descriptor;
1008 Add_LF : Boolean := True;
1009 Empty_Buffer : Boolean := False)
1011 Full_Str : constant String := Str & ASCII.LF;
1013 Result : Expect_Match;
1014 Descriptors : Array_Of_Pd := (1 => Descriptor'Unrestricted_Access);
1017 pragma Unreferenced (Discard);
1020 if Empty_Buffer then
1022 -- Force a read on the process if there is anything waiting
1024 Expect_Internal (Descriptors, Result,
1025 Timeout => 0, Full_Buffer => False);
1026 Descriptor.Last_Match_End := Descriptor.Buffer_Index;
1030 Reinitialize_Buffer (Descriptor);
1034 Last := Full_Str'Last;
1036 Last := Full_Str'Last - 1;
1039 Call_Filters (Descriptor, Full_Str (Full_Str'First .. Last), Input);
1042 Write (Descriptor.Input_Fd,
1044 Last - Full_Str'First + 1);
1045 -- Shouldn't we at least have a pragma Assert on the result ???
1052 procedure Send_Signal
1053 (Descriptor : Process_Descriptor;
1057 -- A nonpositive process id passed to kill has special meanings. For
1058 -- example, -1 means kill all processes in sight, including self, in
1059 -- POSIX and Windows (and something slightly different in Linux). See
1060 -- man pages for details. In any case, we don't want to do that. Note
1061 -- that Descriptor.Pid will be -1 if the process was not successfully
1062 -- started; we don't want to kill ourself in that case.
1064 if Descriptor.Pid > 0 then
1065 Kill (Descriptor.Pid, Signal);
1066 -- ??? Need to check process status here
1068 raise Invalid_Process;
1072 ---------------------------------
1073 -- Set_Up_Child_Communications --
1074 ---------------------------------
1076 procedure Set_Up_Child_Communications
1077 (Pid : in out Process_Descriptor;
1078 Pipe1 : in out Pipe_Type;
1079 Pipe2 : in out Pipe_Type;
1080 Pipe3 : in out Pipe_Type;
1082 Args : System.Address)
1084 pragma Warnings (Off, Pid);
1087 -- Since the code between fork and exec on VMS executes
1088 -- in the context of the parent process, we need to
1089 -- perform the following actions:
1090 -- - save stdin, stdout, stderr
1091 -- - replace them by our pipes
1092 -- - create the child with process handle inheritance
1093 -- - revert to the previous stdin, stdout and stderr.
1095 Save_Input := Dup (GNAT.OS_Lib.Standin);
1096 Save_Output := Dup (GNAT.OS_Lib.Standout);
1097 Save_Error := Dup (GNAT.OS_Lib.Standerr);
1099 -- Since we are still called from the parent process, there is no way
1100 -- currently we can cleanly close the unneeded ends of the pipes, but
1101 -- this doesn't really matter.
1102 -- We could close Pipe1.Output, Pipe2.Input, Pipe3.Input.
1104 Dup2 (Pipe1.Input, GNAT.OS_Lib.Standin);
1105 Dup2 (Pipe2.Output, GNAT.OS_Lib.Standout);
1106 Dup2 (Pipe3.Output, GNAT.OS_Lib.Standerr);
1108 Portable_Execvp (Pid.Pid'Access, Cmd & ASCII.Nul, Args);
1110 end Set_Up_Child_Communications;
1112 ---------------------------
1113 -- Set_Up_Communications --
1114 ---------------------------
1116 procedure Set_Up_Communications
1117 (Pid : in out Process_Descriptor;
1118 Err_To_Out : Boolean;
1119 Pipe1 : not null access Pipe_Type;
1120 Pipe2 : not null access Pipe_Type;
1121 Pipe3 : not null access Pipe_Type)
1126 if Create_Pipe (Pipe1) /= 0 then
1130 if Create_Pipe (Pipe2) /= 0 then
1134 Pid.Input_Fd := Pipe1.Output;
1135 Pid.Output_Fd := Pipe2.Input;
1138 Pipe3.all := Pipe2.all;
1140 if Create_Pipe (Pipe3) /= 0 then
1145 Pid.Error_Fd := Pipe3.Input;
1146 end Set_Up_Communications;
1148 ----------------------------------
1149 -- Set_Up_Parent_Communications --
1150 ----------------------------------
1152 procedure Set_Up_Parent_Communications
1153 (Pid : in out Process_Descriptor;
1154 Pipe1 : in out Pipe_Type;
1155 Pipe2 : in out Pipe_Type;
1156 Pipe3 : in out Pipe_Type)
1158 pragma Warnings (Off, Pid);
1162 Dup2 (Save_Input, GNAT.OS_Lib.Standin);
1163 Dup2 (Save_Output, GNAT.OS_Lib.Standout);
1164 Dup2 (Save_Error, GNAT.OS_Lib.Standerr);
1167 Close (Save_Output);
1170 Close (Pipe1.Input);
1171 Close (Pipe2.Output);
1172 Close (Pipe3.Output);
1173 end Set_Up_Parent_Communications;
1179 procedure Trace_Filter
1180 (Descriptor : Process_Descriptor'Class;
1182 User_Data : System.Address := System.Null_Address)
1184 pragma Warnings (Off, Descriptor);
1185 pragma Warnings (Off, User_Data);
1190 --------------------
1191 -- Unlock_Filters --
1192 --------------------
1194 procedure Unlock_Filters (Descriptor : in out Process_Descriptor) is
1196 if Descriptor.Filters_Lock > 0 then
1197 Descriptor.Filters_Lock := Descriptor.Filters_Lock - 1;