Skip to content

Commit

Permalink
project: improve consistency of os-fs-open_pipe variants
Browse files Browse the repository at this point in the history
The changes confuse git, but the Ada sources are actually not
modified, only renamed:
win32 -> windows
unix  -> osx
linux -> unix
  • Loading branch information
asarhaddon committed Apr 21, 2022
1 parent 34554f2 commit 7693898
Show file tree
Hide file tree
Showing 4 changed files with 24 additions and 28 deletions.
8 changes: 2 additions & 6 deletions gnatcoll.gpr
Original file line number Diff line number Diff line change
Expand Up @@ -171,6 +171,8 @@ project GnatColl is

for Specification ("GNATCOLL.OS.Constants")
use "gnatcoll-os-constants__" & OS & ".ads";
for Implementation ("GNATCOLL.OS.FS.Open_Pipe")
use "gnatcoll-os-fs-open_pipe__" & OS & ".adb";

case OS is
when "unix" | "osx" =>
Expand Down Expand Up @@ -229,8 +231,6 @@ project GnatColl is
use "gnatcoll-os-fs-null_file__win32.adb";
for Implementation ("GNATCOLL.OS.FS.Open")
use "gnatcoll-os-fs-open__win32.adb";
for Implementation ("GNATCOLL.OS.FS.Open_Pipe")
use "gnatcoll-os-fs-open_pipe__win32.adb";
for Implementation ("GNATCOLL.OS.FS.Set_Close_On_Exec")
use "gnatcoll-os-fs-set_close_on_exec__win32.adb";
for Specification ("GNATCOLL.OS.Process_Types")
Expand Down Expand Up @@ -259,13 +259,9 @@ project GnatColl is
when "unix" =>
for Specification ("GNATCOLL.OS.Libc_Constants")
use "gnatcoll-os-libc_constants__linux.ads";
for Implementation ("GNATCOLL.OS.FS.Open_Pipe")
use "gnatcoll-os-fs-open_pipe__linux.adb";
when "osx" =>
for Specification ("GNATCOLL.OS.Libc_Constants")
use "gnatcoll-os-libc_constants__osx.ads";
for Implementation ("GNATCOLL.OS.FS.Open_Pipe")
use "gnatcoll-os-fs-open_pipe__unix.adb";
when "windows" =>
null;
end case;
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -22,6 +22,7 @@
------------------------------------------------------------------------------

with GNATCOLL.OS.Libc;
with GNAT.Task_Lock;

separate (GNATCOLL.OS.FS)
procedure Open_Pipe
Expand All @@ -33,16 +34,29 @@ is
Result : aliased Libc.Pipe_Type;
Status : Libc.Libc_Status;
begin

-- This implementation relies on the fact that pipe2 is used to open the
-- pipe and flag set to O_CLOEXEC. Thus there is no need to call
-- Set_Close_On_Exec.
-- We need to ensure that a call to pipe and set_close_on_exec is done
-- atomically. Otherwise the pipe file descriptors might leak into other
-- processes and thus block the pipe (in programs mixing tasking and
-- process spawning for example).
GNAT.Task_Lock.Lock;
Status := Libc.Pipe (Result'Access);

if Status = Libc.Error then
GNAT.Task_Lock.Unlock;
raise OS_Error with "cannot open pipe";
end if;

Pipe_Read := Result.Input;
Pipe_Write := Result.Output;

begin
Set_Close_On_Exec (Pipe_Read, True);
Set_Close_On_Exec (Pipe_Write, True);
exception
when OS_Error =>
GNAT.Task_Lock.Unlock;
raise;
end;
GNAT.Task_Lock.Unlock;

end Open_Pipe;
22 changes: 4 additions & 18 deletions src/os/gnatcoll-os-fs-open_pipe__unix.adb
Original file line number Diff line number Diff line change
Expand Up @@ -22,7 +22,6 @@
------------------------------------------------------------------------------

with GNATCOLL.OS.Libc;
with GNAT.Task_Lock;

separate (GNATCOLL.OS.FS)
procedure Open_Pipe
Expand All @@ -34,29 +33,16 @@ is
Result : aliased Libc.Pipe_Type;
Status : Libc.Libc_Status;
begin
-- We need to ensure that a call to pipe and set_close_on_exec is done
-- atomically. Otherwise the pipe file descriptors might leak into other
-- processes and thus block the pipe (in programs mixing tasking and
-- process spawning for example).
GNAT.Task_Lock.Lock;
Status := Libc.Pipe (Result'Access);

-- This implementation relies on the fact that pipe2 is used to open the
-- pipe and flag set to O_CLOEXEC. Thus there is no need to call
-- Set_Close_On_Exec.
Status := Libc.Pipe (Result'Access);
if Status = Libc.Error then
GNAT.Task_Lock.Unlock;
raise OS_Error with "cannot open pipe";
end if;

Pipe_Read := Result.Input;
Pipe_Write := Result.Output;

begin
Set_Close_On_Exec (Pipe_Read, True);
Set_Close_On_Exec (Pipe_Write, True);
exception
when OS_Error =>
GNAT.Task_Lock.Unlock;
raise;
end;
GNAT.Task_Lock.Unlock;

end Open_Pipe;
File renamed without changes.

0 comments on commit 7693898

Please sign in to comment.