mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-04-30 03:40:34 +02:00
'spawn' ensures it is passed open file ports.
Fixes <https://bugs.gnu.org/61073>. * libguile/posix.c (FDES_FROM_PORT_OR_INTEGER): When OBJ is not an integer, use 'SCM_VALIDATE_OPFPORT' before using 'SCM_FPORT_FDES'. * test-suite/tests/posix.test ("spawn")["non-file port argument"]: New test.
This commit is contained in:
parent
35566ea585
commit
5b42f8c154
2 changed files with 18 additions and 5 deletions
|
@ -1486,12 +1486,20 @@ SCM_DEFINE (scm_spawn_process, "spawn", 2, 0, 1,
|
||||||
if (SCM_UNBNDP (err_scm))
|
if (SCM_UNBNDP (err_scm))
|
||||||
err_scm = scm_current_error_port ();
|
err_scm = scm_current_error_port ();
|
||||||
|
|
||||||
#define FDES_FROM_PORT_OR_INTEGER(obj) \
|
#define FDES_FROM_PORT_OR_INTEGER(fd, obj, pos) \
|
||||||
(scm_is_integer (obj) ? scm_to_int (obj) : SCM_FPORT_FDES (obj))
|
{ \
|
||||||
|
if (scm_is_integer (obj)) \
|
||||||
|
fd = scm_to_int (obj); \
|
||||||
|
else \
|
||||||
|
{ \
|
||||||
|
SCM_VALIDATE_OPFPORT (pos, obj); \
|
||||||
|
fd = SCM_FPORT_FDES (obj); \
|
||||||
|
} \
|
||||||
|
}
|
||||||
|
|
||||||
in = FDES_FROM_PORT_OR_INTEGER (in_scm);
|
FDES_FROM_PORT_OR_INTEGER (in, in_scm, 3);
|
||||||
out = FDES_FROM_PORT_OR_INTEGER (out_scm);
|
FDES_FROM_PORT_OR_INTEGER (out, out_scm, 4);
|
||||||
err = FDES_FROM_PORT_OR_INTEGER (err_scm);
|
FDES_FROM_PORT_OR_INTEGER (err, err_scm, 5);
|
||||||
|
|
||||||
#undef FDES_FROM_PORT_OR_INTEGER
|
#undef FDES_FROM_PORT_OR_INTEGER
|
||||||
|
|
||||||
|
|
|
@ -386,6 +386,11 @@
|
||||||
0
|
0
|
||||||
(cdr (waitpid (spawn "true" '("true")))))
|
(cdr (waitpid (spawn "true" '("true")))))
|
||||||
|
|
||||||
|
(pass-if-exception "non-file port argument" ;<https://bugs.gnu.org/61073>
|
||||||
|
exception:wrong-type-arg
|
||||||
|
(spawn "true" '("true")
|
||||||
|
#:error (%make-void-port "w")))
|
||||||
|
|
||||||
(pass-if-equal "uname with stdout redirect"
|
(pass-if-equal "uname with stdout redirect"
|
||||||
(list 0 ;exit value
|
(list 0 ;exit value
|
||||||
(string-append (utsname:sysname (uname)) " "
|
(string-append (utsname:sysname (uname)) " "
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue