[PATCH] Improved ^c support for gdb/guile

[Doug Evans <xdje42 at gmail dot com>]

Hi.

Here's my modest contribution to the Guile anniversary potluck.

The patch to selftest-support.exp could be done differently,
I've tried to keep it simple.  The problem is that gdb with guile
will get SIGPWR from time to time when Guile's GC kicks in,
and we need this to not alter test behaviour.  The patch just
tells the parent gdb to ignore SIGPWR, which is simple enough
without loss of coverage.  A good question is what other signals
Guile GC might use.

Regression tested on amd64-linux with guile 2.0.9.

2014-02-17  Doug Evans  <xdje42@gmail.com>

	* Makefile.in (SUBDIR_GUILE_OBS): Add scm-sigint.o.
	(SUBDIR_GUILE_SRCS): Add scm-sigint.c.
	(scm-sigint.o): New rule.
	* guile/guile-internal.h (gdbscm_make_sigint_exception): Declare.
	(gdbscm_install_sigint_handler): Declare.
	(gdbscm_enable_sigint, gdbscm_disable_sigint): Declare.
	(gdbscm_initialize_sigint): Declare.
	* guile/guile.c (initialize_gdb_module): Call gdbscm_initialize_sigint.
	* guile/scm-exception.c (gdbscm_make_sigint_exception): New function.
	(gdbscm_scm_from_gdb_exception): Call it.
	* guile/scm-safe-call.c: #include "guile.h".
	(gdbscm_enter_guile_mode, gdbscm_exit_guile_mode): New functions.
	(gdbscm_with_guile, gdbscm_call_guile): Call them.
	* guile/scm-sigint.c: New file.

	testsuite/
	* gdb.gdb/guile-interrupts.exp: New file.
	* gdb.gdb/guile-interrupts.gdb: New file.
	* lib/selftest-support.exp (selftest_setup): Don't stop for SIGPWR.

diff --git a/gdb/Makefile.in b/gdb/Makefile.in
index 2884725..2871e47 100644
--- a/gdb/Makefile.in
+++ b/gdb/Makefile.in
@@ -299,6 +299,7 @@ SUBDIR_GUILE_OBS = \
 	scm-ports.o \
 	scm-pretty-print.o \
 	scm-safe-call.o \
+	scm-sigint.o \
 	scm-string.o \
 	scm-symbol.o \
 	scm-symtab.o \
@@ -322,6 +323,7 @@ SUBDIR_GUILE_SRCS = \
 	guile/scm-ports.c \
 	guile/scm-pretty-print.c \
 	guile/scm-safe-call.c \
+	guile/scm-sigint.c \
 	guile/scm-string.c \
 	guile/scm-symbol.c \
 	guile/scm-symtab.c \
@@ -2280,6 +2282,10 @@ scm-frame.o: $(srcdir)/guile/scm-frame.c
 	$(COMPILE) $(srcdir)/guile/scm-frame.c
 	$(POSTCOMPILE)
 
+scm-sigint.o: $(srcdir)/guile/scm-sigint.c
+	$(COMPILE) $(srcdir)/guile/scm-sigint.c
+	$(POSTCOMPILE)
+
 scm-gsmob.o: $(srcdir)/guile/scm-gsmob.c
 	$(COMPILE) $(srcdir)/guile/scm-gsmob.c
 	$(POSTCOMPILE)
