project: improve consistency of os-fs-open_pipe variants

Author: asarhaddon

gnatcoll.gpr

@@ -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" =>
@@ -225,8 +227,6 @@ project GnatColl is
               use "gnatcoll-os-fs-is_console__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")
@@ -255,13 +255,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";
       end case;
    end Naming;
 

src/os/gnatcoll-os-fs-open_pipe__linux.adb renamed to src/os/gnatcoll-os-fs-open_pipe__osx.adb

@@ -22,6 +22,7 @@
 ------------------------------------------------------------------------------
 
 with GNATCOLL.OS.Libc;
+with GNAT.Task_Lock;
 
 separate (GNATCOLL.OS.FS)
 procedure Open_Pipe
@@ -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;

src/os/gnatcoll-os-fs-open_pipe__unix.adb

@@ -22,7 +22,6 @@
 ------------------------------------------------------------------------------
 
 with GNATCOLL.OS.Libc;
-with GNAT.Task_Lock;
 
 separate (GNATCOLL.OS.FS)
 procedure Open_Pipe
@@ -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;