1 ------------------------------------------------------------------------------
3 -- GNAT LIBRARY COMPONENTS --
5 -- G N A T . E X P E C T --
9 -- Copyright (C) 2000-2005 Ada Core Technologies, Inc. --
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, 59 Temple Place - Suite 330, Boston, --
20 -- MA 02111-1307, 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 with System; use System;
35 with Ada.Calendar; use Ada.Calendar;
38 with GNAT.OS_Lib; use GNAT.OS_Lib;
39 with GNAT.Regpat; use GNAT.Regpat;
41 with Unchecked_Deallocation;
43 package body GNAT.Expect is
45 type Array_Of_Pd is array (Positive range <>) of Process_Descriptor_Access;
47 procedure Expect_Internal
48 (Descriptors : in out Array_Of_Pd;
49 Result : out Expect_Match;
51 Full_Buffer : Boolean);
52 -- Internal function used to read from the process Descriptor.
54 -- Three outputs are possible:
55 -- Result=Expect_Timeout, if no output was available before the timeout
57 -- Result=Expect_Full_Buffer, if Full_Buffer is True and some characters
58 -- had to be discarded from the internal buffer of Descriptor.
59 -- Result=<integer>, indicates how many characters were added to the
60 -- internal buffer. These characters are from indexes
61 -- Descriptor.Buffer_Index - Result + 1 .. Descriptor.Buffer_Index
62 -- Process_Died is raised if the process is no longer valid.
64 procedure Reinitialize_Buffer
65 (Descriptor : in out Process_Descriptor'Class);
66 -- Reinitialize the internal buffer.
67 -- The buffer is deleted up to the end of the last match.
69 procedure Free is new Unchecked_Deallocation
70 (Pattern_Matcher, Pattern_Matcher_Access);
72 procedure Call_Filters
73 (Pid : Process_Descriptor'Class;
75 Filter_On : Filter_Type);
76 -- Call all the filters that have the appropriate type.
77 -- This function does nothing if the filters are locked
79 ------------------------------
80 -- Target dependent section --
81 ------------------------------
83 function Dup (Fd : File_Descriptor) return File_Descriptor;
84 pragma Import (C, Dup);
86 procedure Dup2 (Old_Fd, New_Fd : File_Descriptor);
87 pragma Import (C, Dup2);
89 procedure Kill (Pid : Process_Id; Sig_Num : Integer);
90 pragma Import (C, Kill, "__gnat_kill");
92 function Create_Pipe (Pipe : access Pipe_Type) return Integer;
93 pragma Import (C, Create_Pipe, "__gnat_pipe");
96 (Fds : System.Address;
99 Is_Set : System.Address)
101 pragma Import (C, Poll, "__gnat_expect_poll");
102 -- Check whether there is any data waiting on the file descriptor
103 -- Out_fd, and wait if there is none, at most Timeout milliseconds
104 -- Returns -1 in case of error, 0 if the timeout expired before
105 -- data became available.
107 -- Out_Is_Set is set to 1 if data was available, 0 otherwise.
109 function Waitpid (Pid : Process_Id) return Integer;
110 pragma Import (C, Waitpid, "__gnat_waitpid");
111 -- Wait for a specific process id, and return its exit code.
117 function "+" (S : String) return GNAT.OS_Lib.String_Access is
119 return new String'(S);
127 (P : GNAT.Regpat.Pattern_Matcher)
128 return Pattern_Matcher_Access
131 return new GNAT.Regpat.Pattern_Matcher'(P);
139 (Descriptor : in out Process_Descriptor;
140 Filter : Filter_Function;
141 Filter_On : Filter_Type := Output;
142 User_Data : System.Address := System.Null_Address;
143 After : Boolean := False)
145 Current : Filter_List := Descriptor.Filters;
149 while Current /= null and then Current.Next /= null loop
150 Current := Current.Next;
153 if Current = null then
154 Descriptor.Filters :=
155 new Filter_List_Elem'
156 (Filter => Filter, Filter_On => Filter_On,
157 User_Data => User_Data, Next => null);
160 new Filter_List_Elem'
161 (Filter => Filter, Filter_On => Filter_On,
162 User_Data => User_Data, Next => null);
166 Descriptor.Filters :=
167 new Filter_List_Elem'
168 (Filter => Filter, Filter_On => Filter_On,
169 User_Data => User_Data, Next => Descriptor.Filters);
177 procedure Call_Filters
178 (Pid : Process_Descriptor'Class;
180 Filter_On : Filter_Type)
182 Current_Filter : Filter_List;
185 if Pid.Filters_Lock = 0 then
186 Current_Filter := Pid.Filters;
188 while Current_Filter /= null loop
189 if Current_Filter.Filter_On = Filter_On then
190 Current_Filter.Filter
191 (Pid, Str, Current_Filter.User_Data);
194 Current_Filter := Current_Filter.Next;
204 (Descriptor : in out Process_Descriptor;
205 Status : out Integer)
208 Close (Descriptor.Input_Fd);
210 if Descriptor.Error_Fd /= Descriptor.Output_Fd then
211 Close (Descriptor.Error_Fd);
214 Close (Descriptor.Output_Fd);
216 -- ??? Should have timeouts for different signals
217 Kill (Descriptor.Pid, 9);
219 GNAT.OS_Lib.Free (Descriptor.Buffer);
220 Descriptor.Buffer_Size := 0;
222 Status := Waitpid (Descriptor.Pid);
225 procedure Close (Descriptor : in out Process_Descriptor) is
228 Close (Descriptor, Status);
236 (Descriptor : in out Process_Descriptor;
237 Result : out Expect_Match;
239 Timeout : Integer := 10000;
240 Full_Buffer : Boolean := False)
244 Expect (Descriptor, Result, Never_Match, Timeout, Full_Buffer);
246 Expect (Descriptor, Result, Compile (Regexp), Timeout, Full_Buffer);
251 (Descriptor : in out Process_Descriptor;
252 Result : out Expect_Match;
254 Matched : out GNAT.Regpat.Match_Array;
255 Timeout : Integer := 10000;
256 Full_Buffer : Boolean := False)
259 pragma Assert (Matched'First = 0);
262 (Descriptor, Result, Never_Match, Matched, Timeout, Full_Buffer);
265 (Descriptor, Result, Compile (Regexp), Matched, Timeout,
271 (Descriptor : in out Process_Descriptor;
272 Result : out Expect_Match;
273 Regexp : GNAT.Regpat.Pattern_Matcher;
274 Timeout : Integer := 10000;
275 Full_Buffer : Boolean := False)
277 Matched : GNAT.Regpat.Match_Array (0 .. 0);
280 Expect (Descriptor, Result, Regexp, Matched, Timeout, Full_Buffer);
284 (Descriptor : in out Process_Descriptor;
285 Result : out Expect_Match;
286 Regexp : GNAT.Regpat.Pattern_Matcher;
287 Matched : out GNAT.Regpat.Match_Array;
288 Timeout : Integer := 10000;
289 Full_Buffer : Boolean := False)
292 Descriptors : Array_Of_Pd := (1 => Descriptor'Unrestricted_Access);
293 Try_Until : constant Time := Clock + Duration (Timeout) / 1000.0;
294 Timeout_Tmp : Integer := Timeout;
297 pragma Assert (Matched'First = 0);
298 Reinitialize_Buffer (Descriptor);
301 -- First, test if what is already in the buffer matches (This is
302 -- required if this package is used in multi-task mode, since one of
303 -- the tasks might have added something in the buffer, and we don't
304 -- want other tasks to wait for new input to be available before
305 -- checking the regexps).
308 (Regexp, Descriptor.Buffer (1 .. Descriptor.Buffer_Index), Matched);
310 if Descriptor.Buffer_Index >= 1 and then Matched (0).First /= 0 then
312 Descriptor.Last_Match_Start := Matched (0).First;
313 Descriptor.Last_Match_End := Matched (0).Last;
317 -- Else try to read new input
319 Expect_Internal (Descriptors, N, Timeout_Tmp, Full_Buffer);
321 if N = Expect_Timeout or else N = Expect_Full_Buffer then
326 -- Calculate the timeout for the next turn.
327 -- Note that Timeout is, from the caller's perspective, the maximum
328 -- time until a match, not the maximum time until some output is
329 -- read, and thus can not be reused as is for Expect_Internal.
331 if Timeout /= -1 then
332 Timeout_Tmp := Integer (Try_Until - Clock) * 1000;
334 if Timeout_Tmp < 0 then
335 Result := Expect_Timeout;
341 -- Even if we had the general timeout above, we have to test that the
342 -- last test we read from the external process didn't match.
345 (Regexp, Descriptor.Buffer (1 .. Descriptor.Buffer_Index), Matched);
347 if Matched (0).First /= 0 then
349 Descriptor.Last_Match_Start := Matched (0).First;
350 Descriptor.Last_Match_End := Matched (0).Last;
356 (Descriptor : in out Process_Descriptor;
357 Result : out Expect_Match;
358 Regexps : Regexp_Array;
359 Timeout : Integer := 10000;
360 Full_Buffer : Boolean := False)
362 Patterns : Compiled_Regexp_Array (Regexps'Range);
363 Matched : GNAT.Regpat.Match_Array (0 .. 0);
366 for J in Regexps'Range loop
367 Patterns (J) := new Pattern_Matcher'(Compile (Regexps (J).all));
370 Expect (Descriptor, Result, Patterns, Matched, Timeout, Full_Buffer);
372 for J in Regexps'Range loop
378 (Descriptor : in out Process_Descriptor;
379 Result : out Expect_Match;
380 Regexps : Compiled_Regexp_Array;
381 Timeout : Integer := 10000;
382 Full_Buffer : Boolean := False)
384 Matched : GNAT.Regpat.Match_Array (0 .. 0);
387 Expect (Descriptor, Result, Regexps, Matched, Timeout, Full_Buffer);
391 (Result : out Expect_Match;
392 Regexps : Multiprocess_Regexp_Array;
393 Timeout : Integer := 10000;
394 Full_Buffer : Boolean := False)
396 Matched : GNAT.Regpat.Match_Array (0 .. 0);
399 Expect (Result, Regexps, Matched, Timeout, Full_Buffer);
403 (Descriptor : in out Process_Descriptor;
404 Result : out Expect_Match;
405 Regexps : Regexp_Array;
406 Matched : out GNAT.Regpat.Match_Array;
407 Timeout : Integer := 10000;
408 Full_Buffer : Boolean := False)
410 Patterns : Compiled_Regexp_Array (Regexps'Range);
413 pragma Assert (Matched'First = 0);
415 for J in Regexps'Range loop
416 Patterns (J) := new Pattern_Matcher'(Compile (Regexps (J).all));
419 Expect (Descriptor, Result, Patterns, Matched, Timeout, Full_Buffer);
421 for J in Regexps'Range loop
427 (Descriptor : in out Process_Descriptor;
428 Result : out Expect_Match;
429 Regexps : Compiled_Regexp_Array;
430 Matched : out GNAT.Regpat.Match_Array;
431 Timeout : Integer := 10000;
432 Full_Buffer : Boolean := False)
435 Descriptors : Array_Of_Pd := (1 => Descriptor'Unrestricted_Access);
438 pragma Assert (Matched'First = 0);
440 Reinitialize_Buffer (Descriptor);
443 -- First, test if what is already in the buffer matches (This is
444 -- required if this package is used in multi-task mode, since one of
445 -- the tasks might have added something in the buffer, and we don't
446 -- want other tasks to wait for new input to be available before
447 -- checking the regexps).
449 if Descriptor.Buffer /= null then
450 for J in Regexps'Range loop
453 Descriptor.Buffer (1 .. Descriptor.Buffer_Index),
456 if Matched (0) /= No_Match then
457 Result := Expect_Match (J);
458 Descriptor.Last_Match_Start := Matched (0).First;
459 Descriptor.Last_Match_End := Matched (0).Last;
465 Expect_Internal (Descriptors, N, Timeout, Full_Buffer);
467 if N = Expect_Timeout or else N = Expect_Full_Buffer then
475 (Result : out Expect_Match;
476 Regexps : Multiprocess_Regexp_Array;
477 Matched : out GNAT.Regpat.Match_Array;
478 Timeout : Integer := 10000;
479 Full_Buffer : Boolean := False)
482 Descriptors : Array_Of_Pd (Regexps'Range);
485 pragma Assert (Matched'First = 0);
487 for J in Descriptors'Range loop
488 Descriptors (J) := Regexps (J).Descriptor;
489 Reinitialize_Buffer (Regexps (J).Descriptor.all);
493 -- First, test if what is already in the buffer matches (This is
494 -- required if this package is used in multi-task mode, since one of
495 -- the tasks might have added something in the buffer, and we don't
496 -- want other tasks to wait for new input to be available before
497 -- checking the regexps).
499 for J in Regexps'Range loop
500 Match (Regexps (J).Regexp.all,
501 Regexps (J).Descriptor.Buffer
502 (1 .. Regexps (J).Descriptor.Buffer_Index),
505 if Matched (0) /= No_Match then
506 Result := Expect_Match (J);
507 Regexps (J).Descriptor.Last_Match_Start := Matched (0).First;
508 Regexps (J).Descriptor.Last_Match_End := Matched (0).Last;
513 Expect_Internal (Descriptors, N, Timeout, Full_Buffer);
515 if N = Expect_Timeout or else N = Expect_Full_Buffer then
522 ---------------------
523 -- Expect_Internal --
524 ---------------------
526 procedure Expect_Internal
527 (Descriptors : in out Array_Of_Pd;
528 Result : out Expect_Match;
530 Full_Buffer : Boolean)
532 Num_Descriptors : Integer;
533 Buffer_Size : Integer := 0;
537 type File_Descriptor_Array is
538 array (Descriptors'Range) of File_Descriptor;
539 Fds : aliased File_Descriptor_Array;
541 type Integer_Array is array (Descriptors'Range) of Integer;
542 Is_Set : aliased Integer_Array;
545 for J in Descriptors'Range loop
546 Fds (J) := Descriptors (J).Output_Fd;
548 if Descriptors (J).Buffer_Size = 0 then
549 Buffer_Size := Integer'Max (Buffer_Size, 4096);
552 Integer'Max (Buffer_Size, Descriptors (J).Buffer_Size);
557 Buffer : aliased String (1 .. Buffer_Size);
558 -- Buffer used for input. This is allocated only once, not for
559 -- every iteration of the loop
562 -- Loop until we match or we have a timeout
566 Poll (Fds'Address, Fds'Length, Timeout, Is_Set'Address);
568 case Num_Descriptors is
578 Result := Expect_Timeout;
584 for J in Descriptors'Range loop
585 if Is_Set (J) = 1 then
586 Buffer_Size := Descriptors (J).Buffer_Size;
588 if Buffer_Size = 0 then
592 N := Read (Descriptors (J).Output_Fd, Buffer'Address,
595 -- Error or End of file
598 -- ??? Note that ddd tries again up to three times
599 -- in that case. See LiterateA.C:174
603 -- If there is no limit to the buffer size
605 if Descriptors (J).Buffer_Size = 0 then
608 Tmp : String_Access := Descriptors (J).Buffer;
612 Descriptors (J).Buffer :=
613 new String (1 .. Tmp'Length + N);
614 Descriptors (J).Buffer (1 .. Tmp'Length) :=
616 Descriptors (J).Buffer
617 (Tmp'Length + 1 .. Tmp'Length + N) :=
620 Descriptors (J).Buffer_Index :=
621 Descriptors (J).Buffer'Last;
624 Descriptors (J).Buffer :=
626 Descriptors (J).Buffer.all :=
628 Descriptors (J).Buffer_Index := N;
633 -- Add what we read to the buffer
635 if Descriptors (J).Buffer_Index + N - 1 >
636 Descriptors (J).Buffer_Size
638 -- If the user wants to know when we have
639 -- read more than the buffer can contain.
642 Result := Expect_Full_Buffer;
646 -- Keep as much as possible from the buffer,
647 -- and forget old characters.
649 Descriptors (J).Buffer
650 (1 .. Descriptors (J).Buffer_Size - N) :=
651 Descriptors (J).Buffer
652 (N - Descriptors (J).Buffer_Size +
653 Descriptors (J).Buffer_Index + 1 ..
654 Descriptors (J).Buffer_Index);
655 Descriptors (J).Buffer_Index :=
656 Descriptors (J).Buffer_Size - N;
659 -- Keep what we read in the buffer.
661 Descriptors (J).Buffer
662 (Descriptors (J).Buffer_Index + 1 ..
663 Descriptors (J).Buffer_Index + N) :=
665 Descriptors (J).Buffer_Index :=
666 Descriptors (J).Buffer_Index + N;
669 -- Call each of the output filter with what we
673 (Descriptors (J).all, Buffer (1 .. N), Output);
675 Result := Expect_Match (N);
689 function Expect_Out (Descriptor : Process_Descriptor) return String is
691 return Descriptor.Buffer (1 .. Descriptor.Last_Match_End);
694 ----------------------
695 -- Expect_Out_Match --
696 ----------------------
698 function Expect_Out_Match (Descriptor : Process_Descriptor) return String is
700 return Descriptor.Buffer
701 (Descriptor.Last_Match_Start .. Descriptor.Last_Match_End);
702 end Expect_Out_Match;
709 (Descriptor : in out Process_Descriptor;
710 Timeout : Integer := 0)
712 Buffer_Size : constant Integer := 8192;
713 Num_Descriptors : Integer;
715 Is_Set : aliased Integer;
716 Buffer : aliased String (1 .. Buffer_Size);
719 -- Empty the current buffer
721 Descriptor.Last_Match_End := Descriptor.Buffer_Index;
722 Reinitialize_Buffer (Descriptor);
724 -- Read everything from the process to flush its output
728 Poll (Descriptor.Output_Fd'Address, 1, Timeout, Is_Set'Address);
730 case Num_Descriptors is
737 -- Timeout => End of flush
746 N := Read (Descriptor.Output_Fd, Buffer'Address,
764 function Get_Error_Fd
765 (Descriptor : Process_Descriptor) return GNAT.OS_Lib.File_Descriptor is
767 return Descriptor.Error_Fd;
774 function Get_Input_Fd
775 (Descriptor : Process_Descriptor) return GNAT.OS_Lib.File_Descriptor is
777 return Descriptor.Input_Fd;
784 function Get_Output_Fd
785 (Descriptor : Process_Descriptor) return GNAT.OS_Lib.File_Descriptor is
787 return Descriptor.Output_Fd;
795 (Descriptor : Process_Descriptor) return Process_Id is
797 return Descriptor.Pid;
804 procedure Interrupt (Descriptor : in out Process_Descriptor) is
805 SIGINT : constant := 2;
808 Send_Signal (Descriptor, SIGINT);
815 procedure Lock_Filters (Descriptor : in out Process_Descriptor) is
817 Descriptor.Filters_Lock := Descriptor.Filters_Lock + 1;
820 ------------------------
821 -- Non_Blocking_Spawn --
822 ------------------------
824 procedure Non_Blocking_Spawn
825 (Descriptor : out Process_Descriptor'Class;
827 Args : GNAT.OS_Lib.Argument_List;
828 Buffer_Size : Natural := 4096;
829 Err_To_Out : Boolean := False)
831 function Fork return Process_Id;
832 pragma Import (C, Fork, "__gnat_expect_fork");
833 -- Starts a new process if possible. See the Unix command fork for more
834 -- information. On systems that do not support this capability (such as
835 -- Windows...), this command does nothing, and Fork will return
838 Pipe1, Pipe2, Pipe3 : aliased Pipe_Type;
841 Arg_List : String_List (1 .. Args'Length + 2);
842 C_Arg_List : aliased array (1 .. Args'Length + 2) of System.Address;
844 Command_With_Path : String_Access;
847 -- Create the rest of the pipes
849 Set_Up_Communications
850 (Descriptor, Err_To_Out, Pipe1'Access, Pipe2'Access, Pipe3'Access);
852 Command_With_Path := Locate_Exec_On_Path (Command);
854 if Command_With_Path = null then
855 raise Invalid_Process;
858 -- Fork a new process
860 Descriptor.Pid := Fork;
862 -- Are we now in the child (or, for Windows, still in the common
865 if Descriptor.Pid = Null_Pid then
866 -- Prepare an array of arguments to pass to C
868 Arg := new String (1 .. Command_With_Path'Length + 1);
869 Arg (1 .. Command_With_Path'Length) := Command_With_Path.all;
870 Arg (Arg'Last) := ASCII.NUL;
873 for J in Args'Range loop
874 Arg := new String (1 .. Args (J)'Length + 1);
875 Arg (1 .. Args (J)'Length) := Args (J).all;
876 Arg (Arg'Last) := ASCII.NUL;
877 Arg_List (J + 2 - Args'First) := Arg.all'Access;
880 Arg_List (Arg_List'Last) := null;
882 -- Make sure all arguments are compatible with OS conventions
884 Normalize_Arguments (Arg_List);
886 -- Prepare low-level argument list from the normalized arguments
888 for K in Arg_List'Range loop
889 if Arg_List (K) /= null then
890 C_Arg_List (K) := Arg_List (K).all'Address;
892 C_Arg_List (K) := System.Null_Address;
896 -- This does not return on Unix systems
898 Set_Up_Child_Communications
899 (Descriptor, Pipe1, Pipe2, Pipe3, Command_With_Path.all,
903 Free (Command_With_Path);
905 -- Did we have an error when spawning the child ?
907 if Descriptor.Pid < Null_Pid then
908 raise Invalid_Process;
910 -- We are now in the parent process
912 Set_Up_Parent_Communications (Descriptor, Pipe1, Pipe2, Pipe3);
917 Descriptor.Buffer_Size := Buffer_Size;
919 if Buffer_Size /= 0 then
920 Descriptor.Buffer := new String (1 .. Positive (Buffer_Size));
922 end Non_Blocking_Spawn;
924 -------------------------
925 -- Reinitialize_Buffer --
926 -------------------------
928 procedure Reinitialize_Buffer
929 (Descriptor : in out Process_Descriptor'Class)
932 if Descriptor.Buffer_Size = 0 then
934 Tmp : String_Access := Descriptor.Buffer;
939 (1 .. Descriptor.Buffer_Index - Descriptor.Last_Match_End);
942 Descriptor.Buffer.all := Tmp
943 (Descriptor.Last_Match_End + 1 .. Descriptor.Buffer_Index);
948 Descriptor.Buffer_Index := Descriptor.Buffer'Last;
952 (1 .. Descriptor.Buffer_Index - Descriptor.Last_Match_End) :=
954 (Descriptor.Last_Match_End + 1 .. Descriptor.Buffer_Index);
956 if Descriptor.Buffer_Index > Descriptor.Last_Match_End then
957 Descriptor.Buffer_Index :=
958 Descriptor.Buffer_Index - Descriptor.Last_Match_End;
960 Descriptor.Buffer_Index := 0;
964 Descriptor.Last_Match_Start := 0;
965 Descriptor.Last_Match_End := 0;
966 end Reinitialize_Buffer;
972 procedure Remove_Filter
973 (Descriptor : in out Process_Descriptor;
974 Filter : Filter_Function)
976 Previous : Filter_List := null;
977 Current : Filter_List := Descriptor.Filters;
980 while Current /= null loop
981 if Current.Filter = Filter then
982 if Previous = null then
983 Descriptor.Filters := Current.Next;
985 Previous.Next := Current.Next;
990 Current := Current.Next;
999 (Descriptor : in out Process_Descriptor;
1001 Add_LF : Boolean := True;
1002 Empty_Buffer : Boolean := False)
1004 Full_Str : constant String := Str & ASCII.LF;
1006 Result : Expect_Match;
1007 Descriptors : Array_Of_Pd := (1 => Descriptor'Unrestricted_Access);
1010 pragma Unreferenced (Dummy);
1013 if Empty_Buffer then
1015 -- Force a read on the process if there is anything waiting.
1017 Expect_Internal (Descriptors, Result,
1018 Timeout => 0, Full_Buffer => False);
1019 Descriptor.Last_Match_End := Descriptor.Buffer_Index;
1023 Reinitialize_Buffer (Descriptor);
1027 Last := Full_Str'Last;
1029 Last := Full_Str'Last - 1;
1032 Call_Filters (Descriptor, Full_Str (Full_Str'First .. Last), Input);
1035 Write (Descriptor.Input_Fd,
1037 Last - Full_Str'First + 1);
1044 procedure Send_Signal
1045 (Descriptor : Process_Descriptor;
1049 Kill (Descriptor.Pid, Signal);
1050 -- ??? Need to check process status here.
1053 ---------------------------------
1054 -- Set_Up_Child_Communications --
1055 ---------------------------------
1057 procedure Set_Up_Child_Communications
1058 (Pid : in out Process_Descriptor;
1059 Pipe1 : in out Pipe_Type;
1060 Pipe2 : in out Pipe_Type;
1061 Pipe3 : in out Pipe_Type;
1063 Args : in System.Address)
1065 pragma Warnings (Off, Pid);
1067 Input : File_Descriptor;
1068 Output : File_Descriptor;
1069 Error : File_Descriptor;
1072 -- Since Windows does not have a separate fork/exec, we need to
1073 -- perform the following actions:
1074 -- - save stdin, stdout, stderr
1075 -- - replace them by our pipes
1076 -- - create the child with process handle inheritance
1077 -- - revert to the previous stdin, stdout and stderr.
1079 Input := Dup (GNAT.OS_Lib.Standin);
1080 Output := Dup (GNAT.OS_Lib.Standout);
1081 Error := Dup (GNAT.OS_Lib.Standerr);
1083 -- Since we are still called from the parent process, there is no way
1084 -- currently we can cleanly close the unneeded ends of the pipes, but
1085 -- this doesn't really matter.
1086 -- We could close Pipe1.Output, Pipe2.Input, Pipe3.Input.
1088 Dup2 (Pipe1.Input, GNAT.OS_Lib.Standin);
1089 Dup2 (Pipe2.Output, GNAT.OS_Lib.Standout);
1090 Dup2 (Pipe3.Output, GNAT.OS_Lib.Standerr);
1092 Portable_Execvp (Pid.Pid'Access, Cmd & ASCII.Nul, Args);
1094 -- The following commands are not executed on Unix systems, and are
1095 -- only required for Windows systems. We are now in the parent process.
1097 -- Restore the old descriptors
1099 Dup2 (Input, GNAT.OS_Lib.Standin);
1100 Dup2 (Output, GNAT.OS_Lib.Standout);
1101 Dup2 (Error, GNAT.OS_Lib.Standerr);
1105 end Set_Up_Child_Communications;
1107 ---------------------------
1108 -- Set_Up_Communications --
1109 ---------------------------
1111 procedure Set_Up_Communications
1112 (Pid : in out Process_Descriptor;
1113 Err_To_Out : Boolean;
1114 Pipe1 : access Pipe_Type;
1115 Pipe2 : access Pipe_Type;
1116 Pipe3 : access Pipe_Type)
1123 if Create_Pipe (Pipe1) /= 0 then
1127 if Create_Pipe (Pipe2) /= 0 then
1131 -- Record the 'parent' end of the two pipes in Pid:
1132 -- Child stdin is connected to the 'write' end of Pipe1;
1133 -- Child stdout is connected to the 'read' end of Pipe2.
1134 -- We do not want these descriptors to remain open in the child
1135 -- process, so we mark them close-on-exec/non-inheritable.
1137 Pid.Input_Fd := Pipe1.Output;
1138 Set_Close_On_Exec (Pipe1.Output, True, Status);
1139 Pid.Output_Fd := Pipe2.Input;
1140 Set_Close_On_Exec (Pipe2.Input, True, Status);
1144 -- Reuse the standard output pipe for standard error
1146 Pipe3.all := Pipe2.all;
1149 -- Create a separate pipe for standard error
1151 if Create_Pipe (Pipe3) /= 0 then
1156 -- As above, we record the proper fd for the child's
1157 -- standard error stream.
1159 Pid.Error_Fd := Pipe3.Input;
1160 Set_Close_On_Exec (Pipe3.Input, True, Status);
1161 end Set_Up_Communications;
1163 ----------------------------------
1164 -- Set_Up_Parent_Communications --
1165 ----------------------------------
1167 procedure Set_Up_Parent_Communications
1168 (Pid : in out Process_Descriptor;
1169 Pipe1 : in out Pipe_Type;
1170 Pipe2 : in out Pipe_Type;
1171 Pipe3 : in out Pipe_Type)
1173 pragma Warnings (Off, Pid);
1176 Close (Pipe1.Input);
1177 Close (Pipe2.Output);
1178 Close (Pipe3.Output);
1179 end Set_Up_Parent_Communications;
1185 procedure Trace_Filter
1186 (Descriptor : Process_Descriptor'Class;
1188 User_Data : System.Address := System.Null_Address)
1190 pragma Warnings (Off, Descriptor);
1191 pragma Warnings (Off, User_Data);
1197 --------------------
1198 -- Unlock_Filters --
1199 --------------------
1201 procedure Unlock_Filters (Descriptor : in out Process_Descriptor) is
1203 if Descriptor.Filters_Lock > 0 then
1204 Descriptor.Filters_Lock := Descriptor.Filters_Lock - 1;