diff --git a/gnatcoll.gpr b/gnatcoll.gpr index 78ec52db..888dbcab 100644 --- a/gnatcoll.gpr +++ b/gnatcoll.gpr @@ -43,15 +43,17 @@ project GnatColl is type OS_Kind is ("windows", "unix", "osx"); OS : OS_Kind := External ("GNATCOLL_OS", "unix"); - Sources := ("src", "src/os", "src/paragraph_filling"); - + Unix_Win32 := ""; case OS is when "unix" | "osx" => - Sources := Sources & ("src/os/unix"); + Unix_Win32 := "unix"; when "windows" => - Sources := Sources & ("src/os/win32"); + Unix_Win32 := "windows"; end case; + Sources := ("src", "src/os", "src/paragraph_filling", + "src/os/" & Unix_Win32); + case Projects is when "yes" => Sources := Sources & ("src/projects"); @@ -192,113 +194,58 @@ 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"; + + for Specification ("GNATCOLL.Mmap.System") + use "gnatcoll-mmap-system__" & Unix_Win32 & ".ads"; + for Implementation ("GNATCOLL.Mmap.System") + use "gnatcoll-mmap-system__" & Unix_Win32 & ".adb"; + for Implementation ("GNATCOLL.IO.Native.Codec") + use "gnatcoll-io-native-codec__" & Unix_Win32 & ".adb"; + for Implementation ("GNATCOLL.Plugins") + use "gnatcoll-plugins__" & Unix_Win32 & ".adb"; + for Implementation ("GNATCOLL.OS.Stat.Stat") + use "gnatcoll-os-stat-stat__" & Unix_Win32 & ".adb"; + for Implementation ("GNATCOLL.OS.FS.Null_File") + use "gnatcoll-os-fs-null_file__" & Unix_Win32 & ".adb"; + for Implementation ("GNATCOLL.OS.FS.Open") + use "gnatcoll-os-fs-open__" & Unix_Win32 & ".adb"; + for Implementation ("GNATCOLL.OS.FS.Set_Close_On_Exec") + use "gnatcoll-os-fs-set_close_on_exec__" & Unix_Win32 & ".adb"; + for Implementation ("GNATCOLL.OS.FS.Is_Console") + use "gnatcoll-os-fs-is_console__" & Unix_Win32 & ".adb"; + for Implementation ("GNATCOLL.OS.Process.Wait") + use "gnatcoll-os-process-wait__" & Unix_Win32 & ".adb"; + for Implementation ("GNATCOLL.OS.Process.Internal_Spawn") + use "gnatcoll-os-process-internal_spawn__" & Unix_Win32 & ".adb"; + for Specification ("GNATCOLL.OS.Process_Types") + use "gnatcoll-os-process_types__" & Unix_Win32 & ".ads"; + for Implementation ("GNATCOLL.OS.Process_Types") + use "gnatcoll-os-process_types__" & Unix_Win32 & ".adb"; + for Implementation ("GNATCOLL.OS.Process.State") + use "gnatcoll-os-process-state__" & Unix_Win32 & ".adb"; + for Implementation ("GNATCOLL.OS.Process.Wait_For_Processes") + use "gnatcoll-os-process-wait_for_processes__" & Unix_Win32 & ".adb"; + for Specification ("GNATCOLL.OS.Dir_Types") + use "gnatcoll-os-dir_types__" & Unix_Win32 & ".ads"; + for Implementation ("GNATCOLL.OS.Dir.Open") + use "gnatcoll-os-dir-open__" & Unix_Win32 & ".adb"; + for Implementation ("GNATCOLL.OS.Dir.Close") + use "gnatcoll-os-dir-close__" & Unix_Win32 & ".adb"; + for Implementation ("GNATCOLL.OS.Dir.Read") + use "gnatcoll-os-dir-read__" & Unix_Win32 & ".adb"; + for Implementation ("GNATCOLL.OS.FSUtil.Copy_File_Content") + use "gnatcoll-os-fsutil-copy_file_content__" & Unix_Win32 & ".adb"; + for Implementation ("GNATCOLL.OS.FSUtil.Copy_Permissions") + use "gnatcoll-os-fsutil-copy_permissions__" & Unix_Win32 & ".adb"; + for Implementation ("GNATCOLL.OS.FSUtil.Copy_Timestamps") + use "gnatcoll-os-fsutil-copy_timestamps__" & Unix_Win32 & ".adb"; case OS is when "unix" | "osx" => - for Specification ("GNATCOLL.Mmap.System") - use "gnatcoll-mmap-system__unix.ads"; - for Implementation ("GNATCOLL.Mmap.System") - use "gnatcoll-mmap-system__unix.adb"; - for Implementation ("GNATCOLL.IO.Native.Codec") - use "gnatcoll-io-native-codec__unix.adb"; - for Implementation ("GNATCOLL.Plugins") - use "gnatcoll-plugins__unix.adb"; - for Implementation ("GNATCOLL.OS.Stat.Stat") - use "gnatcoll-os-stat-stat__unix.adb"; - for Implementation ("GNATCOLL.OS.FS.Null_File") - use "gnatcoll-os-fs-null_file__unix.adb"; - for Implementation ("GNATCOLL.OS.FS.Open") - use "gnatcoll-os-fs-open__unix.adb"; - for Implementation ("GNATCOLL.OS.FS.Set_Close_On_Exec") - use "gnatcoll-os-fs-set_close_on_exec__unix.adb"; - for Implementation ("GNATCOLL.OS.FS.Is_Console") - use "gnatcoll-os-fs-is_console__unix.adb"; - for Implementation ("GNATCOLL.OS.Process.Wait") - use "gnatcoll-os-process-wait__unix.adb"; - for Implementation ("GNATCOLL.OS.Process.Internal_Spawn") - use "gnatcoll-os-process-internal_spawn__unix.adb"; - for Specification ("GNATCOLL.OS.Process_Types") - use "gnatcoll-os-process_types__unix.ads"; - for Implementation ("GNATCOLL.OS.Process_Types") - use "gnatcoll-os-process_types__unix.adb"; - for Implementation ("GNATCOLL.OS.Process.State") - use "gnatcoll-os-process-state__unix.adb"; - for Implementation ("GNATCOLL.OS.Process.Wait_For_Processes") - use "gnatcoll-os-process-wait_for_processes__unix.adb"; - for Specification ("GNATCOLL.OS.Dir_Types") - use "gnatcoll-os-dir_types__unix.ads"; - for Implementation ("GNATCOLL.OS.Dir.Open") - use "gnatcoll-os-dir-open__unix.adb"; - for Implementation ("GNATCOLL.OS.Dir.Close") - use "gnatcoll-os-dir-close__unix.adb"; - for Implementation ("GNATCOLL.OS.Dir.Read") - use "gnatcoll-os-dir-read__unix.adb"; - for Implementation ("GNATCOLL.OS.FSUtil.Copy_File_Content") - use "gnatcoll-os-fsutil-copy_file_content__unix.adb"; - for Implementation ("GNATCOLL.OS.FSUtil.Copy_Permissions") - use "gnatcoll-os-fsutil-copy_permissions__unix.adb"; - for Implementation ("GNATCOLL.OS.FSUtil.Copy_Timestamps") - use "gnatcoll-os-fsutil-copy_timestamps__unix.adb"; - when "windows" => - for Specification ("GNATCOLL.Mmap.System") - use "gnatcoll-mmap-system__win32.ads"; - for Implementation ("GNATCOLL.Mmap.System") - use "gnatcoll-mmap-system__win32.adb"; - for Implementation ("GNATCOLL.IO.Native.Codec") - use "gnatcoll-io-native-codec__win32.adb"; - for Implementation ("GNATCOLL.Plugins") - use "gnatcoll-plugins__windows.adb"; - for Implementation ("GNATCOLL.OS.Stat.Stat") - use "gnatcoll-os-stat-stat__win32.adb"; - for Implementation ("GNATCOLL.OS.FS.Is_Console") - use "gnatcoll-os-fs-is_console__win32.adb"; - for Implementation ("GNATCOLL.OS.FS.Null_File") - 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") - use "gnatcoll-os-process_types__win32.ads"; - for Implementation ("GNATCOLL.OS.Process_Types") - use "gnatcoll-os-process_types__win32.adb"; - for Implementation ("GNATCOLL.OS.Process.Wait") - use "gnatcoll-os-process-wait__win32.adb"; - for Implementation ("GNATCOLL.OS.Process.Internal_Spawn") - use "gnatcoll-os-process-internal_spawn__win32.adb"; - for Implementation ("GNATCOLL.OS.Process.State") - use "gnatcoll-os-process-state__win32.adb"; - for Implementation ("GNATCOLL.OS.Process.Wait_For_Processes") - use "gnatcoll-os-process-wait_for_processes__win32.adb"; - for Specification ("GNATCOLL.OS.Dir_Types") - use "gnatcoll-os-dir_types__win32.ads"; - for Implementation ("GNATCOLL.OS.Dir.Open") - use "gnatcoll-os-dir-open__win32.adb"; - for Implementation ("GNATCOLL.OS.Dir.Close") - use "gnatcoll-os-dir-close__win32.adb"; - for Implementation ("GNATCOLL.OS.Dir.Read") - use "gnatcoll-os-dir-read__win32.adb"; - for Implementation ("GNATCOLL.OS.FSUtil.Copy_File_Content") - use "gnatcoll-os-fsutil-copy_file_content__win32.adb"; - for Implementation ("GNATCOLL.OS.FSUtil.Copy_Permissions") - use "gnatcoll-os-fsutil-copy_permissions__win32.adb"; - for Implementation ("GNATCOLL.OS.FSUtil.Copy_Timestamps") - use "gnatcoll-os-fsutil-copy_timestamps__win32.adb"; - end case; - - case OS 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"; + use "gnatcoll-os-libc_constants__" & OS & ".ads"; when "windows" => null; end case; diff --git a/src/gnatcoll-plugins__windows.adb b/src/gnatcoll-plugins__win32.adb similarity index 100% rename from src/gnatcoll-plugins__windows.adb rename to src/gnatcoll-plugins__win32.adb 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 diff --git a/src/os/unix/gnatcoll-os-libc_constants__linux.ads b/src/os/unix/gnatcoll-os-libc_constants__unix.ads similarity index 100% rename from src/os/unix/gnatcoll-os-libc_constants__linux.ads rename to src/os/unix/gnatcoll-os-libc_constants__unix.ads