diff --git a/gdb/guile/guile-internal.h b/gdb/guile/guile-internal.h
index dcdd422..d4d718d 100644
--- a/gdb/guile/guile-internal.h
+++ b/gdb/guile/guile-internal.h
@@ -288,6 +288,8 @@ extern SCM gdbscm_out_of_range_error (const char *subr, int arg_pos,
 extern SCM gdbscm_make_misc_error (const char *subr, int arg_pos,
 				   SCM bad_value, const char *error);
 
+extern SCM gdbscm_make_sigint_exception (void);
+
 extern void gdbscm_throw (SCM exception) ATTRIBUTE_NORETURN;
 
 extern SCM gdbscm_scm_from_gdb_exception (struct gdb_exception exception);
@@ -341,6 +343,14 @@ extern char *gdbscm_safe_eval_string (const char *string, int display_result);
 extern char *gdbscm_safe_source_script (const char *filename);
 
 extern void gdbscm_enter_repl (void);
+
+/* scm-sigint.c */
+
+extern void gdbscm_install_sigint_handler (struct signal_handler *previous);
+
+extern void gdbscm_enable_sigint (void);
+
+extern void gdbscm_disable_sigint (void);
 
 /* Interface to various GDB objects, in alphabetical order.  */
 
@@ -533,6 +543,7 @@ extern void gdbscm_initialize_math (void);
 extern void gdbscm_initialize_objfiles (void);
 extern void gdbscm_initialize_pretty_printers (void);
 extern void gdbscm_initialize_ports (void);
+extern void gdbscm_initialize_sigint (void);
 extern void gdbscm_initialize_smobs (void);
 extern void gdbscm_initialize_strings (void);
 extern void gdbscm_initialize_symbols (void);
diff --git a/gdb/guile/guile.c b/gdb/guile/guile.c
index b7134f7..8f71c0a 100644
--- a/gdb/guile/guile.c
+++ b/gdb/guile/guile.c
@@ -545,6 +545,7 @@ initialize_gdb_module (void *data)
   gdbscm_initialize_objfiles ();
   gdbscm_initialize_ports ();
   gdbscm_initialize_pretty_printers ();
+  gdbscm_initialize_sigint ();
   gdbscm_initialize_strings ();
   gdbscm_initialize_symbols ();
   gdbscm_initialize_symtabs ();
diff --git a/gdb/guile/scm-exception.c b/gdb/guile/scm-exception.c
index a96a350..f752da8 100644
--- a/gdb/guile/scm-exception.c
+++ b/gdb/guile/scm-exception.c
@@ -404,6 +404,16 @@ gdbscm_memory_error_p (SCM key)
   return scm_is_eq (key, memory_error_symbol);
 }
 
+/* Create a SIGINT <gdb:exception>.  */
+
+SCM
+gdbscm_make_sigint_exception (void)
+{
+  /* This is copied from top-repl.scm.  */
+  return gdbscm_make_error (signal_symbol, NULL, _("User interrupt"),
+			    SCM_EOL, scm_list_1 (scm_from_int (SIGINT)));
+}
+
 /* Wrapper around scm_throw to throw a gdb:exception.
    This function does not return.
    This function cannot be called from inside TRY_CATCH.  */
@@ -426,8 +436,7 @@ gdbscm_scm_from_gdb_exception (struct gdb_exception exception)
   if (exception.reason == RETURN_QUIT)
     {
       /* Handle this specially to be consistent with top-repl.scm.  */
-      return gdbscm_make_error (signal_symbol, NULL, _("User interrupt"),
-				SCM_EOL, scm_list_1 (scm_from_int (SIGINT)));
+      return gdbscm_make_sigint_exception ();
     }
 
   if (exception.error == MEMORY_ERROR)
diff --git a/gdb/guile/scm-safe-call.c b/gdb/guile/scm-safe-call.c
index 147d7f5..a1e2ade 100644
--- a/gdb/guile/scm-safe-call.c
+++ b/gdb/guile/scm-safe-call.c
@@ -23,6 +23,7 @@
 #include "defs.h"
 #include "filenames.h"
 #include "gdb_assert.h"
+#include "guile.h"
 #include "guile-internal.h"
 
 /* Struct to marshall args to scscm_safe_call_body.  */
@@ -53,6 +54,45 @@ struct with_catch_data
   SCM catch_result;
 };
 
+/* Enter Guile mode from GDB.
+   This involves setting up the SIGINT handler so Guile sees them instead
+   of GDB.  */
+
+static struct active_ext_lang_state *
+gdbscm_enter_guile_mode (void)
+{
+  struct active_ext_lang_state *previous;
+
+  /* If the Scheme side hasn't been initialized yet (and in fact we are
+     called to perform the Scheme-side initialization), don't install our
+     SIGINT handler.  We don't want a ^c to affect initialization.  */
+
+  previous = set_active_ext_lang (&extension_language_guile);
+
+  if (gdb_scheme_initialized)
+    {
+      /* Install our SIGINT handler.  */
+      gdbscm_install_sigint_handler (&previous->sigint_handler);
+      /* Tell the SIGINT listener thread to pay attention to SIGINT
+	 notifications.  */
+      gdbscm_enable_sigint ();
+    }
+
+  return previous;
+}
+
+/* Return to GDB mode from Guile.
+   This undoes everything gdbscm_enter_guile_mode does.  */
+
+static void
+gdbscm_exit_guile_mode (struct active_ext_lang_state *previous)
+{
+  if (gdb_scheme_initialized)
+    gdbscm_disable_sigint ();
+
+  restore_active_ext_lang (previous);
+}
+
 /* The "body" argument to scm_i_with_continuation_barrier.
    Invoke the user-supplied function.  */
 
