[multiple changes]

2014-07-29  Jerome Lambourg  <lambourg@adacore.com>

	* expect.c (__gnat_expect_poll): New parameter dead_process
	used to return the dead process among the array of file
	descriptors. The Windows, VMS and HPUX implementations now
	properly report the dead process via this parameter. Other unixes
	don't need it.
	* g-expect.adb (Poll): Adapt to the C profile.
	(Expect_Internal): Use the new parameter to properly close the
	File Descriptor.  This then can be properly reported by the
	function First_Dead_Process as is expected.

2014-07-29  Robert Dewar  <dewar@adacore.com>

	* gnat_ugn.texi: Minor clarification of -gnatQ switch.

From-SVN: r213177

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index a04acf4e2a38e650b745fc53e1791971aa1d261d..08877c33943168a1ed6c1d8f5181cb41fae8708f 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,19 @@
+2014-07-29  Jerome Lambourg  <lambourg@adacore.com>
+
+       * expect.c (__gnat_expect_poll): New parameter dead_process
+       used to return the dead process among the array of file
+       descriptors. The Windows, VMS and HPUX implementations now
+       properly report the dead process via this parameter. Other unixes
+       don't need it.
+       * g-expect.adb (Poll): Adapt to the C profile.
+       (Expect_Internal): Use the new parameter to properly close the
+       File Descriptor.  This then can be properly reported by the
+       function First_Dead_Process as is expected.
+
+2014-07-29  Robert Dewar  <dewar@adacore.com>
+
+       * gnat_ugn.texi: Minor clarification of -gnatQ switch.
+
 2014-07-29  Robert Dewar  <dewar@adacore.com>
 
        * einfo.adb (Derived_Type_Link): New function

diff --git a/gcc/ada/expect.c b/gcc/ada/expect.c
index aa014a6a38195e4817fab69e03ef4f1db08817cf..ce03224e9cf93314a83d413417f742d919b51109 100644 (file)
--- a/gcc/ada/expect.c
+++ b/gcc/ada/expect.c
@@ -148,7 +148,11 @@ __gnat_pipe (int *fd)
 }
 
 int
-__gnat_expect_poll (int *fd, int num_fd, int timeout, int *is_set)
+__gnat_expect_poll (int *fd,
+                    int num_fd,
+                    int timeout,
+                    int *dead_process,
+                    int *is_set)
 {
 #define MAX_DELAY 100
 
@@ -156,6 +160,8 @@ __gnat_expect_poll (int *fd, int num_fd, int timeout, int *is_set)
   DWORD avail;
   HANDLE handles[num_fd];
 
+  *dead_process = 0;
+
   for (i = 0; i < num_fd; i++)
     is_set[i] = 0;
 
@@ -174,6 +180,7 @@ __gnat_expect_poll (int *fd, int num_fd, int timeout, int *is_set)
       for (i = 0; i < num_fd; i++)
         {
           if (!PeekNamedPipe (handles [i], NULL, 0, NULL, &avail, NULL))
+            *dead_process = i + 1;
             return -1;
 
           if (avail > 0)
@@ -245,7 +252,11 @@ __gnat_expect_portable_execvp (int *pid, char *cmd, char *argv[])
 }
 
 int
-__gnat_expect_poll (int *fd, int num_fd, int timeout, int *is_set)
+__gnat_expect_poll (int *fd,
+                    int num_fd,
+                    int timeout,
+                    int *dead_process,
+                    int *is_set)
 {
   int i, num, ready = 0;
   unsigned int status;
@@ -258,6 +269,8 @@ __gnat_expect_poll (int *fd, int num_fd, int timeout, int *is_set)
   } iosb;
   char buf [256];
 
+  *dead_process = 0;
+
   for (i = 0; i < num_fd; i++)
     is_set[i] = 0;
 
@@ -280,6 +293,7 @@ __gnat_expect_poll (int *fd, int num_fd, int timeout, int *is_set)
          if ((status & 1) != 1)
            {
              ready = -1;
+              dead_process = i + 1;
              return ready;
            }
        }
@@ -395,7 +409,11 @@ __gnat_expect_portable_execvp (int *pid, char *cmd, char *argv[])
 }
 
 int
