-- --
-- B o d y --
-- --
--- Copyright (C) 2000-2007, AdaCore --
+-- Copyright (C) 2000-2009, AdaCore --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
-- --
------------------------------------------------------------------------------
-with System; use System;
-with Ada.Calendar; use Ada.Calendar;
+with System; use System;
+with System.OS_Constants; use System.OS_Constants;
+with Ada.Calendar; use Ada.Calendar;
with GNAT.IO;
with GNAT.OS_Lib; use GNAT.OS_Lib;
procedure Close (Descriptor : in out Process_Descriptor) is
Status : Integer;
+ pragma Unreferenced (Status);
begin
Close (Descriptor, Status);
end Close;
(Descriptor : in out Process_Descriptor;
Result : out Expect_Match;
Regexp : String;
- Timeout : Integer := 10000;
+ Timeout : Integer := 10_000;
Full_Buffer : Boolean := False)
is
begin
Result : out Expect_Match;
Regexp : String;
Matched : out GNAT.Regpat.Match_Array;
- Timeout : Integer := 10000;
+ Timeout : Integer := 10_000;
Full_Buffer : Boolean := False)
is
begin
(Descriptor : in out Process_Descriptor;
Result : out Expect_Match;
Regexp : GNAT.Regpat.Pattern_Matcher;
- Timeout : Integer := 10000;
+ Timeout : Integer := 10_000;
Full_Buffer : Boolean := False)
is
Matched : GNAT.Regpat.Match_Array (0 .. 0);
-
+ pragma Warnings (Off, Matched);
begin
Expect (Descriptor, Result, Regexp, Matched, Timeout, Full_Buffer);
end Expect;
Result : out Expect_Match;
Regexp : GNAT.Regpat.Pattern_Matcher;
Matched : out GNAT.Regpat.Match_Array;
- Timeout : Integer := 10000;
+ Timeout : Integer := 10_000;
Full_Buffer : Boolean := False)
is
N : Expect_Match;
(Descriptor : in out Process_Descriptor;
Result : out Expect_Match;
Regexps : Regexp_Array;
- Timeout : Integer := 10000;
+ Timeout : Integer := 10_000;
Full_Buffer : Boolean := False)
is
Patterns : Compiled_Regexp_Array (Regexps'Range);
- Matched : GNAT.Regpat.Match_Array (0 .. 0);
+
+ Matched : GNAT.Regpat.Match_Array (0 .. 0);
+ pragma Warnings (Off, Matched);
begin
for J in Regexps'Range loop
(Descriptor : in out Process_Descriptor;
Result : out Expect_Match;
Regexps : Compiled_Regexp_Array;
- Timeout : Integer := 10000;
+ Timeout : Integer := 10_000;
Full_Buffer : Boolean := False)
is
Matched : GNAT.Regpat.Match_Array (0 .. 0);
-
+ pragma Warnings (Off, Matched);
begin
Expect (Descriptor, Result, Regexps, Matched, Timeout, Full_Buffer);
end Expect;
procedure Expect
(Result : out Expect_Match;
Regexps : Multiprocess_Regexp_Array;
- Timeout : Integer := 10000;
+ Timeout : Integer := 10_000;
Full_Buffer : Boolean := False)
is
Matched : GNAT.Regpat.Match_Array (0 .. 0);
-
+ pragma Warnings (Off, Matched);
begin
Expect (Result, Regexps, Matched, Timeout, Full_Buffer);
end Expect;
Result : out Expect_Match;
Regexps : Regexp_Array;
Matched : out GNAT.Regpat.Match_Array;
- Timeout : Integer := 10000;
+ Timeout : Integer := 10_000;
Full_Buffer : Boolean := False)
is
Patterns : Compiled_Regexp_Array (Regexps'Range);
Result : out Expect_Match;
Regexps : Compiled_Regexp_Array;
Matched : out GNAT.Regpat.Match_Array;
- Timeout : Integer := 10000;
+ Timeout : Integer := 10_000;
Full_Buffer : Boolean := False)
is
N : Expect_Match;
(Result : out Expect_Match;
Regexps : Multiprocess_Regexp_Array;
Matched : out GNAT.Regpat.Match_Array;
- Timeout : Integer := 10000;
+ Timeout : Integer := 10_000;
Full_Buffer : Boolean := False)
is
N : Expect_Match;
else
-- Add what we read to the buffer
- if Descriptors (J).Buffer_Index + N - 1 >
+ if Descriptors (J).Buffer_Index + N >
Descriptors (J).Buffer_Size
then
-- If the user wants to know when we have
Send (Process, Input);
end if;
- GNAT.OS_Lib.Close (Get_Input_Fd (Process));
+ Close (Process.Input_Fd);
+ Process.Input_Fd := Invalid_FD;
declare
Result : Expect_Match;
+ pragma Unreferenced (Result);
begin
-- This loop runs until the call to Expect raises Process_Died
-- Prepare low-level argument list from the normalized arguments
for K in Arg_List'Range loop
- if Arg_List (K) /= null then
- C_Arg_List (K) := Arg_List (K).all'Address;
- else
- C_Arg_List (K) := System.Null_Address;
- end if;
+ C_Arg_List (K) :=
+ (if Arg_List (K) /= null
+ then Arg_List (K).all'Address
+ else System.Null_Address);
end loop;
-- This does not return on Unix systems
Empty_Buffer : Boolean := False)
is
Line_Feed : aliased constant String := (1 .. 1 => ASCII.LF);
- Result : Expect_Match;
Descriptors : Array_Of_Pd := (1 => Descriptor'Unrestricted_Access);
+ Result : Expect_Match;
Discard : Natural;
+ pragma Warnings (Off, Result);
pragma Warnings (Off, Discard);
begin
Args : System.Address)
is
pragma Warnings (Off, Pid);
+ pragma Warnings (Off, Pipe1);
+ pragma Warnings (Off, Pipe2);
+ pragma Warnings (Off, Pipe3);
Input : File_Descriptor;
Output : File_Descriptor;
Error : File_Descriptor;
+ No_Fork_On_Target : constant Boolean := Target_OS = Windows;
+
begin
- -- Since Windows does not have a separate fork/exec, we need to
- -- perform the following actions:
- -- - save stdin, stdout, stderr
- -- - replace them by our pipes
- -- - create the child with process handle inheritance
- -- - revert to the previous stdin, stdout and stderr.
+ if No_Fork_On_Target then
+
+ -- Since Windows does not have a separate fork/exec, we need to
+ -- perform the following actions:
- Input := Dup (GNAT.OS_Lib.Standin);
- Output := Dup (GNAT.OS_Lib.Standout);
- Error := Dup (GNAT.OS_Lib.Standerr);
+ -- - save stdin, stdout, stderr
+ -- - replace them by our pipes
+ -- - create the child with process handle inheritance
+ -- - revert to the previous stdin, stdout and stderr.
+
+ Input := Dup (GNAT.OS_Lib.Standin);
+ Output := Dup (GNAT.OS_Lib.Standout);
+ Error := Dup (GNAT.OS_Lib.Standerr);
+ end if;
-- Since we are still called from the parent process, there is no way
-- currently we can cleanly close the unneeded ends of the pipes, but
-- this doesn't really matter.
- -- We could close Pipe1.Output, Pipe2.Input, Pipe3.Input.
+
+ -- We could close Pipe1.Output, Pipe2.Input, Pipe3.Input
Dup2 (Pipe1.Input, GNAT.OS_Lib.Standin);
Dup2 (Pipe2.Output, GNAT.OS_Lib.Standout);
Dup2 (Pipe3.Output, GNAT.OS_Lib.Standerr);
- Portable_Execvp (Pid.Pid'Access, Cmd & ASCII.Nul, Args);
+ Portable_Execvp (Pid.Pid'Access, Cmd & ASCII.NUL, Args);
- -- The following commands are not executed on Unix systems, and are
- -- only required for Windows systems. We are now in the parent process.
+ -- The following commands are not executed on Unix systems, and are only
+ -- required for Windows systems. We are now in the parent process.
-- Restore the old descriptors
Pipe3 : not null access Pipe_Type)
is
Status : Boolean;
+ pragma Unreferenced (Status);
begin
-- Create the pipes
-- Reuse the standard output pipe for standard error
Pipe3.all := Pipe2.all;
- else
+ else
-- Create a separate pipe for standard error
if Create_Pipe (Pipe3) /= 0 then
Pipe3 : in out Pipe_Type)
is
pragma Warnings (Off, Pid);
+ pragma Warnings (Off, Pipe1);
+ pragma Warnings (Off, Pipe2);
+ pragma Warnings (Off, Pipe3);
+
begin
Close (Pipe1.Input);
Close (Pipe2.Output);
- Close (Pipe3.Output);
+
+ if Pipe3.Output /= Pipe2.Output then
+ Close (Pipe3.Output);
+ end if;
end Set_Up_Parent_Communications;
------------------
OSDN Git Service
