This is the mail archive of the
gdb-patches@sourceware.org
mailing list for the GDB project.
[PATCH v2] Improved ^c support for gdb/guile
- From: Doug Evans <xdje42 at gmail dot com>
- To: gdb-patches at sourceware dot org
- Date: Mon, 17 Feb 2014 15:26:27 -0500
- Subject: [PATCH v2] Improved ^c support for gdb/guile
- Authentication-results: sourceware.org; auth=none
- References: <wrbvbwejihe dot fsf at sspiff dot org>
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.*" \