Package: emacs;
Message #68 received at 66912 <at> debbugs.gnu.org (full text, mbox):
From: Alan Mackenzie <acm <at> muc.de> To: Stefan Monnier <monnier <at> iro.umontreal.ca> Cc: acm <at> muc.de, 66912 <at> debbugs.gnu.org Subject: Re: Bug#66912: With `require', the byte compiler reports the wrong file for errors. Date: Mon, 4 Nov 2024 21:08:35 +0000
Hello, Stefan.
On Mon, Nov 04, 2024 at 11:12:19 -0500, Stefan Monnier wrote:
> >> I don't understand the above code: `handler-bind` is not supposed to
> >> call setjmp/longjmp: when the handler of a `handler-bind` gets called,
> >> the stack is not unwound.
> > I started off by just making the HANDLER_BIND case use the same code as
> > CONDITION_CASE, and got segfaults. I've tried to find the places where
> > a longjmp gets called for condition-case, but my brain's tired after a
> > weekend of heavy coding.
> The longjmp is in `unwind_to_catch`, called from `signal_or_quit`, but
> we only get there for CONDITION_CASE, not for HANDLER_BIND.
OK, thanks.
> > Given HANDLER_BIND doesn't need the setjmp/longjmp mechanism, it would
> > seem there's no sense in combining the HANDLER_BIND and CONDITION_CASE
> > cases in internal_cc_hb and friends. I should just restore the
> > condition-case functions to what they were, and add separate new ones
> > for handler-bind.
> OK.
DONE.
> > I think I see now you're right. push_handler doesn't push an entry onto
> > the binding stack. I'll amend these comments as soon as I understand
> > the code. I think these lines definitely need comments.
> Maybe pointing the reader to the SKIP_CONDITIONS comment in `lisp.h`?
I've put a brief comment on the line saying /* Restore after
`max_ensure_room'. */
> >> Also there's no reason to presume the HANDLER_BIND handler is at the
> >> top, so if we wanted to remove it, we'd have to work harder.
> > This code is difficult to understand. What is the purpose of the
> > binding block around the call of the handler function? I think a
> > comment here would help.
> The `unbind_to` is there because `max_ensure_room` may
> `specbind` something. In 99% of the cases it does nothing.
OK, thanks, I've got that.
> >> How is this related to `Fprefix_load_file_names`?
> > Not closely. I think I should have propsed two separate patches, rather
> > than the big one I did. Fprefix_load_file_names is what puts the "While
> > loading foo.el... " in front of an error message.
> Splitting it into two would be good yes.
OK, I think I agree, even if I would rather not have to advocate for the
second patch again. ;-)
> AFAICT, the `Fprefix_load_file_names` is the part that aims to address
> bug#66912. IMO the other belongs in another bug-report/feature-request?
OK, I've separated out the bit that applies "While loading foo.el... "
from all the stuff about handler-bind. The patch below should, on its
own, fix bug#66912.
What's not there yet is being able to get into the debugger when a byte
compilation is requiring a file, and debug-on-error has been set. That
will be the subject of the next bug report.
Here's the amended patch. It's a lot shorter (and easier) than the
previous version. I would like to commit it as the fix to bug#66912.
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index f058fc48cc7..776083468c6 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -1436,8 +1436,9 @@ byte-compile-report-error
when printing the error message."
(setq byte-compiler-error-flag t)
(byte-compile-log-warning
- (if (stringp error-info) error-info
- (error-message-string error-info))
+ (prefix-load-file-names
+ (if (stringp error-info) error-info
+ (error-message-string error-info)))
fill :error))
;;; sanity-checking arglists
diff --git a/lisp/emacs-lisp/debug.el b/lisp/emacs-lisp/debug.el
index ec947c1215d..4068daf6614 100644
--- a/lisp/emacs-lisp/debug.el
+++ b/lisp/emacs-lisp/debug.el
@@ -418,7 +418,9 @@ debugger--insert-header
;; Debugger entered for an error.
('error
(insert "--Lisp error: ")
- (insert (backtrace-print-to-string (nth 1 args)))
+ (insert
+ (prefix-load-file-names
+ (backtrace-print-to-string (nth 1 args))))
(insert ?\n))
;; debug-on-call, when the next thing is an eval.
('t
@@ -426,8 +428,10 @@ debugger--insert-header
;; User calls debug directly.
(_
(insert ": ")
- (insert (backtrace-print-to-string (if (eq (car args) 'nil)
- (cdr args) args)))
+ (insert
+ (prefix-load-file-names
+ (backtrace-print-to-string (if (eq (car args) 'nil)
+ (cdr args) args))))
(insert ?\n))))
diff --git a/src/keyboard.c b/src/keyboard.c
index 6d28dca9aeb..6758c328038 100644
--- a/src/keyboard.c
+++ b/src/keyboard.c
@@ -1096,7 +1096,7 @@ DEFUN ("command-error-default-function", Fcommand_error_default_function,
Fdiscard_input ();
bitch_at_user ();
}
-
+ context = Fprefix_load_file_names (context);
print_error_message (data, Qt, SSDATA (context), signal);
}
return Qnil;
diff --git a/src/lread.c b/src/lread.c
index ea0398196e3..f81efb3df70 100644
--- a/src/lread.c
+++ b/src/lread.c
@@ -236,6 +236,9 @@ #define USE_ANDROID_ASSETS
check for recursive loads. */
static Lisp_Object Vloads_in_progress;
+/* The same as the above, except it survives the unbinding done in the
+ event of an error, and can thus be used in error handling. */
+Lisp_Object Vloads_still_in_progress;
static int read_emacs_mule_char (int, int (*) (int, Lisp_Object),
Lisp_Object);
@@ -1271,6 +1274,29 @@ close_file_unwind_android_fd (void *ptr)
#endif
+DEFUN ("prefix-load-file-names", Fprefix_load_file_names,
+ Sprefix_load_file_names, 1, 1, 0,
+ doc: /* Prefix the string BASE_STRING with a message about each
+file currently being loaded. Return the resulting string and reset this
+information to null. */)
+ (Lisp_Object base_string)
+{
+ Lisp_Object result = build_string ("");
+ Lisp_Object while_loading = build_string ("While loading ");
+ Lisp_Object ellipsis = build_string ("... ");
+
+ while (!NILP (Vloads_still_in_progress))
+ {
+ result = concat2 (concat3 (while_loading,
+ Fcar (Vloads_still_in_progress),
+ ellipsis),
+ result);
+ Vloads_still_in_progress = Fcdr (Vloads_still_in_progress);
+ }
+ result = concat3 (result, build_string ("\n"), base_string);
+ return result;
+}
+
DEFUN ("load", Fload, Sload, 1, 5, 0,
doc: /* Execute a file of Lisp code named FILE.
First try FILE with `.elc' appended, then try with `.el', then try
@@ -1516,6 +1542,7 @@ DEFUN ("load", Fload, Sload, 1, 5, 0,
signal_error ("Recursive load", Fcons (found, Vloads_in_progress));
record_unwind_protect (record_load_unwind, Vloads_in_progress);
Vloads_in_progress = Fcons (found, Vloads_in_progress);
+ Vloads_still_in_progress = Vloads_in_progress;
}
/* All loads are by default dynamic, unless the file itself specifies
@@ -1615,7 +1642,9 @@ DEFUN ("load", Fload, Sload, 1, 5, 0,
val = call4 (Vload_source_file_function, found, hist_file_name,
NILP (noerror) ? Qnil : Qt,
(NILP (nomessage) || force_load_messages) ? Qnil : Qt);
- return unbind_to (count, val);
+ unbind_to (count, Qnil);
+ Vloads_still_in_progress = Vloads_in_progress;
+ return val;
}
}
@@ -1741,6 +1770,8 @@ DEFUN ("load", Fload, Sload, 1, 5, 0,
if (!NILP (Ffboundp (Qdo_after_load_evaluation)))
call1 (Qdo_after_load_evaluation, hist_file_name) ;
+ Vloads_still_in_progress = Vloads_in_progress;
+
for (int i = 0; i < ARRAYELTS (saved_strings); i++)
{
xfree (saved_strings[i].string);
@@ -5772,6 +5803,7 @@ init_lread (void)
Vload_true_file_name = Qnil;
Vstandard_input = Qt;
Vloads_in_progress = Qnil;
+ Vloads_still_in_progress = Qnil;
}
/* Print a warning that directory intended for use USE and with name
@@ -5819,6 +5851,7 @@ syms_of_lread (void)
defsubr (&Sintern_soft);
defsubr (&Sunintern);
defsubr (&Sget_load_suffixes);
+ defsubr (&Sprefix_load_file_names);
defsubr (&Sload);
defsubr (&Seval_buffer);
defsubr (&Seval_region);
@@ -6138,6 +6171,8 @@ syms_of_lread (void)
Vloads_in_progress = Qnil;
staticpro (&Vloads_in_progress);
+ Vloads_still_in_progress = Qnil;
+ staticpro (&Vloads_still_in_progress);
DEFSYM (Qhash_table, "hash-table");
DEFSYM (Qdata, "data");
> Stefan
--
Alan Mackenzie (Nuremberg, Germany).
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.