g-expect-vms.adb:
2007-04-20 Bob Duff <duff@adacore.com> * g-expect-vms.adb: (Send_Signal, Close): Raise Invalid_Process if the process id is invalid. * g-expect.ads, g-expect.adb (Send): Avoid useless copy of the string. (Send_Signal, Close): Raise Invalid_Process if the process id is invalid. (Pattern_Matcher_Access): Is now a general access type to be able to use aliased string. From-SVN: r125361
This commit is contained in:
Bob Duff
Arnaud Charlet
parent
30681738f9
commit
11efec4da2
@ -6,7 +6,7 @@
|
||||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 2002-2006, AdaCore --
|
||||
-- Copyright (C) 2002-2007, 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- --
|
||||
@ -33,14 +33,14 @@
|
||||
|
||||
-- This is the VMS version
|
||||
|
||||
with System; use System;
|
||||
with Ada.Calendar; use Ada.Calendar;
|
||||
with System; use System;
|
||||
with Ada.Calendar; use Ada.Calendar;
|
||||
|
||||
with GNAT.IO;
|
||||
with GNAT.OS_Lib; use GNAT.OS_Lib;
|
||||
with GNAT.Regpat; use GNAT.Regpat;
|
||||
with GNAT.OS_Lib; use GNAT.OS_Lib;
|
||||
with GNAT.Regpat; use GNAT.Regpat;
|
||||
|
||||
with Unchecked_Deallocation;
|
||||
with Ada.Unchecked_Deallocation;
|
||||
|
||||
package body GNAT.Expect is
|
||||
|
||||
@ -72,7 +72,7 @@ package body GNAT.Expect is
|
||||
-- Reinitialize the internal buffer.
|
||||
-- The buffer is deleted up to the end of the last match.
|
||||
|
||||
procedure Free is new Unchecked_Deallocation
|
||||
procedure Free is new Ada.Unchecked_Deallocation
|
||||
(Pattern_Matcher, Pattern_Matcher_Access);
|
||||
|
||||
procedure Call_Filters
|
||||
@ -218,12 +218,21 @@ package body GNAT.Expect is
|
||||
Close (Descriptor.Output_Fd);
|
||||
|
||||
-- ??? Should have timeouts for different signals
|
||||
Kill (Descriptor.Pid, 9);
|
||||
|
||||
if Descriptor.Pid > 0 then -- see comment in Send_Signal
|
||||
Kill (Descriptor.Pid, Sig_Num => 9);
|
||||
end if;
|
||||
|
||||
GNAT.OS_Lib.Free (Descriptor.Buffer);
|
||||
Descriptor.Buffer_Size := 0;
|
||||
|
||||
Status := Waitpid (Descriptor.Pid);
|
||||
-- Check process id (see comment in Send_Signal)
|
||||
|
||||
if Descriptor.Pid > 0 then
|
||||
Status := Waitpid (Descriptor.Pid);
|
||||
else
|
||||
raise Invalid_Process;
|
||||
end if;
|
||||
end Close;
|
||||
|
||||
procedure Close (Descriptor : in out Process_Descriptor) is
|
||||
@ -327,7 +336,8 @@ package body GNAT.Expect is
|
||||
return;
|
||||
end if;
|
||||
|
||||
-- Calculate the timeout for the next turn.
|
||||
-- Calculate the timeout for the next turn
|
||||
|
||||
-- Note that Timeout is, from the caller's perspective, the maximum
|
||||
-- time until a match, not the maximum time until some output is
|
||||
-- read, and thus cannot be reused as is for Expect_Internal.
|
||||
@ -758,7 +768,6 @@ package body GNAT.Expect is
|
||||
end if;
|
||||
end case;
|
||||
end loop;
|
||||
|
||||
end Flush;
|
||||
|
||||
------------------------
|
||||
@ -894,7 +903,6 @@ package body GNAT.Expect is
|
||||
|
||||
procedure Interrupt (Descriptor : in out Process_Descriptor) is
|
||||
SIGINT : constant := 2;
|
||||
|
||||
begin
|
||||
Send_Signal (Descriptor, SIGINT);
|
||||
end Interrupt;
|
||||
@ -1030,9 +1038,10 @@ package body GNAT.Expect is
|
||||
|
||||
Call_Filters (Descriptor, Full_Str (Full_Str'First .. Last), Input);
|
||||
|
||||
Discard := Write (Descriptor.Input_Fd,
|
||||
Full_Str'Address,
|
||||
Last - Full_Str'First + 1);
|
||||
Discard :=
|
||||
Write (Descriptor.Input_Fd,
|
||||
Full_Str'Address,
|
||||
Last - Full_Str'First + 1);
|
||||
-- Shouldn't we at least have a pragma Assert on the result ???
|
||||
end Send;
|
||||
|
||||
@ -1045,8 +1054,19 @@ package body GNAT.Expect is
|
||||
Signal : Integer)
|
||||
is
|
||||
begin
|
||||
Kill (Descriptor.Pid, Signal);
|
||||
-- ??? Need to check process status here
|
||||
-- A nonpositive process id passed to kill has special meanings. For
|
||||
-- example, -1 means kill all processes in sight, including self, in
|
||||
-- POSIX and Windows (and something slightly different in Linux). See
|
||||
-- man pages for details. In any case, we don't want to do that. Note
|
||||
-- that Descriptor.Pid will be -1 if the process was not successfully
|
||||
-- started; we don't want to kill ourself in that case.
|
||||
|
||||
if Descriptor.Pid > 0 then
|
||||
Kill (Descriptor.Pid, Signal);
|
||||
-- ??? Need to check process status here
|
||||
else
|
||||
raise Invalid_Process;
|
||||
end if;
|
||||
end Send_Signal;
|
||||
|
||||
---------------------------------
|
||||
@ -1163,7 +1183,6 @@ package body GNAT.Expect is
|
||||
is
|
||||
pragma Warnings (Off, Descriptor);
|
||||
pragma Warnings (Off, User_Data);
|
||||
|
||||
begin
|
||||
GNAT.IO.Put (Str);
|
||||
end Trace_Filter;
|
||||
|
||||
@ -6,7 +6,7 @@
|
||||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 2000-2006, AdaCore --
|
||||
-- Copyright (C) 2000-2007, 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- --
|
||||
@ -38,7 +38,7 @@ with GNAT.IO;
|
||||
with GNAT.OS_Lib; use GNAT.OS_Lib;
|
||||
with GNAT.Regpat; use GNAT.Regpat;
|
||||
|
||||
with Unchecked_Deallocation;
|
||||
with Ada.Unchecked_Deallocation;
|
||||
|
||||
package body GNAT.Expect is
|
||||
|
||||
@ -66,10 +66,10 @@ package body GNAT.Expect is
|
||||
-- Reinitialize the internal buffer.
|
||||
-- The buffer is deleted up to the end of the last match.
|
||||
|
||||
procedure Free is new Unchecked_Deallocation
|
||||
procedure Free is new Ada.Unchecked_Deallocation
|
||||
(Pattern_Matcher, Pattern_Matcher_Access);
|
||||
|
||||
procedure Free is new Unchecked_Deallocation
|
||||
procedure Free is new Ada.Unchecked_Deallocation
|
||||
(Filter_List_Elem, Filter_List);
|
||||
|
||||
procedure Call_Filters
|
||||
@ -100,8 +100,7 @@ package body GNAT.Expect is
|
||||
(Fds : System.Address;
|
||||
Num_Fds : Integer;
|
||||
Timeout : Integer;
|
||||
Is_Set : System.Address)
|
||||
return Integer;
|
||||
Is_Set : System.Address) return Integer;
|
||||
pragma Import (C, Poll, "__gnat_expect_poll");
|
||||
-- Check whether there is any data waiting on the file descriptor
|
||||
-- Out_fd, and wait if there is none, at most Timeout milliseconds
|
||||
@ -128,8 +127,7 @@ package body GNAT.Expect is
|
||||
---------
|
||||
|
||||
function "+"
|
||||
(P : GNAT.Regpat.Pattern_Matcher)
|
||||
return Pattern_Matcher_Access
|
||||
(P : GNAT.Regpat.Pattern_Matcher) return Pattern_Matcher_Access
|
||||
is
|
||||
begin
|
||||
return new GNAT.Regpat.Pattern_Matcher'(P);
|
||||
@ -222,7 +220,9 @@ package body GNAT.Expect is
|
||||
|
||||
-- ??? Should have timeouts for different signals
|
||||
|
||||
Kill (Descriptor.Pid, 9, 0);
|
||||
if Descriptor.Pid > 0 then -- see comment in Send_Signal
|
||||
Kill (Descriptor.Pid, Sig_Num => 9, Close => 0);
|
||||
end if;
|
||||
|
||||
GNAT.OS_Lib.Free (Descriptor.Buffer);
|
||||
Descriptor.Buffer_Size := 0;
|
||||
@ -236,7 +236,14 @@ package body GNAT.Expect is
|
||||
end loop;
|
||||
|
||||
Descriptor.Filters := null;
|
||||
Status := Waitpid (Descriptor.Pid);
|
||||
|
||||
-- Check process id (see comment in Send_Signal)
|
||||
|
||||
if Descriptor.Pid > 0 then
|
||||
Status := Waitpid (Descriptor.Pid);
|
||||
else
|
||||
raise Invalid_Process;
|
||||
end if;
|
||||
end Close;
|
||||
|
||||
procedure Close (Descriptor : in out Process_Descriptor) is
|
||||
@ -863,7 +870,8 @@ package body GNAT.Expect is
|
||||
------------------
|
||||
|
||||
function Get_Error_Fd
|
||||
(Descriptor : Process_Descriptor) return GNAT.OS_Lib.File_Descriptor is
|
||||
(Descriptor : Process_Descriptor) return GNAT.OS_Lib.File_Descriptor
|
||||
is
|
||||
begin
|
||||
return Descriptor.Error_Fd;
|
||||
end Get_Error_Fd;
|
||||
@ -873,7 +881,8 @@ package body GNAT.Expect is
|
||||
------------------
|
||||
|
||||
function Get_Input_Fd
|
||||
(Descriptor : Process_Descriptor) return GNAT.OS_Lib.File_Descriptor is
|
||||
(Descriptor : Process_Descriptor) return GNAT.OS_Lib.File_Descriptor
|
||||
is
|
||||
begin
|
||||
return Descriptor.Input_Fd;
|
||||
end Get_Input_Fd;
|
||||
@ -883,7 +892,8 @@ package body GNAT.Expect is
|
||||
-------------------
|
||||
|
||||
function Get_Output_Fd
|
||||
(Descriptor : Process_Descriptor) return GNAT.OS_Lib.File_Descriptor is
|
||||
(Descriptor : Process_Descriptor) return GNAT.OS_Lib.File_Descriptor
|
||||
is
|
||||
begin
|
||||
return Descriptor.Output_Fd;
|
||||
end Get_Output_Fd;
|
||||
@ -893,7 +903,8 @@ package body GNAT.Expect is
|
||||
-------------
|
||||
|
||||
function Get_Pid
|
||||
(Descriptor : Process_Descriptor) return Process_Id is
|
||||
(Descriptor : Process_Descriptor) return Process_Id
|
||||
is
|
||||
begin
|
||||
return Descriptor.Pid;
|
||||
end Get_Pid;
|
||||
@ -904,7 +915,6 @@ package body GNAT.Expect is
|
||||
|
||||
procedure Interrupt (Descriptor : in out Process_Descriptor) is
|
||||
SIGINT : constant := 2;
|
||||
|
||||
begin
|
||||
Send_Signal (Descriptor, SIGINT);
|
||||
end Interrupt;
|
||||
@ -1106,8 +1116,7 @@ package body GNAT.Expect is
|
||||
Add_LF : Boolean := True;
|
||||
Empty_Buffer : Boolean := False)
|
||||
is
|
||||
Full_Str : constant String := Str & ASCII.LF;
|
||||
Last : Natural;
|
||||
Line_Feed : aliased constant String := (1 .. 1 => ASCII.LF);
|
||||
Result : Expect_Match;
|
||||
Descriptors : Array_Of_Pd := (1 => Descriptor'Unrestricted_Access);
|
||||
|
||||
@ -1119,8 +1128,8 @@ package body GNAT.Expect is
|
||||
|
||||
-- Force a read on the process if there is anything waiting
|
||||
|
||||
Expect_Internal (Descriptors, Result,
|
||||
Timeout => 0, Full_Buffer => False);
|
||||
Expect_Internal
|
||||
(Descriptors, Result, Timeout => 0, Full_Buffer => False);
|
||||
Descriptor.Last_Match_End := Descriptor.Buffer_Index;
|
||||
|
||||
-- Empty the buffer
|
||||
@ -1128,18 +1137,15 @@ package body GNAT.Expect is
|
||||
Reinitialize_Buffer (Descriptor);
|
||||
end if;
|
||||
|
||||
if Add_LF then
|
||||
Last := Full_Str'Last;
|
||||
else
|
||||
Last := Full_Str'Last - 1;
|
||||
end if;
|
||||
|
||||
Call_Filters (Descriptor, Full_Str (Full_Str'First .. Last), Input);
|
||||
|
||||
Call_Filters (Descriptor, Str, Input);
|
||||
Discard :=
|
||||
Write (Descriptor.Input_Fd,
|
||||
Full_Str'Address,
|
||||
Last - Full_Str'First + 1);
|
||||
Write (Descriptor.Input_Fd, Str'Address, Str'Last - Str'First + 1);
|
||||
|
||||
if Add_LF then
|
||||
Call_Filters (Descriptor, Line_Feed, Input);
|
||||
Discard :=
|
||||
Write (Descriptor.Input_Fd, Line_Feed'Address, 1);
|
||||
end if;
|
||||
end Send;
|
||||
|
||||
-----------------
|
||||
@ -1151,8 +1157,19 @@ package body GNAT.Expect is
|
||||
Signal : Integer)
|
||||
is
|
||||
begin
|
||||
Kill (Descriptor.Pid, Signal, 1);
|
||||
-- ??? Need to check process status here
|
||||
-- A nonpositive process id passed to kill has special meanings. For
|
||||
-- example, -1 means kill all processes in sight, including self, in
|
||||
-- POSIX and Windows (and something slightly different in Linux). See
|
||||
-- man pages for details. In any case, we don't want to do that. Note
|
||||
-- that Descriptor.Pid will be -1 if the process was not successfully
|
||||
-- started; we don't want to kill ourself in that case.
|
||||
|
||||
if Descriptor.Pid > 0 then
|
||||
Kill (Descriptor.Pid, Signal, Close => 1);
|
||||
-- ??? Need to check process status here
|
||||
else
|
||||
raise Invalid_Process;
|
||||
end if;
|
||||
end Send_Signal;
|
||||
|
||||
---------------------------------
|
||||
@ -1258,8 +1275,7 @@ package body GNAT.Expect is
|
||||
end if;
|
||||
end if;
|
||||
|
||||
-- As above, we record the proper fd for the child's
|
||||
-- standard error stream.
|
||||
-- As above, record the proper fd for the child's standard error stream
|
||||
|
||||
Pid.Error_Fd := Pipe3.Input;
|
||||
Set_Close_On_Exec (Pipe3.Input, True, Status);
|
||||
@ -1293,7 +1309,6 @@ package body GNAT.Expect is
|
||||
is
|
||||
pragma Warnings (Off, Descriptor);
|
||||
pragma Warnings (Off, User_Data);
|
||||
|
||||
begin
|
||||
GNAT.IO.Put (Str);
|
||||
end Trace_Filter;
|
||||
|
||||
@ -6,7 +6,7 @@
|
||||
-- --
|
||||
-- S p e c --
|
||||
-- --
|
||||
-- Copyright (C) 2000-2006, AdaCore --
|
||||
-- Copyright (C) 2000-2007, 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- --
|
||||
@ -188,41 +188,39 @@ package GNAT.Expect is
|
||||
procedure Close (Descriptor : in out Process_Descriptor);
|
||||
-- Terminate the process and close the pipes to it. It implicitly
|
||||
-- does the 'wait' command required to clean up the process table.
|
||||
-- This also frees the buffer associated with the process id.
|
||||
-- This also frees the buffer associated with the process id. Raise
|
||||
-- Invalid_Process if the process id is invalid.
|
||||
|
||||
procedure Close
|
||||
(Descriptor : in out Process_Descriptor;
|
||||
Status : out Integer);
|
||||
-- Same as above, but also returns the exit status of the process,
|
||||
-- as set for example by the procedure GNAT.OS_Lib.OS_Exit.
|
||||
-- Same as above, but also returns the exit status of the process, as set
|
||||
-- for example by the procedure GNAT.OS_Lib.OS_Exit.
|
||||
|
||||
procedure Send_Signal
|
||||
(Descriptor : Process_Descriptor;
|
||||
Signal : Integer);
|
||||
-- Send a given signal to the process
|
||||
-- Send a given signal to the process. Raise Invalid_Process if the process
|
||||
-- id is invalid.
|
||||
|
||||
procedure Interrupt (Descriptor : in out Process_Descriptor);
|
||||
-- Interrupt the process (the equivalent of Ctrl-C on unix and windows)
|
||||
-- and call close if the process dies.
|
||||
|
||||
function Get_Input_Fd
|
||||
(Descriptor : Process_Descriptor)
|
||||
return GNAT.OS_Lib.File_Descriptor;
|
||||
(Descriptor : Process_Descriptor) return GNAT.OS_Lib.File_Descriptor;
|
||||
-- Return the input file descriptor associated with Descriptor
|
||||
|
||||
function Get_Output_Fd
|
||||
(Descriptor : Process_Descriptor)
|
||||
return GNAT.OS_Lib.File_Descriptor;
|
||||
(Descriptor : Process_Descriptor) return GNAT.OS_Lib.File_Descriptor;
|
||||
-- Return the output file descriptor associated with Descriptor
|
||||
|
||||
function Get_Error_Fd
|
||||
(Descriptor : Process_Descriptor)
|
||||
return GNAT.OS_Lib.File_Descriptor;
|
||||
(Descriptor : Process_Descriptor) return GNAT.OS_Lib.File_Descriptor;
|
||||
-- Return the error output file descriptor associated with Descriptor
|
||||
|
||||
function Get_Pid
|
||||
(Descriptor : Process_Descriptor)
|
||||
return Process_Id;
|
||||
(Descriptor : Process_Descriptor) return Process_Id;
|
||||
-- Return the process id assocated with a given process descriptor
|
||||
|
||||
function Get_Command_Output
|
||||
@ -403,7 +401,7 @@ package GNAT.Expect is
|
||||
|
||||
type Regexp_Array is array (Positive range <>) of GNAT.OS_Lib.String_Access;
|
||||
|
||||
type Pattern_Matcher_Access is access GNAT.Regpat.Pattern_Matcher;
|
||||
type Pattern_Matcher_Access is access all GNAT.Regpat.Pattern_Matcher;
|
||||
type Compiled_Regexp_Array is array (Positive range <>)
|
||||
of Pattern_Matcher_Access;
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user