mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-04-29 19:30:36 +02:00
5a8502a494
Fixes <https://bugs.gnu.org/68087>. * libguile/scmsigs.h (scm_i_signals_pre_fork, scm_i_signals_post_fork): New declarations. (scm_i_signal_delivery_thread): Change type to SCM.. * libguile/threads.c (scm_all_threads): Adjust accordingly and exclude threads that have ‘t->exited’. Access ‘thread_count’ after grabbing ‘thread_admin_mutex’. * libguile/posix.c (scm_fork): Add calls to ‘scm_i_signals_pre_fork’ and ‘scm_i_signals_post_fork’. * libguile/scmsigs.c (signal_delivery_thread): Close signal_pipe[0] upon exit and set it to -1. (once): New file-global variable, moved from… (scm_i_ensure_signal_delivery_thread): … here. (stop_signal_delivery_thread, scm_i_signals_pre_fork) (scm_i_signals_post_fork): New functions. * test-suite/standalone/test-sigaction-fork: New file. * test-suite/standalone/Makefile.am (check_SCRIPTS, TESTS): Add it.
85 lines
2.9 KiB
Scheme
Executable file
85 lines
2.9 KiB
Scheme
Executable file
#!/bin/sh
|
|
exec guile -q -s "$0" "$@"
|
|
!#
|
|
;;; test-sigaction-fork --- Signal thread vs. fork, again.
|
|
;;;
|
|
;;; Copyright (C) 2024 Free Software Foundation, Inc.
|
|
;;;
|
|
;;; This library is free software; you can redistribute it and/or
|
|
;;; modify it under the terms of the GNU Lesser General Public
|
|
;;; License as published by the Free Software Foundation; either
|
|
;;; version 3 of the License, or (at your option) any later version.
|
|
;;;
|
|
;;; This library is distributed in the hope that it will be useful,
|
|
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
|
;;; Lesser General Public License for more details.
|
|
;;;
|
|
;;; You should have received a copy of the GNU Lesser General Public
|
|
;;; License along with this library; if not, write to the Free Software
|
|
;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
|
|
|
|
;;; Test the bug described at <https://bugs.gnu.org/68087>: the signal
|
|
;;; thread would not be restarted after a call to 'primitive-fork',
|
|
;;; leading signals to be silently ignored.
|
|
|
|
(use-modules (ice-9 match))
|
|
|
|
(define signals-handled
|
|
;; List of signals handled.
|
|
'())
|
|
|
|
(define parent
|
|
;; PID of the parent process.
|
|
(getpid))
|
|
|
|
(unless (provided? 'fork)
|
|
(exit 77))
|
|
|
|
;; This call spawns the signal delivery thread as a side effect.
|
|
(sigaction SIGALRM
|
|
(lambda (signal)
|
|
(call-with-blocked-asyncs
|
|
(lambda ()
|
|
(set! signals-handled
|
|
(cons `(first-handler . ,(getpid))
|
|
signals-handled))))))
|
|
|
|
(kill (getpid) SIGALRM)
|
|
(while (null? signals-handled) ;let the async run
|
|
(sleep 1))
|
|
|
|
(match (primitive-fork)
|
|
(0
|
|
(pk 'child (getpid) signals-handled)
|
|
(kill (getpid) SIGALRM) ;first handler
|
|
(sleep 1) ;let the async run
|
|
(sigaction SIGALRM
|
|
(lambda (signal)
|
|
(call-with-blocked-asyncs
|
|
(lambda ()
|
|
(set! signals-handled
|
|
(cons `(second-handler . ,(getpid))
|
|
signals-handled))))))
|
|
(kill (getpid) SIGALRM) ;second handler
|
|
(sleep 1) ;give asyncs one more chance to run
|
|
(format (current-error-port) "signals handled by the child + parent: ~s~%"
|
|
signals-handled)
|
|
(exit (equal? signals-handled
|
|
`((second-handler . ,(getpid))
|
|
(first-handler . ,(getpid))
|
|
(first-handler . ,parent)))))
|
|
|
|
(child
|
|
(kill (getpid) SIGALRM) ;first handler
|
|
(sleep 1) ;give asyncs one more chance to run
|
|
(format (current-error-port) "signals handled by the parent: ~s~%"
|
|
signals-handled)
|
|
(exit (and (equal? signals-handled
|
|
`((first-handler . ,parent)
|
|
(first-handler . ,parent)))
|
|
(zero? (cdr (waitpid child)))))))
|
|
|
|
;;; Local Variables:
|
|
;;; mode: scheme
|
|
;;; End:
|