bug#24047: Should 'signal' sometimes return?

[Paul Eggert <eggert@cs.ucla.edu>]

[-- Attachment #1: Type: text/plain, Size: 295 bytes --]

Attached is a more-conservative version of the patch, which keeps the 
debug-on-quit behavior when the user types C-g, so that 'signal' never 
returns but C-g might still "return". This is in response to Stefan's 
email at 
<http://lists.gnu.org/archive/html/emacs-devel/2016-07/msg00958.html>.

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-signal-no-longer-returns.patch --]
[-- Type: text/x-patch; name="0001-signal-no-longer-returns.patch", Size: 11634 bytes --]

From 8ac14fbe08d5cb14495ed6f57498abad41913804 Mon Sep 17 00:00:00 2001
From: Paul Eggert <eggert@cs.ucla.edu>
Date: Fri, 22 Jul 2016 12:31:07 +0200
Subject: [PATCH] =?UTF-8?q?=E2=80=98signal=E2=80=99=20no=20longer=20returns?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

Although for decades ‘signal’ has been documented to not return,
a corner case in the Lisp debugger causes ‘signal’ to return.
Remove the corner case and adjust Emacs internals accordingly.
An alternative would be to document the corner case, but this
would complicate the Lisp API unnecessarily.
* src/eval.c (signal_or_quit): New function, with most of the
old contents of Fsignal.
(quit): New function, which uses signal_or_quit and which
might return.  All keyboard-based callers of Fsignal (Qquit,
Qnil) changed to use this new function instead.
(Fsignal): Use signal_or_quit.  Now _Noreturn.  All callers
changed.
(xsignal): Move to lisp.h.
* src/lisp.h (xsignal): Now an inline function, as it's now
just an alias for Fsignal.
---
 src/bytecode.c |    2 +-
 src/charset.c  |    6 +++---
 src/coding.c   |    6 +++---
 src/eval.c     |   37 ++++++++++++++++++++++++-------------
 src/fileio.c   |    2 +-
 src/keyboard.c |    6 +++---
 src/lisp.h     |    7 ++++++-
 src/nsmenu.m   |    2 +-
 src/term.c     |    2 +-
 src/w32fns.c   |    2 +-
 src/w32menu.c  |    9 ++++-----
 src/xfns.c     |    6 +++---
 src/xmenu.c    |    6 +++---
 13 files changed, 54 insertions(+), 39 deletions(-)

diff --git a/src/bytecode.c b/src/bytecode.c
index 05bc9fc..ee1b79f 100644
--- a/src/bytecode.c
+++ b/src/bytecode.c
@@ -386,7 +386,7 @@ struct byte_stack
 	Vquit_flag = Qnil;				\
 	if (EQ (Vthrow_on_input, flag))			\
 	  Fthrow (Vthrow_on_input, Qt);			\
-	Fsignal (Qquit, Qnil);				\
+	quit ();					\
       }							\
     else if (pending_signals)				\
       process_pending_signals ();			\
diff --git a/src/charset.c b/src/charset.c
index 95a9c57..05469aa 100644
--- a/src/charset.c
+++ b/src/charset.c
@@ -843,9 +843,9 @@ range of code points (in CHARSET) of target characters.  */)
   int nchars;
 
   if (nargs != charset_arg_max)
-    return Fsignal (Qwrong_number_of_arguments,
-		    Fcons (intern ("define-charset-internal"),
-			   make_number (nargs)));
+    Fsignal (Qwrong_number_of_arguments,
+	     Fcons (intern ("define-charset-internal"),
+		    make_number (nargs)));
 
   attrs = Fmake_vector (make_number (charset_attr_max), Qnil);
 
