[PATCH v2] Improved ^c support for gdb/guile

[Doug Evans <xdje42 at gmail dot com>]

Doug Evans <xdje42@gmail.com> writes:

> 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.

Here's v2.

Unworkable-as-is optimization trying to avoid queueing asyncs.  Blech.

I'm still seeing intermittent testsuite failures because Guile is
getting an uncaught SIGINT.


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_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..8eb2f30 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,10 @@ 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);
 
 /* Interface to various GDB objects, in alphabetical order.  */
 
@@ -533,6 +539,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..8a35e07 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,39 @@ 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;
+
+  previous = set_active_ext_lang (&extension_language_guile);
+
+  /* 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.  */
+
+  if (gdb_scheme_initialized)
+    {
+      /* Install our SIGINT handler.  */
+      gdbscm_install_sigint_handler (&previous->sigint_handler);
+    }
+
+  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)
+{
+  restore_active_ext_lang (previous);
+}
+
 /* The "body" argument to scm_i_with_continuation_barrier.
    Invoke the user-supplied function.  */
 
@@ -169,6 +203,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 +218,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 +237,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 +247,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..cebaa6d
--- /dev/null
+++ b/gdb/guile/scm-sigint.c
@@ -0,0 +1,261 @@
+/* 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;
+
+/* 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;
+
+      /* Transfer over any already queued SIGINT.  */
+      if (check_quit_flag ())
+	{
+	  set_quit_flag ();
+	  notify_sigint_listener ();
+	}
+    }
+}
+
+/* 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)
+	{
+	  /* Note: There could be one or more bytes left in the pipe after
+	     we've switched out of Guile mode.  That's ok, if our async has
+	     already been queued, no additional ones are queued.  */
+	  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.*" \