-__gnat_expect_poll (int *fd, int num_fd, int timeout, int *is_set)
+__gnat_expect_poll (int *fd,
+                    int num_fd,
+                    int timeout,
+                    int *dead_process,
+                    int *is_set)
 {
   struct timeval tv;
   SELECT_MASK rset;
@@ -406,6 +424,8 @@ __gnat_expect_poll (int *fd, int num_fd, int timeout, int *is_set)
   int i;
   int received;
 
+  *dead_process = 0;
+
   tv.tv_sec  = timeout / 1000;
   tv.tv_usec = (timeout % 1000) * 1000;
 
@@ -458,6 +478,7 @@ __gnat_expect_poll (int *fd, int num_fd, int timeout, int *is_set)
                    if (ei.request == TIOCCLOSE)
                      {
                        ioctl (fd[i], TIOCREQSET, &ei);
+                        dead_process = i + 1;
                        return -1;
                      }
 
@@ -510,10 +531,12 @@ __gnat_expect_portable_execvp (int *pid ATTRIBUTE_UNUSED,
 
 int
 __gnat_expect_poll (int *fd ATTRIBUTE_UNUSED,
-                   int num_fd ATTRIBUTE_UNUSED,
-                   int timeout ATTRIBUTE_UNUSED,
-                   int *is_set ATTRIBUTE_UNUSED)
+                    int num_fd ATTRIBUTE_UNUSED,
+                    int timeout ATTRIBUTE_UNUSED,
+                    int *dead_process ATTRIBUTE_UNUSED,
+                    int *is_set ATTRIBUTE_UNUSED)
 {
+  *dead_process = 0;
   return -1;
 }
 #endif

diff --git a/gcc/ada/g-expect.adb b/gcc/ada/g-expect.adb
index 94f69642af4f24afd969737b42f89a1882b9b74d..94f80e92263dbf4ebbc6360a25b4beef345fd504 100644 (file)
--- a/gcc/ada/g-expect.adb
+++ b/gcc/ada/g-expect.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---                     Copyright (C) 2000-2012, AdaCore                     --
+--                     Copyright (C) 2000-2014, 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- --
@@ -104,17 +104,22 @@ package body GNAT.Expect is
    pragma Import (C, Create_Pipe, "__gnat_pipe");
 
    function Poll
-     (Fds     : System.Address;
-      Num_Fds : Integer;
-      Timeout : Integer;
-      Is_Set  : System.Address) return Integer;
+     (Fds          : System.Address;
+      Num_Fds      : Integer;
+      Timeout      : Integer;
+      Dead_Process : access 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
+   --  Check whether there is any data waiting on the file descriptors
+   --  Fds, and wait if there is none, at most Timeout milliseconds
    --  Returns -1 in case of error, 0 if the timeout expired before
    --  data became available.
    --
-   --  Out_Is_Set is set to 1 if data was available, 0 otherwise.
+   --  Is_Set is an array of the same size as FDs and elements are set to 1 if
+   --  data is available for the corresponding File Descriptor, 0 otherwise.
+   --
+   --  If a process dies, then Dead_Process is set to the index of the
+   --  corresponding file descriptor.
 
    function Waitpid (Pid : Process_Id) return Integer;
    pragma Import (C, Waitpid, "__gnat_waitpid");
@@ -632,7 +637,7 @@ package body GNAT.Expect is
          --  Buffer used for input. This is allocated only once, not for
          --  every iteration of the loop
 
-         D : Integer;
+         D : aliased Integer;
          --  Index in Descriptors
 
       begin
@@ -640,7 +645,7 @@ package body GNAT.Expect is
 
          loop
             Num_Descriptors :=
-              Poll (Fds'Address, Fds_Count, Timeout, Is_Set'Address);
+              Poll (Fds'Address, Fds_Count, Timeout, D'Access, Is_Set'Address);
 
             case Num_Descriptors is
 
@@ -648,6 +653,12 @@ package body GNAT.Expect is
 
                when -1 =>
                   Result := Expect_Internal_Error;
+
+                  if D /= 0 then
+                     Close (Descriptors (D).Input_Fd);
+                     Descriptors (D).Input_Fd := Invalid_FD;
+                  end if;
+
                   return;
 
                --  Timeout?
@@ -813,7 +824,7 @@ package body GNAT.Expect is
    is
       Buffer_Size     : constant Integer := 8192;
       Num_Descriptors : Integer;
-      N               : Integer;
+      N               : aliased Integer;
       Is_Set          : aliased Integer;
       Buffer          : aliased String (1 .. Buffer_Size);
 
@@ -827,7 +838,11 @@ package body GNAT.Expect is
 
       loop
          Num_Descriptors :=
-           Poll (Descriptor.Output_Fd'Address, 1, Timeout, Is_Set'Address);
+           Poll (Descriptor.Output_Fd'Address,
+                 1,
+                 Timeout,
+                 N'Access,
+                 Is_Set'Address);
 
          case Num_Descriptors is
 

diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi
index b4a7025fcfcd688626b5f4dc3f7d6ee7803c7297..e6cc74da608c4116ea99ef533a6cf04eff190b1d 100644 (file)
--- a/gcc/ada/gnat_ugn.texi
+++ b/gcc/ada/gnat_ugn.texi
@@ -4260,6 +4260,8 @@ Don't quit. Try semantics, even if parse errors.
 @item -gnatQ
 @cindex @option{-gnatQ} (@command{gcc})
 Don't quit. Generate @file{ALI} and tree files even if illegalities.
+Note that code generation is still suppressed in the presence of any
+errors, so even with @option{-gnatQ} no object file is generated.
 
 @item -gnatr
 @cindex @option{-gnatr} (@command{gcc})