diff --git a/src/coding.c b/src/coding.c
index 29c90f0..a8ddc81 100644
--- a/src/coding.c
+++ b/src/coding.c
@@ -10546,9 +10546,9 @@ assigned to each coding category (see `coding-category-list').
   return Qnil;
 
  short_args:
-  return Fsignal (Qwrong_number_of_arguments,
-		  Fcons (intern ("define-coding-system-internal"),
-			 make_number (nargs)));
+  Fsignal (Qwrong_number_of_arguments,
+	   Fcons (intern ("define-coding-system-internal"),
+		  make_number (nargs)));
 }
 
 
diff --git a/src/eval.c b/src/eval.c
index 72facd5..33b82f7 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -1431,6 +1431,7 @@ struct handler *
 }
 
 \f
+static Lisp_Object signal_or_quit (Lisp_Object, Lisp_Object, bool);
 static Lisp_Object find_handler_clause (Lisp_Object, Lisp_Object);
 static bool maybe_call_debugger (Lisp_Object conditions, Lisp_Object sig,
 				 Lisp_Object data);
@@ -1444,7 +1445,7 @@ static bool maybe_call_debugger (Lisp_Object conditions, Lisp_Object sig,
     Fkill_emacs (Qnil);
   if (EQ (Vthrow_on_input, flag))
     Fthrow (Vthrow_on_input, Qt);
-  Fsignal (Qquit, Qnil);
+  quit ();
 }
 
 DEFUN ("signal", Fsignal, Ssignal, 2, 2, 0,
@@ -1460,9 +1461,29 @@ static bool maybe_call_debugger (Lisp_Object conditions, Lisp_Object sig,
 See Info anchor `(elisp)Definition of signal' for some details on how this
 error message is constructed.
 If the signal is handled, DATA is made available to the handler.
-See also the function `condition-case'.  */)
+See also the function `condition-case'.  */
+       attributes: noreturn)
   (Lisp_Object error_symbol, Lisp_Object data)
 {
+  signal_or_quit (error_symbol, data, false);
+  eassume (false);
+}
+
+/* Quit, in response to a keyboard quit request.  */
+Lisp_Object
+quit (void)
+{
+  return signal_or_quit (Qquit, Qnil, true);
+}
+
+/* Signal an error, or quit.  ERROR_SYMBOL and DATA are as with Fsignal.
+   If KEYBOARD_QUIT, this is a quit; ERROR_SYMBOL should be
+   Qquit and DATA should be Qnil, and this function may return.
+   Otherwise this function is like Fsignal and does not return.  */
+
+static Lisp_Object
+signal_or_quit (Lisp_Object error_symbol, Lisp_Object data, bool keyboard_quit)
+{
   /* When memory is full, ERROR-SYMBOL is nil,
      and DATA is (REAL-ERROR-SYMBOL . REAL-DATA).
      That is a special case--don't do this in other situations.  */
@@ -1542,7 +1563,7 @@ static bool maybe_call_debugger (Lisp_Object conditions, Lisp_Object sig,
 	= maybe_call_debugger (conditions, error_symbol, data);
       /* We can't return values to code which signaled an error, but we
 	 can continue code which has signaled a quit.  */
-      if (debugger_called && EQ (real_error_symbol, Qquit))
+      if (keyboard_quit && debugger_called && EQ (real_error_symbol, Qquit))
 	return Qnil;
     }
 
@@ -1569,16 +1590,6 @@ static bool maybe_call_debugger (Lisp_Object conditions, Lisp_Object sig,
   fatal ("%s", SDATA (string));
 }
 
-/* Internal version of Fsignal that never returns.
-   Used for anything but Qquit (which can return from Fsignal).  */
-
-void
-xsignal (Lisp_Object error_symbol, Lisp_Object data)
-{
-  Fsignal (error_symbol, data);
-  emacs_abort ();
-}
-
 /* Like xsignal, but takes 0, 1, 2, or 3 args instead of a list.  */
 
 void
diff --git a/src/fileio.c b/src/fileio.c
index b1f9d3c..66ea761 100644
--- a/src/fileio.c
+++ b/src/fileio.c
@@ -4513,7 +4513,7 @@ buffer contents (in the accessible portion) with the file contents.
                              PT - BEG, Z - PT - inserted);
 
   if (read_quit)
-    Fsignal (Qquit, Qnil);
+    quit ();
 
   /* Retval needs to be dealt with in all cases consistently.  */
   if (NILP (val))
diff --git a/src/keyboard.c b/src/keyboard.c
index 8901ff0..ed49684 100644
--- a/src/keyboard.c
+++ b/src/keyboard.c
@@ -696,7 +696,7 @@ static Lisp_Object modify_event_symbol (ptrdiff_t, int, Lisp_Object,
 
   val = command_loop ();
   if (EQ (val, Qt))
-    Fsignal (Qquit, Qnil);
+    quit ();
   /* Handle throw from read_minibuf when using minibuffer
      while it's active but we're in another window.  */
   if (STRINGP (val))
@@ -7581,7 +7581,7 @@ struct user_signal_info
   /* If we got a quit from within the menu computation,
      quit all the way out of it.  This takes care of C-] in the debugger.  */
   if (CONSP (arg) && EQ (XCAR (arg), Qquit))
-    Fsignal (Qquit, Qnil);
+    quit ();
 
   return Qnil;
 }
@@ -10407,7 +10407,7 @@ shows the events before all translations (except for input methods).
 	  immediate_quit = false;
 	  pthread_sigmask (SIG_SETMASK, &empty_mask, 0);
 	  saved = gl_state;
-	  Fsignal (Qquit, Qnil);
+	  quit ();
 	  gl_state = saved;
 	}
       else
diff --git a/src/lisp.h b/src/lisp.h
index 39877d7..089f397 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -3879,7 +3879,12 @@ extern void map_obarray (Lisp_Object, void (*) (Lisp_Object, Lisp_Object),
 extern Lisp_Object run_hook_with_args (ptrdiff_t nargs, Lisp_Object *args,
 				       Lisp_Object (*funcall)
 				       (ptrdiff_t nargs, Lisp_Object *args));
-extern _Noreturn void xsignal (Lisp_Object, Lisp_Object);
+extern Lisp_Object quit (void);
+INLINE _Noreturn void
+xsignal (Lisp_Object error_symbol, Lisp_Object data)
+{
+  Fsignal (error_symbol, data);
+}
 extern _Noreturn void xsignal0 (Lisp_Object);
 extern _Noreturn void xsignal1 (Lisp_Object, Lisp_Object);
 extern _Noreturn void xsignal2 (Lisp_Object, Lisp_Object, Lisp_Object);
diff --git a/src/nsmenu.m b/src/nsmenu.m
index 83ded6d..d1f4b02 100644
--- a/src/nsmenu.m
+++ b/src/nsmenu.m
@@ -1843,7 +1843,7 @@ - (Lisp_Object)runDialogAt: (NSPoint)p
 
   if (EQ (ret, Qundefined) && window_closed)
     /* Make close button pressed equivalent to C-g.  */
-    Fsignal (Qquit, Qnil);
+    quit ();
 
   return ret;
 }
