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

3 files changed, 98 insertions, 66 deletions

diff --git a/gcc/ada/g-expect-vms.adb b/gcc/ada/g-expect-vms.adb
index 55ede65..c4c4419 100644
--- a/gcc/ada/g-expect-vms.adb
+++ b/gcc/ada/g-expect-vms.adb
@@ -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;
diff --git a/gcc/ada/g-expect.adb b/gcc/ada/g-expect.adb
index ffbcfc3..fb9d296 100644
--- a/gcc/ada/g-expect.adb
+++ b/gcc/ada/g-expect.adb
@@ -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;
 
+      Call_Filters (Descriptor, Str, Input);
+      Discard :=
+        Write (Descriptor.Input_Fd, Str'Address, Str'Last - Str'First + 1);
+
       if Add_LF then
-         Last := Full_Str'Last;
-      else
-         Last := Full_Str'Last - 1;
+         Call_Filters (Descriptor, Line_Feed, Input);
+         Discard :=
+           Write (Descriptor.Input_Fd, Line_Feed'Address, 1);
       end if;
-
-      Call_Filters (Descriptor, Full_Str (Full_Str'First .. Last), Input);
-
-      Discard :=
-        Write (Descriptor.Input_Fd,
-               Full_Str'Address,
-               Last - Full_Str'First + 1);
    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;
diff --git a/gcc/ada/g-expect.ads b/gcc/ada/g-expect.ads
index 7cc1bad..7d9eced 100644
--- a/gcc/ada/g-expect.ads
+++ b/gcc/ada/g-expect.ads
@@ -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;