Skip to content

Commit 7693898

Browse files
committed
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
1 parent 34554f2 commit 7693898

4 files changed

+24
-28
lines changed

gnatcoll.gpr

+2-6
Original file line numberDiff line numberDiff line change
@@ -171,6 +171,8 @@ project GnatColl is
171171

172172
for Specification ("GNATCOLL.OS.Constants")
173173
use "gnatcoll-os-constants__" & OS & ".ads";
174+
for Implementation ("GNATCOLL.OS.FS.Open_Pipe")
175+
use "gnatcoll-os-fs-open_pipe__" & OS & ".adb";
174176

175177
case OS is
176178
when "unix" | "osx" =>
@@ -229,8 +231,6 @@ project GnatColl is
229231
use "gnatcoll-os-fs-null_file__win32.adb";
230232
for Implementation ("GNATCOLL.OS.FS.Open")
231233
use "gnatcoll-os-fs-open__win32.adb";
232-
for Implementation ("GNATCOLL.OS.FS.Open_Pipe")
233-
use "gnatcoll-os-fs-open_pipe__win32.adb";
234234
for Implementation ("GNATCOLL.OS.FS.Set_Close_On_Exec")
235235
use "gnatcoll-os-fs-set_close_on_exec__win32.adb";
236236
for Specification ("GNATCOLL.OS.Process_Types")
@@ -259,13 +259,9 @@ project GnatColl is
259259
when "unix" =>
260260
for Specification ("GNATCOLL.OS.Libc_Constants")
261261
use "gnatcoll-os-libc_constants__linux.ads";
262-
for Implementation ("GNATCOLL.OS.FS.Open_Pipe")
263-
use "gnatcoll-os-fs-open_pipe__linux.adb";
264262
when "osx" =>
265263
for Specification ("GNATCOLL.OS.Libc_Constants")
266264
use "gnatcoll-os-libc_constants__osx.ads";
267-
for Implementation ("GNATCOLL.OS.FS.Open_Pipe")
268-
use "gnatcoll-os-fs-open_pipe__unix.adb";
269265
when "windows" =>
270266
null;
271267
end case;

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

+18-4
Original file line numberDiff line numberDiff line change
@@ -22,6 +22,7 @@
2222
------------------------------------------------------------------------------
2323

2424
with GNATCOLL.OS.Libc;
25+
with GNAT.Task_Lock;
2526

2627
separate (GNATCOLL.OS.FS)
2728
procedure Open_Pipe
@@ -33,16 +34,29 @@ is
3334
Result : aliased Libc.Pipe_Type;
3435
Status : Libc.Libc_Status;
3536
begin
36-
37-
-- This implementation relies on the fact that pipe2 is used to open the
38-
-- pipe and flag set to O_CLOEXEC. Thus there is no need to call
39-
-- Set_Close_On_Exec.
37+
-- We need to ensure that a call to pipe and set_close_on_exec is done
38+
-- atomically. Otherwise the pipe file descriptors might leak into other
39+
-- processes and thus block the pipe (in programs mixing tasking and
40+
-- process spawning for example).
41+
GNAT.Task_Lock.Lock;
4042
Status := Libc.Pipe (Result'Access);
43+
4144
if Status = Libc.Error then
45+
GNAT.Task_Lock.Unlock;
4246
raise OS_Error with "cannot open pipe";
4347
end if;
4448

4549
Pipe_Read := Result.Input;
4650
Pipe_Write := Result.Output;
4751

52+
begin
53+
Set_Close_On_Exec (Pipe_Read, True);
54+
Set_Close_On_Exec (Pipe_Write, True);
55+
exception
56+
when OS_Error =>
57+
GNAT.Task_Lock.Unlock;
58+
raise;
59+
end;
60+
GNAT.Task_Lock.Unlock;
61+
4862
end Open_Pipe;

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

+4-18
Original file line numberDiff line numberDiff line change
@@ -22,7 +22,6 @@
2222
------------------------------------------------------------------------------
2323

2424
with GNATCOLL.OS.Libc;
25-
with GNAT.Task_Lock;
2625

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

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

4945
Pipe_Read := Result.Input;
5046
Pipe_Write := Result.Output;
5147

52-
begin
53-
Set_Close_On_Exec (Pipe_Read, True);
54-
Set_Close_On_Exec (Pipe_Write, True);
55-
exception
56-
when OS_Error =>
57-
GNAT.Task_Lock.Unlock;
58-
raise;
59-
end;
60-
GNAT.Task_Lock.Unlock;
61-
6248
end Open_Pipe;

0 commit comments

Comments
 (0)