Commit a7737c19 by Arnaud Charlet

[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
parent ab01e614
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> 2014-07-29 Robert Dewar <dewar@adacore.com>
* einfo.adb (Derived_Type_Link): New function * einfo.adb (Derived_Type_Link): New function
......
...@@ -148,7 +148,11 @@ __gnat_pipe (int *fd) ...@@ -148,7 +148,11 @@ __gnat_pipe (int *fd)
} }
int 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 #define MAX_DELAY 100
...@@ -156,6 +160,8 @@ __gnat_expect_poll (int *fd, int num_fd, int timeout, int *is_set) ...@@ -156,6 +160,8 @@ __gnat_expect_poll (int *fd, int num_fd, int timeout, int *is_set)
DWORD avail; DWORD avail;
HANDLE handles[num_fd]; HANDLE handles[num_fd];
*dead_process = 0;
for (i = 0; i < num_fd; i++) for (i = 0; i < num_fd; i++)
is_set[i] = 0; is_set[i] = 0;
...@@ -174,6 +180,7 @@ __gnat_expect_poll (int *fd, int num_fd, int timeout, int *is_set) ...@@ -174,6 +180,7 @@ __gnat_expect_poll (int *fd, int num_fd, int timeout, int *is_set)
for (i = 0; i < num_fd; i++) for (i = 0; i < num_fd; i++)
{ {
if (!PeekNamedPipe (handles [i], NULL, 0, NULL, &avail, NULL)) if (!PeekNamedPipe (handles [i], NULL, 0, NULL, &avail, NULL))
*dead_process = i + 1;
return -1; return -1;
if (avail > 0) if (avail > 0)
...@@ -245,7 +252,11 @@ __gnat_expect_portable_execvp (int *pid, char *cmd, char *argv[]) ...@@ -245,7 +252,11 @@ __gnat_expect_portable_execvp (int *pid, char *cmd, char *argv[])
} }
int 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; int i, num, ready = 0;
unsigned int status; unsigned int status;
...@@ -258,6 +269,8 @@ __gnat_expect_poll (int *fd, int num_fd, int timeout, int *is_set) ...@@ -258,6 +269,8 @@ __gnat_expect_poll (int *fd, int num_fd, int timeout, int *is_set)
} iosb; } iosb;
char buf [256]; char buf [256];
*dead_process = 0;
for (i = 0; i < num_fd; i++) for (i = 0; i < num_fd; i++)
is_set[i] = 0; is_set[i] = 0;
...@@ -280,6 +293,7 @@ __gnat_expect_poll (int *fd, int num_fd, int timeout, int *is_set) ...@@ -280,6 +293,7 @@ __gnat_expect_poll (int *fd, int num_fd, int timeout, int *is_set)
if ((status & 1) != 1) if ((status & 1) != 1)
{ {
ready = -1; ready = -1;
dead_process = i + 1;
return ready; return ready;
} }
} }
...@@ -395,7 +409,11 @@ __gnat_expect_portable_execvp (int *pid, char *cmd, char *argv[]) ...@@ -395,7 +409,11 @@ __gnat_expect_portable_execvp (int *pid, char *cmd, char *argv[])
} }
int 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; struct timeval tv;
SELECT_MASK rset; SELECT_MASK rset;
...@@ -406,6 +424,8 @@ __gnat_expect_poll (int *fd, int num_fd, int timeout, int *is_set) ...@@ -406,6 +424,8 @@ __gnat_expect_poll (int *fd, int num_fd, int timeout, int *is_set)
int i; int i;
int received; int received;
*dead_process = 0;
tv.tv_sec = timeout / 1000; tv.tv_sec = timeout / 1000;
tv.tv_usec = (timeout % 1000) * 1000; tv.tv_usec = (timeout % 1000) * 1000;
...@@ -458,6 +478,7 @@ __gnat_expect_poll (int *fd, int num_fd, int timeout, int *is_set) ...@@ -458,6 +478,7 @@ __gnat_expect_poll (int *fd, int num_fd, int timeout, int *is_set)
if (ei.request == TIOCCLOSE) if (ei.request == TIOCCLOSE)
{ {
ioctl (fd[i], TIOCREQSET, &ei); ioctl (fd[i], TIOCREQSET, &ei);
dead_process = i + 1;
return -1; return -1;
} }
...@@ -510,10 +531,12 @@ __gnat_expect_portable_execvp (int *pid ATTRIBUTE_UNUSED, ...@@ -510,10 +531,12 @@ __gnat_expect_portable_execvp (int *pid ATTRIBUTE_UNUSED,
int int
__gnat_expect_poll (int *fd ATTRIBUTE_UNUSED, __gnat_expect_poll (int *fd ATTRIBUTE_UNUSED,
int num_fd ATTRIBUTE_UNUSED, int num_fd ATTRIBUTE_UNUSED,
int timeout ATTRIBUTE_UNUSED, int timeout ATTRIBUTE_UNUSED,
int *is_set ATTRIBUTE_UNUSED) int *dead_process ATTRIBUTE_UNUSED,
int *is_set ATTRIBUTE_UNUSED)
{ {
*dead_process = 0;
return -1; return -1;
} }
#endif #endif
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -104,17 +104,22 @@ package body GNAT.Expect is ...@@ -104,17 +104,22 @@ package body GNAT.Expect is
pragma Import (C, Create_Pipe, "__gnat_pipe"); pragma Import (C, Create_Pipe, "__gnat_pipe");
function Poll function Poll
(Fds : System.Address; (Fds : System.Address;
Num_Fds : Integer; Num_Fds : Integer;
Timeout : Integer; Timeout : Integer;
Is_Set : System.Address) return Integer; Dead_Process : access Integer;
Is_Set : System.Address) return Integer;
pragma Import (C, Poll, "__gnat_expect_poll"); pragma Import (C, Poll, "__gnat_expect_poll");
-- Check whether there is any data waiting on the file descriptor -- Check whether there is any data waiting on the file descriptors
-- Out_fd, and wait if there is none, at most Timeout milliseconds -- Fds, and wait if there is none, at most Timeout milliseconds
-- Returns -1 in case of error, 0 if the timeout expired before -- Returns -1 in case of error, 0 if the timeout expired before
-- data became available. -- 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; function Waitpid (Pid : Process_Id) return Integer;
pragma Import (C, Waitpid, "__gnat_waitpid"); pragma Import (C, Waitpid, "__gnat_waitpid");
...@@ -632,7 +637,7 @@ package body GNAT.Expect is ...@@ -632,7 +637,7 @@ package body GNAT.Expect is
-- Buffer used for input. This is allocated only once, not for -- Buffer used for input. This is allocated only once, not for
-- every iteration of the loop -- every iteration of the loop
D : Integer; D : aliased Integer;
-- Index in Descriptors -- Index in Descriptors
begin begin
...@@ -640,7 +645,7 @@ package body GNAT.Expect is ...@@ -640,7 +645,7 @@ package body GNAT.Expect is
loop loop
Num_Descriptors := 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 case Num_Descriptors is
...@@ -648,6 +653,12 @@ package body GNAT.Expect is ...@@ -648,6 +653,12 @@ package body GNAT.Expect is
when -1 => when -1 =>
Result := Expect_Internal_Error; Result := Expect_Internal_Error;
if D /= 0 then
Close (Descriptors (D).Input_Fd);
Descriptors (D).Input_Fd := Invalid_FD;
end if;
return; return;
-- Timeout? -- Timeout?
...@@ -813,7 +824,7 @@ package body GNAT.Expect is ...@@ -813,7 +824,7 @@ package body GNAT.Expect is
is is
Buffer_Size : constant Integer := 8192; Buffer_Size : constant Integer := 8192;
Num_Descriptors : Integer; Num_Descriptors : Integer;
N : Integer; N : aliased Integer;
Is_Set : aliased Integer; Is_Set : aliased Integer;
Buffer : aliased String (1 .. Buffer_Size); Buffer : aliased String (1 .. Buffer_Size);
...@@ -827,7 +838,11 @@ package body GNAT.Expect is ...@@ -827,7 +838,11 @@ package body GNAT.Expect is
loop loop
Num_Descriptors := 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 case Num_Descriptors is
......
...@@ -4260,6 +4260,8 @@ Don't quit. Try semantics, even if parse errors. ...@@ -4260,6 +4260,8 @@ Don't quit. Try semantics, even if parse errors.
@item -gnatQ @item -gnatQ
@cindex @option{-gnatQ} (@command{gcc}) @cindex @option{-gnatQ} (@command{gcc})
Don't quit. Generate @file{ALI} and tree files even if illegalities. 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 @item -gnatr
@cindex @option{-gnatr} (@command{gcc}) @cindex @option{-gnatr} (@command{gcc})
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment