From 7693898913e6429684aaec7f6a0199718652148d Mon Sep 17 00:00:00 2001 From: Nicolas Boulenguez Date: Thu, 21 Apr 2022 18:22:28 +0200 Subject: [PATCH] project: improve consistency of os-fs-open_pipe variants The changes confuse git, but the Ada sources are actually not modified, only renamed: win32 -> windows unix -> osx linux -> unix --- gnatcoll.gpr | 8 ++----- ....adb => gnatcoll-os-fs-open_pipe__osx.adb} | 22 +++++++++++++++---- src/os/gnatcoll-os-fs-open_pipe__unix.adb | 22 ++++--------------- ... => gnatcoll-os-fs-open_pipe__windows.adb} | 0 4 files changed, 24 insertions(+), 28 deletions(-) rename src/os/{gnatcoll-os-fs-open_pipe__linux.adb => gnatcoll-os-fs-open_pipe__osx.adb} (80%) rename src/os/{gnatcoll-os-fs-open_pipe__win32.adb => gnatcoll-os-fs-open_pipe__windows.adb} (100%) diff --git a/gnatcoll.gpr b/gnatcoll.gpr index b508adf9..38deff03 100644 --- a/gnatcoll.gpr +++ b/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" => @@ -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") @@ -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; diff --git a/src/os/gnatcoll-os-fs-open_pipe__linux.adb b/src/os/gnatcoll-os-fs-open_pipe__osx.adb similarity index 80% rename from src/os/gnatcoll-os-fs-open_pipe__linux.adb rename to src/os/gnatcoll-os-fs-open_pipe__osx.adb index a3a45b52..cd123cd5 100644 --- a/src/os/gnatcoll-os-fs-open_pipe__linux.adb +++ b/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; diff --git a/src/os/gnatcoll-os-fs-open_pipe__unix.adb b/src/os/gnatcoll-os-fs-open_pipe__unix.adb index cd123cd5..a3a45b52 100644 --- a/src/os/gnatcoll-os-fs-open_pipe__unix.adb +++ b/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; diff --git a/src/os/gnatcoll-os-fs-open_pipe__win32.adb b/src/os/gnatcoll-os-fs-open_pipe__windows.adb similarity index 100% rename from src/os/gnatcoll-os-fs-open_pipe__win32.adb rename to src/os/gnatcoll-os-fs-open_pipe__windows.adb