diff options
| -rw-r--r-- | gcc/ada/ChangeLog | 16 | ||||
| -rw-r--r-- | gcc/ada/expect.c | 35 | ||||
| -rw-r--r-- | gcc/ada/g-expect.adb | 39 | ||||
| -rw-r--r-- | gcc/ada/gnat_ugn.texi | 2 |
4 files changed, 74 insertions, 18 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index a04acf4..08877c3 100644 --- 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 aa014a6..ce03224 100644 --- 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 94f6964..94f80e9 100644 --- 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 b4a7025..e6cc74d 100644 --- 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}) |