diff --git a/src/term.c b/src/term.c
index 81908b3..d54ff11 100644
--- a/src/term.c
+++ b/src/term.c
@@ -3759,7 +3759,7 @@ struct tty_menu_state
       /* Make "Cancel" equivalent to C-g unless FOR_CLICK (which means
 	 the menu was invoked with a mouse event as POSITION).  */
       if (!(menuflags & MENU_FOR_CLICK))
-        Fsignal (Qquit, Qnil);
+	quit ();
       break;
     }
 
diff --git a/src/w32fns.c b/src/w32fns.c
index d6b54d1..584e311 100644
--- a/src/w32fns.c
+++ b/src/w32fns.c
@@ -7584,7 +7584,7 @@ with offset DY added (default is -10).
 
   /* Make "Cancel" equivalent to C-g.  */
   if (NILP (filename))
-    Fsignal (Qquit, Qnil);
+    quit ();
 
   return filename;
 }
diff --git a/src/w32menu.c b/src/w32menu.c
index 13296d9..7c66360 100644
--- a/src/w32menu.c
+++ b/src/w32menu.c
@@ -827,7 +827,7 @@ typedef int (WINAPI * MessageBoxW_Proc) (
     {
       unblock_input ();
       /* Make "Cancel" equivalent to C-g.  */
-      Fsignal (Qquit, Qnil);
+      quit ();
     }
 
   unblock_input ();
@@ -1019,7 +1019,7 @@ typedef int (WINAPI * MessageBoxW_Proc) (
     }
   else
     /* Make "Cancel" equivalent to C-g.  */
-    Fsignal (Qquit, Qnil);
+    quit ();
 
   return Qnil;
 }
@@ -1155,7 +1155,7 @@ typedef int (WINAPI * MessageBoxW_Proc) (
   else if (answer == IDNO)
     lispy_answer = build_string ("No");
   else
-    Fsignal (Qquit, Qnil);
+    quit ();
 
   for (temp = XCDR (contents); CONSP (temp); temp = XCDR (temp))
     {
@@ -1177,8 +1177,7 @@ typedef int (WINAPI * MessageBoxW_Proc) (
 	  return value;
 	}
     }
-  Fsignal (Qquit, Qnil);
-  return Qnil;
+  return quit ();
 }
 #endif  /* !HAVE_DIALOGS  */
 \f
diff --git a/src/xfns.c b/src/xfns.c
index 798dc49..c44997b 100644
--- a/src/xfns.c
+++ b/src/xfns.c
@@ -6346,7 +6346,7 @@ with offset DY added (default is -10).
 
   /* Make "Cancel" equivalent to C-g.  */
   if (NILP (file))
-    Fsignal (Qquit, Qnil);
+    quit ();
 
   decoded_file = DECODE_FILE (file);
 
@@ -6418,7 +6418,7 @@ with offset DY added (default is -10).
 
   /* Make "Cancel" equivalent to C-g.  */
   if (NILP (file))
-    Fsignal (Qquit, Qnil);
+    quit ();
 
   decoded_file = DECODE_FILE (file);
 
@@ -6469,7 +6469,7 @@ Return either a font spec (for GTK versions >= 3.2) or a string
   unblock_input ();
 
   if (NILP (font))
-    Fsignal (Qquit, Qnil);
+    quit ();
 
   return unbind_to (count, font);
 }
diff --git a/src/xmenu.c b/src/xmenu.c
index 9e1a817..9ab7bdf 100644
--- a/src/xmenu.c
+++ b/src/xmenu.c
@@ -1649,7 +1649,7 @@ struct next_popup_x_y
     {
       unblock_input ();
       /* Make "Cancel" equivalent to C-g.  */
-      Fsignal (Qquit, Qnil);
+      quit ();
     }
 
   unblock_input ();
@@ -1913,7 +1913,7 @@ struct next_popup_x_y
     }
   else
     /* Make "Cancel" equivalent to C-g.  */
-    Fsignal (Qquit, Qnil);
+    quit ();
 
   return Qnil;
 }
@@ -2304,7 +2304,7 @@ struct next_popup_x_y
       if (!(menuflags & MENU_FOR_CLICK))
 	{
 	  unblock_input ();
-	  Fsignal (Qquit, Qnil);
+	  quit ();
 	}
       break;
     }
-- 
1.7.9.5