Package: emacs;
Message #113 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, Eli Zaretskii <eliz <at> gnu.org>, 66912 <at> debbugs.gnu.org Subject: Re: Bug#66912: With `require', the byte compiler reports the wrong file for errors. Date: Thu, 7 Nov 2024 15:04:32 +0000
Hello again, Stefan.
On Wed, Nov 06, 2024 at 18:14:18 -0500, Stefan Monnier wrote:
[ .... ]
> > At the moment, I think my currently working solution is the best way
> > to go.
> [ As you can guess, I disagree, mostly because I think the problems of
> my suggested approach are "familiar", since the behavior can be
> compared to things like the match-data, so we know how to live with
> its shortcomings, whereas I can't think of something else we already
> have which follows an approach like yours, so we're in new territory
> and it's harder to see what the problems could be and what workarounds
> to use. ]
> Then you'd be better get cracking at the documentation of "survives
> unbinding" 🙂
DONE.
Here is, perhaps, the final version of my patch, containing the revised
doc comment for Vloads_still_in_progress, and for
Fprefix_loads_in_progress.
Maybe, just maybe, I can commit this 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..5d615233f15 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;
@@ -1109,6 +1109,11 @@ DEFUN ("command-error-default-function", Fcommand_error_default_function,
This level has the catches for exiting/returning to editor command loop.
It returns nil to exit recursive edit, t to abort it. */
+static void restore_Vloads_still_in_progress (Lisp_Object arg)
+{
+ Vloads_still_in_progress = arg;
+}
+
Lisp_Object
command_loop (void)
{
@@ -1137,6 +1142,10 @@ command_loop (void)
else
while (1)
{
+ specpdl_ref ccount = SPECPDL_INDEX ();
+
+ record_unwind_protect (restore_Vloads_still_in_progress,
+ Vloads_still_in_progress);
internal_catch (Qtop_level, top_level_1, Qnil);
internal_catch (Qtop_level, command_loop_2, Qerror);
executing_kbd_macro = Qnil;
@@ -1144,6 +1153,7 @@ command_loop (void)
/* End of file in -batch run causes exit here. */
if (noninteractive)
Fkill_emacs (Qt, Qnil);
+ unbind_to (ccount, Qnil);
}
}
diff --git a/src/lisp.h b/src/lisp.h
index 5ef97047f76..e7eecba96f6 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -4794,6 +4794,7 @@ #define FLOAT_TO_STRING_BUFSIZE 350
ATTRIBUTE_FORMAT_PRINTF (5, 0);
/* Defined in lread.c. */
+extern Lisp_Object Vloads_still_in_progress;
extern Lisp_Object intern_1 (const char *, ptrdiff_t);
extern Lisp_Object intern_c_string_1 (const char *, ptrdiff_t);
extern Lisp_Object intern_driver (Lisp_Object, Lisp_Object, Lisp_Object);
diff --git a/src/lread.c b/src/lread.c
index ea0398196e3..234f3b1cd25 100644
--- a/src/lread.c
+++ b/src/lread.c
@@ -234,9 +234,17 @@ #define USE_ANDROID_ASSETS
/* A list of file names for files being loaded in Fload. Used to
check for recursive loads. */
-
static Lisp_Object Vloads_in_progress;
+/* The same as the above, but is bound only in the command loop, not in
+ Fload. It is set to the value of Floads_in_progress at the start and
+ end of Fload. In the event of an error being signaled and the
+ binding stack being unwound, this variable keeps its value. Its sole
+ use is to supplement error messages, giving the names of the stack of
+ files currently being loaded. See Fprefix_load_file_names in this
+ file. */
+Lisp_Object Vloads_still_in_progress;
+
static int read_emacs_mule_char (int, int (*) (int, Lisp_Object),
Lisp_Object);
@@ -1271,6 +1279,34 @@ 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 the
+internal variable holding this information to nil. */)
+ (Lisp_Object base_string)
+{
+ if (NILP (Vloads_still_in_progress))
+ return base_string;
+ else
+ {
+ 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 +1552,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 +1652,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 +1780,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 +5813,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 +5861,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 +6181,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.