@@ -169,6 +209,7 @@ gdbscm_with_guile (void *(*func) (void *), void *data)
 {
   struct c_data c_data;
   struct with_catch_data catch_data;
+  struct active_ext_lang_state *previous;
 
   c_data.func = func;
   c_data.data = data;
@@ -183,8 +224,12 @@ gdbscm_with_guile (void *(*func) (void *), void *data)
   catch_data.stack = SCM_BOOL_F;
   catch_data.catch_result = SCM_UNSPECIFIED;
 
+  previous = gdbscm_enter_guile_mode ();
+
   scm_with_guile (gdbscm_with_catch, &catch_data);
 
+  gdbscm_exit_guile_mode (previous);
+
   return c_data.result;
 }
 
@@ -198,6 +243,7 @@ gdbscm_call_guile (SCM (*func) (void *), void *data,
 		   excp_matcher_func *ok_excps)
 {
   struct with_catch_data catch_data;
+  struct active_ext_lang_state *previous;
 
   catch_data.func = func;
   catch_data.data = data;
@@ -207,12 +253,16 @@ gdbscm_call_guile (SCM (*func) (void *), void *data,
   catch_data.stack = SCM_BOOL_F;
   catch_data.catch_result = SCM_UNSPECIFIED;
 
+  previous = gdbscm_enter_guile_mode ();
+
 #if 0
   scm_c_with_continuation_barrier (gdbscm_with_catch, &catch_data);
 #else
   scm_with_guile (gdbscm_with_catch, &catch_data);
 #endif
 
+  gdbscm_exit_guile_mode (previous);
+
   return catch_data.catch_result;
 }
 
diff --git a/gdb/guile/scm-sigint.c b/gdb/guile/scm-sigint.c
new file mode 100644
index 0000000..87ae947
--- /dev/null
+++ b/gdb/guile/scm-sigint.c
@@ -0,0 +1,292 @@
+/* GDB/Guile SIGINT handling.
+
+   Copyright (C) 2014 Free Software Foundation, Inc.
+
+   This file is part of GDB.
+
+   This program is free software; you can redistribute it and/or modify
+   it under the terms of the GNU General Public License as published by
+   the Free Software Foundation; either version 3 of the License, or
+   (at your option) any later version.
+
+   This program 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 General Public License for more details.
+
+   You should have received a copy of the GNU General Public License
+   along with this program.  If not, see <http://www.gnu.org/licenses/>.  */
+
+/* See README file in this directory for implementation notes, coding
+   conventions, et.al.  */
+
+/* Guile SIGINT handling works as follows:
+
+   The SIGINT handler writes a byte into a pipe, which the SIGINT processing
+   thread uses to indicate the need to queue an async handler with Guile.
+   Presence of data in the pipe does not indicate the need to *throw* a SIGINT,
+   it indicates the need to *check* whether to throw a SIGINT.  Whether to
+   throw a SIGINT is recorded in the same place GDB uses: quit_flag.
+   One consequence of this is that we can optimize calls into GDB: we don't
+   need to install GDB's SIGINT handler.   We do need to install the GDB
+   SIGINT handler for things like (execute "python print 42"), but that is
+   handled when we transition into Python.  */
+
+#include "defs.h"
+#include <signal.h>
+#include "extension-priv.h"
+#include "serial.h" /* For gdb_pipe.  */
+#include "guile-internal.h"
+
+/* The SIGINT handler writes a byte into this pipe to tell the SIGINT
+   processing thread to queue an async with Guile.  */
+static int siscm_sigint_pipe[2];
+
+/* The main thread.  Asyncs are delivered here.  */
+static SCM siscm_main_thread;
+
+/* The SIGINT listener thread.  */
+static SCM siscm_listener_thread;
+
+/* The async procedure to schedule if a SIGINT may be pending.  */
+static SCM siscm_check_and_throw_sigint;
+
+/* Non-zero if we're in Guile SIGINT-handling mode.
+   This is used to allow flushing the pipe when not in Guile mode.  */
+static int siscm_sigint_mode_enabled;
+
+/* Return non-zero if SIGINT handling has been initialized.  */
+
+static int
+siscm_sigint_initialized_p (void)
+{
+  return siscm_sigint_pipe[0] != -1;
+}
+
+/* Tell the SIGINT listener thread it needs to queue an async to check
+   for a SIGINT.
+   N.B. This is called from a signal handler so there is not much we can do.
+   One thing we *can* do is call write().  */
+
+static void
+notify_sigint_listener (void)
+{
+  /* It doesn't matter what we write, we just need to wake up the thread in
+     an async-safe way.  */
+  char c = '?';
+
+  if (write (siscm_sigint_pipe[1], &c, 1) != 1)
+    {
+      char error_msg[100];
+
+      /* This "shouldn't happen", so we don't have to be too fancy with the
+	 error text here.  However we should print something.  */
+      sprintf (error_msg, _("Error %d writing SIGINT pipe.\n"), errno);
+      write (2, error_msg, strlen (error_msg));
+    }
+}
+
+/* Our SIGINT handler.  */
+
+static void
+siscm_handle_sigint (int sig)
+{
+  signal (sig, siscm_handle_sigint);
+
+  /* Set the main flag that indicates a SIGINT has occurred.  */
+  set_quit_flag ();
+
+  /* Tell the SIGINT listener thread to queue an async to check it.  */
+  notify_sigint_listener ();
+}
+
+/* Install our SIGINT handler.  */
+
+void
+gdbscm_install_sigint_handler (struct signal_handler *previous)
+{
+  if (siscm_sigint_initialized_p ())
+    {
+      previous->handler = signal (SIGINT, siscm_handle_sigint);
+      previous->handler_saved = 1;
+    }
+}
+
+/* Tell our SIGINT listener thread it owns SIGINT handling now.
+   Thist must be called *after* Guile has been set as the active
+   extension language.  */
+
+void
+gdbscm_enable_sigint (void)
+{
+  if (siscm_sigint_initialized_p ())
+    {
+      siscm_sigint_mode_enabled = 1;
+
+      /* Transfer over any already queued SIGINT.  */
+      if (check_quit_flag ())
+	{
+	  set_quit_flag ();
+	  notify_sigint_listener ();
+	}
+    }
+}
+
+/* Tell our SIGINT listener thread to go quiescent.  */
+
+void
+gdbscm_disable_sigint (void)
+{
+  if (siscm_sigint_initialized_p ())
+    {
+      siscm_sigint_mode_enabled = 0;
+
+      /* We could drain the pipe here, but there's no data yet to suggest the
+	 extra complexity is needed.  */
+    }
+}
+
+/* Throw a SIGINT (User interrupt) if one is indicated.
+   This function must be run from the main gdb thread.
+   The return value is ignored so we just return "unspecified".  */
+
+static SCM
+gdbscm_check_and_throw_sigint (void)
+{
+  if (check_quit_flag ())
+    gdbscm_throw (gdbscm_make_sigint_exception ());
+  return SCM_UNSPECIFIED;
+}
+
+/* Struct to pass data to/from read_signal_pipe_data.  */
+
+struct signal_pipe_data
+{
+  char sigbyte;
+  ssize_t n;
+  int err;
+};
+
+/* Subroutine of siscm_sigint_listener_thread to pass to scm_without_guile.  */
+
+static void*
+read_signal_pipe_data (void *data)
+{
+  struct signal_pipe_data *sdata = data;
+  
+  sdata->n = read (siscm_sigint_pipe[0], &sdata->sigbyte, 1);
+  sdata->err = errno;
+
+  return NULL;
+}
+
+/* The main entry point for the SIGINT listening thread.
+   The result isn't used anywhere but the API requires we provide one,
+   for simplicity we return SCM_UNSPECIFIED.
+
+   IMPORTANT: This thread can do very little.  It can't modify any state
+   that the main gdb thread uses, unless we employ some locking but that's
+   expensive and unnecessary.  All we have to do is monitor the SIGINT pipe
+   for data and if there is queue an async for Guile to call.  It is the
+   async's job to call check_quit_flag to see if there is actually a SIGINT.
+   The async will be run in the main gdb thread and thus it will be safe to
+   call check_quit_flag.
+
+   FIXME(dje): I've observed the guile-interrupts.exp testcase intermittently
+   fail with symptoms of SIGINT's being delivered to this thread.  Eh?  */
+
+static SCM
+siscm_sigint_listener_thread (void *data)
+{
+  struct signal_pipe_data sigdata;
+
+  /* Check SCM_USE_PTHREAD_THREADS to avoid compilation failures.
+     This function will never get called if pthreads aren't available.  */
+#if SCM_USE_PTHREAD_THREADS
+  {
+    int rc;
+    sigset_t mask;
+
+    /*  Block most signals, certainly all async signals.  */
+    sigfillset (&mask);
+    sigdelset (&mask, SIGSEGV);
+    sigdelset (&mask, SIGABRT);
+    rc = pthread_sigmask (SIG_BLOCK, &mask, NULL);
+    if (rc != 0)
+      {
+	fprintf (stderr,
+		 "GDB/Guile SIGINT thread: Error setting signal mask: %s\n",
+		 safe_strerror (rc));
+	return SCM_UNSPECIFIED;
+      }
+  }
+#endif
+
+  do
+    {
+      /* We need to leave Guile mode because we've got most signals blocked,
+	 including SIGPWR(?) which is used by GC to notify threads.  If we
+	 don't leave Guile mode here we hang in GC_stop_world.  */
+      scm_without_guile (read_signal_pipe_data, &sigdata);
+
+      if (sigdata.n == 1)
+	{
+	  if (siscm_sigint_mode_enabled)
+	    {
+	      scm_system_async_mark_for_thread (siscm_check_and_throw_sigint,
+						siscm_main_thread);
+	    }
+	}
+    }
+  while (sigdata.n == 1);
+
+  if (sigdata.n < 0)
+    {
+      gdbscm_printf (scm_current_error_port (),
+		     "Error reading from SIGINT pipe: %s\n",
+		     safe_strerror (sigdata.err));
+    }
+
+  return SCM_UNSPECIFIED;
+}
+
+/* The exception handler for the SIGINT listening thread.
+   We don't expect to get any exceptions.  If we do, inform the user
+   and let the listener thread terminate.  */
+
+static SCM
+siscm_exception_catcher (void *data, SCM tag, SCM throw_args)
+{
+  gdbscm_printf (scm_current_error_port (),
+		 _("Exception in SIGINT listener thread: ~a/~a\n"),
+		 tag, throw_args);
+  return SCM_BOOL_F;
+}
+
+/* Initialize SIGINT support for GDB/Guile.  */
+
+void
+gdbscm_initialize_sigint (void)
+{
+  siscm_sigint_pipe[0] = siscm_sigint_pipe[1] = -1;
+
+  if (!SCM_USE_PTHREAD_THREADS)
+    {
+      warning (_("Guile does not have pthreads support."));
+      warning (_("Proper SIGINT handling for Guile will be unavailable."));
+      return;
+    }
+
+  if (gdb_pipe (siscm_sigint_pipe) != 0)
+    perror_with_name (_("Couldn't initialize Guile SIGINT pipe."));
+
+  siscm_main_thread = scm_current_thread ();
+  siscm_listener_thread = scm_spawn_thread (siscm_sigint_listener_thread, NULL,
+					    siscm_exception_catcher, NULL);
+
+  /* Get a Scheme handle of gdbscm_check_and_throw_sigint so we can pass it
+     to scm_system_async_mark_for_thread.  */
+  siscm_check_and_throw_sigint
+    = scm_c_define_gsubr ("check-and-throw-sigint", 0, 0, 0,
+			  gdbscm_check_and_throw_sigint);
+}
diff --git a/gdb/testsuite/gdb.gdb/guile-interrupts.exp b/gdb/testsuite/gdb.gdb/guile-interrupts.exp
new file mode 100644
index 0000000..b8636d4
--- /dev/null
+++ b/gdb/testsuite/gdb.gdb/guile-interrupts.exp
@@ -0,0 +1,86 @@
+# Copyright 2014 Free Software Foundation, Inc.
+
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or
+# (at your option) any later version.
+#
+# This program 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 General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+# Test Guile SIGINT handling.
+# This is easiest if we can send SIGINT when gdb is at particular points.
+
+load_lib selftest-support.exp
+load_lib gdb-guile.exp
+
+proc test_guile_interrupts {} {
+    global srcdir subdir
+
+    if {[skip_guile_tests]} {
+	return -1
+    }
+    set have_python [expr ![skip_python_tests]]
+
+    set file [remote_download host $srcdir/$subdir/guile-interrupts.gdb]
+
+    gdb_test "call catch_command_errors(execute_command, \"source $file\", 0, RETURN_MASK_ALL)" \
+	"guile-interrupts.gdb loaded.*"
+
+    # Test #1: Test SIGINT appearing during transition into Guile mode.
+
+    gdb_breakpoint set_active_ext_lang temporary
+
+    gdb_test "call catch_command_errors(execute_command, \"test-interrupt-1\", 0, RETURN_MASK_ALL)" \
+	"Temporary breakpoint.*silently stop."
+    gdb_test "signal SIGINT" \
+	"User interrupt.*Error while executing Scheme code." \
+	"signal SIGINT #1"
+
+    # Test #2: Test SIGINT appearing during transition out of Guile mode.
+
+    gdb_breakpoint restore_active_ext_lang temporary
+    # We need python's before_prompt_hook to not get in the way and take
+    # the SIGINT.
+    if { $have_python } {
+	set save_py_init [get_integer_valueof "gdb_python_initialized" 0]
+	gdb_test_no_output "set var gdb_python_initialized = 0"
+    }
+
+    gdb_test "call catch_command_errors(execute_command, \"test-interrupt-2\", 0, RETURN_MASK_ALL)" \
+	"Temporary breakpoint.*silently stop."
+    gdb_test "signal SIGINT" \
+	"type = Quit" "signal SIGINT #2"
+
+    if { $have_python } {
+	gdb_test_no_output "set var gdb_python_initialized = $save_py_init"
+    }
+
+    # Test #3: Test a SIGINT appearing during the transition from Guile
+    # to GDB to Python.  No QUIT calls (currently) exist in GDB mode during
+    # this transition so we expect Python to process the SIGINT.
+
+    if { $have_python } {
+	gdb_breakpoint set_active_ext_lang
+	gdb_test_no_output "set \$test_3_bpnum = \$bpnum"
+	# Ignore the transition into Guile.
+	# We want the transition into Python.
+	gdb_test "ignore \$test_3_bpnum 1" "Will ignore.*"
+
+	gdb_test "call catch_command_errors(execute_command, \"test-interrupt-3\", 0, RETURN_MASK_ALL)" \
+	    "The program being debugged stopped.*silently stop."
+	gdb_test_no_output "delete \$test_3_bpnum"
+	gdb_test "signal SIGINT" \
+	    "KeyboardInterrupt.*Error while executing Python code.*Error while executing Scheme code." \
+	    "signal SIGINT #3"
+    }
+
+    return 0
+}
+
+do_self_tests captured_command_loop test_guile_interrupts
diff --git a/gdb/testsuite/gdb.gdb/guile-interrupts.gdb b/gdb/testsuite/gdb.gdb/guile-interrupts.gdb
new file mode 100644
index 0000000..d7b5c73
--- /dev/null
+++ b/gdb/testsuite/gdb.gdb/guile-interrupts.gdb
@@ -0,0 +1,43 @@
+# Copyright 2014 Free Software Foundation, Inc.
+
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or
+# (at your option) any later version.
+#
+# This program 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 General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+# This test exercises a SIGINT happening during the transition into Guile.
+# We expect Guile to process the SIGINT.
+
+guile (use-modules (gdb))
+
+define test-interrupt-1
+  guile (begin (usleep 10) 42)
+end
+
+# This test exercises a SIGINT happening during the transition out of Guile.
+# We expect GDB to process the SIGINT.
+
+define test-interrupt-2
+  guile (begin (usleep 10) 43)
+  # ptype is used here because it calls QUIT.
+  ptype char *
+end
+
+# This test exercises a SIGINT happening during the transition from Guile
+# to GDB to Python.  No QUIT calls (currently) exist in GDB mode during
+# this transition so we expect Python to process the SIGINT.
+
+define test-interrupt-3
+  guile (execute "python print 44")
+end
+
+# Print something so the testcase can verify we've loaded successfully.
+echo guile-interrupts.gdb loaded\n
diff --git a/gdb/testsuite/lib/selftest-support.exp b/gdb/testsuite/lib/selftest-support.exp
index 9335477..0ccaf9f 100644
--- a/gdb/testsuite/lib/selftest-support.exp
+++ b/gdb/testsuite/lib/selftest-support.exp
@@ -76,6 +76,12 @@ proc selftest_setup { executable function } {
 	return -1
     }
 
+    # Guile GC uses SIGPWR to communicate with threads, so don't stop for
+    # them and just silently forward them on.  Always doing this doesn't
+    # reduce test coverage so we keep things simple.  We're not too picky
+    # with the expected output in case the host doesn't have SIGPWR.
+    gdb_test "handle SIGPWR nostop noprint pass" ""
+
     # Set a breakpoint at main
     gdb_test "break $function" \
             "Breakpoint.*at.* file.*, line.*" \