Subject: Re: Bug#66912: With `require', the byte compiler reports the wrong file for errors.

From: Alan Mackenzie <[email-masked]>
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).