mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-20 11:40:18 +02:00
Code Activity

Change `system*' to not leave dangling processes behind.

Browse source 
Fixes <http://bugs.gnu.org/13166>.

* libguile/simpos.c (scm_system_star): In the child, call `_exit'
  instead of `SCM_SYSERROR' when `execvp' fails.
* test-suite/tests/posix.test ("system*"): New test prefix.
This commit is contained in:
Ludovic Courtès 2012-12-19 23:15:45 +01:00
parent b9d724982d
commit 668ba7c955
2 changed files with 29 additions and 8 deletions
Download patch file Download diff file Expand all files Collapse all files

22
libguile/simpos.c
View file

@ -1,6 +1,6 @@
/* Copyright (C) 1995,1996,1997,1998,2000,2001, 2003, 2004, 2009, 2010 Free Software /* Copyright (C) 1995, 1996, 1997, 1998, 2000, 2001, 2003, 2004, 2009,
* Foundation, Inc. * 2010, 2012 Free Software Foundation, Inc.
* *
* This library is free software; you can redistribute it and/or * This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License * modify it under the terms of the GNU Lesser General Public License
* as published by the Free Software Foundation; either version 3 of * as published by the Free Software Foundation; either version 3 of
@ -26,6 +26,7 @@
#include <errno.h> #include <errno.h>
#include <signal.h> /* for SIG constants */ #include <signal.h> /* for SIG constants */
#include <stdlib.h> /* for getenv */ #include <stdlib.h> /* for getenv */
#include <stdio.h>
#include "libguile/_scm.h" #include "libguile/_scm.h"
@ -137,10 +138,17 @@ SCM_DEFINE (scm_system_star, "system*", 0, 0, 1,
if (pid == 0) if (pid == 0)
{ {
/* child */ /* child */
execvp (execargv[0], execargv); execvp (execargv[0], execargv);
SCM_SYSERROR;
/* not reached. */ /* Something went wrong. */
return SCM_BOOL_F; fprintf (stderr, "In execvp of %s: %s\n",
execargv[0], strerror (errno));
/* Exit directly instead of throwing, because otherwise this
process may keep on running. Use exit status 127, like
shells in this case, as per POSIX
<http://pubs.opengroup.org/onlinepubs/007904875/utilities/xcu_chap02.html#tag_02_09_01_01>. */
_exit (127);
} }
else else
{ {

15
test-suite/tests/posix.test
View file

@ -1,6 +1,6 @@
;;;; posix.test --- Test suite for Guile POSIX functions. -*- scheme -*- ;;;; posix.test --- Test suite for Guile POSIX functions. -*- scheme -*-
;;;; ;;;;
;;;; Copyright 2003, 2004, 2006, 2007, 2010 Free Software Foundation, Inc. ;;;; Copyright 2003, 2004, 2006, 2007, 2010, 2012 Free Software Foundation, Inc.
;;;; ;;;;
;;;; This library is free software; you can redistribute it and/or ;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public ;;;; modify it under the terms of the GNU Lesser General Public
@ -198,3 +198,16 @@
(setaffinity (getpid) mask) (setaffinity (getpid) mask)
(equal? mask (getaffinity (getpid)))) (equal? mask (getaffinity (getpid))))
(throw 'unresolved)))) (throw 'unresolved))))
;;
;; system*
;;
(with-test-prefix "system*"
(pass-if "http://bugs.gnu.org/13166"
;; With Guile up to 2.0.7 included, the child process launched by
;; `system*' would remain alive after an `execvp' failure.
(let ((me (getpid)))
(and (not (zero? (pk (system* "something-that-does-not-exist"))))
(= me (getpid))))))