gnu: chez-scheme: Backport test fix.issue-71203

The backported commit fixes crashes when signals are delivered to
non-Scheme threads, including GC worker threads and threads
created by foreign libraries.  This appears to have been the
cause of the intermittent test failures we have experienced.

* gnu/packages/patches/chez-scheme-backport-signal.patch: New patch.
* gnu/local.mk (dist_patch_DATA): Add it.
* gnu/packages/chez-scheme.scm (chez-scheme)[source]<patches>: Use it.
(chez-scheme-for-racket, chez-scheme): Enable tests.

Change-Id: Ifd87ca0d1707ef6ad067d883772a5b42803ead94

3 files changed, 89 insertions, 2 deletions

diff --git a/gnu/local.mk b/gnu/local.mk
index d21282938e..37b81f0b02 100644
--- a/gnu/local.mk
+++ b/gnu/local.mk
@@ -1025,6 +1025,7 @@ dist_patch_DATA =						\
   %D%/packages/patches/ccextractor-autoconf-tesseract.patch	\
   %D%/packages/patches/ccextractor-fix-ocr.patch		\
   %D%/packages/patches/chez-scheme-backport-configure.patch	\
+  %D%/packages/patches/chez-scheme-backport-signal.patch	\
   %D%/packages/patches/chez-scheme-bin-sh.patch			\
   %D%/packages/patches/circos-remove-findbin.patch		\
   %D%/packages/patches/cdparanoia-fpic.patch			\
diff --git a/gnu/packages/chez.scm b/gnu/packages/chez.scm
index dd98966c78..8c52bbb188 100644
--- a/gnu/packages/chez.scm
+++ b/gnu/packages/chez.scm
@@ -329,8 +329,6 @@ will name the threaded machine type unless THREADS? is provided as #f."
         (ice-9 match)
         (srfi srfi-34))
       #:out-of-source? #t
-      ;; Intermittent failures: https://github.com/cisco/ChezScheme/issues/809
-      #:tests? #f
       #:test-target "test" ; test-one test-some-fast test-some test test-more
       #:configure-flags
       #~`(,@(let* ((chez+version (strip-store-file-name #$output))
@@ -509,6 +507,7 @@ version of Chez Scheme.")
                 "1q66vafhiwk617z51qkm1v64r3bxqhhf5lzrmsa4l9d5yhvlyk09"))
               (file-name (git-file-name name version))
               (patches (search-patches "chez-scheme-backport-configure.patch"
+                                       "chez-scheme-backport-signal.patch"
                                        "chez-scheme-bin-sh.patch"))
               (snippet #~(begin
                            (use-modules (guix build utils))
diff --git a/gnu/packages/patches/chez-scheme-backport-signal.patch b/gnu/packages/patches/chez-scheme-backport-signal.patch
new file mode 100644
index 0000000000..1fee32b167
--- /dev/null
+++ b/gnu/packages/patches/chez-scheme-backport-signal.patch
@@ -0,0 +1,87 @@
+From e416651d8b53fa2eca6edde764a9131d128cd166 Mon Sep 17 00:00:00 2001
+From: Matthew Flatt <mflatt@racket-lang.org>
+Date: Sat, 2 Mar 2024 07:18:41 -0700
+Subject: [PATCH] constrain signal delivery to Scheme to the main thread (#813)
+
+The intent is to avoid crashes when a signal gets delimited to a
+thread that might not even be a Scheme thread. Also, we don't try to
+queue the event directly in the main thread's context, because then
+we'd need more of a lock (while signal handling is otherwise an
+implicit lock).
+
+(cherry picked from commit fc081fc447a786dd53286e5d7314b7217631cb68)
+---
+
+Notes:
+    This should fix intermittent test failures experienced by Guix:
+    see <https://github.com/cisco/ChezScheme/issues/809>.
+
+ c/globals.h      |  1 +
+ c/schsig.c       | 10 ++++++++++
+ c/thread.c       |  1 +
+ csug/system.stex |  2 ++
+ 4 files changed, 14 insertions(+)
+
+diff --git a/c/globals.h b/c/globals.h
+index d2a08299..eb2965c5 100644
+--- a/c/globals.h
++++ b/c/globals.h
+@@ -49,6 +49,7 @@ EXTERN int S_num_preserve_ownership_threads;
+ # ifdef IMPLICIT_ATOMIC_AS_EXPLICIT
+ EXTERN s_thread_mutex_t S_implicit_mutex;
+ # endif
++EXTERN s_thread_t S_main_thread_id;
+ #endif
+ 
+ /* segment.c */
+diff --git a/c/schsig.c b/c/schsig.c
+index a89ab62a..04677730 100644
+--- a/c/schsig.c
++++ b/c/schsig.c
+@@ -666,6 +666,16 @@ ptr S_dequeue_scheme_signals(ptr tc) {
+ static void forward_signal_to_scheme(INT sig) {
+   ptr tc = get_thread_context();
+ 
++#ifdef PTHREADS
++  /* deliver signals to the main thread, only; depending
++     on the threads that are running, `tc` might even be NULL */
++  if (tc != TO_PTR(&S_G.thread_context)) {
++    pthread_kill(S_main_thread_id, sig);
++    RESET_SIGNAL
++    return;
++  }
++#endif
++
+   if (enqueue_scheme_signal(tc, sig)) {
+     SIGNALINTERRUPTPENDING(tc) = Strue;
+     SOMETHINGPENDING(tc) = Strue;
+diff --git a/c/thread.c b/c/thread.c
+index 9a341b22..f130f44d 100644
+--- a/c/thread.c
++++ b/c/thread.c
+@@ -40,6 +40,7 @@ void S_thread_init(void) {
+     s_thread_cond_init(&S_terminated_cond);
+     S_alloc_mutex.owner = 0;
+     S_alloc_mutex.count = 0;
++    S_main_thread_id = s_thread_self();
+ 
+ # ifdef IMPLICIT_ATOMIC_AS_EXPLICIT
+     s_thread_mutex_init(&S_implicit_mutex);
+diff --git a/csug/system.stex b/csug/system.stex
+index d4f2bcbb..bb89f419 100644
+--- a/csug/system.stex
++++ b/csug/system.stex
+@@ -547,6 +547,8 @@ After a signal handler for a given signal has been registered, receipt
+ of the specified signal results in a call to the handler.
+ The handler is passed the signal number, allowing the same handler to
+ be used for different signals while differentiating among them.
++In a threaded version of the system, signals are always delivered to
++the main thread.
+ 
+ Signals handled in this fashion are treated like keyboard interrupts in
+ that the handler is not called immediately when the signal is delivered
+
+base-commit: 253230f7dfbb4fe777277d6bbf93f39f9567f086
+-- 
+2.41.0
+