[Emacs-diffs] master 0443411: Properly integrate modules into the loading process (Bug#30164).

[Philipp Stephani]

branch: master
commit 0443411f5ce2594a6ec092cd96b92d0b920372f5
Author: Philipp Stephani <address@hidden>
Commit: Philipp Stephani <address@hidden>

    Properly integrate modules into the loading process (Bug#30164).
    
    * src/lread.c (Fload): Don't defer to module-load immediately when
    encountering a module, but use the normal loading machinery to
    properly set up load-history, check for recursive loads, print
    messages, etc.
    
    * test/src/emacs-module-tests.el (module/load-history): New test.
    (module/describe-function-1): Adapt test.
    
    * etc/NEWS: Mention fixed behavior.
---
 etc/NEWS                       |  4 +++
 src/lread.c                    | 82 ++++++++++++++++++++++++++++++------------
 test/src/emacs-module-tests.el | 19 +++++++---
 3 files changed, 77 insertions(+), 28 deletions(-)

diff --git a/etc/NEWS b/etc/NEWS
index b28f284..afd0fba 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -275,6 +275,10 @@ file name extensions.
 ** The new function 'read-answer' accepts either long or short answers
 depending on the new customizable variable 'read-answer-short'.
 
+** The function 'load' now behaves correctly when loading modules.
+Specifically, it puts the module name into 'load-history', prints
+loading messages if requested, and protects against recursive loads.
+
 
 * Changes in Emacs 27.1 on Non-Free Operating Systems
 
diff --git a/src/lread.c b/src/lread.c
index 3b0a17c..1221dc9 100644
--- a/src/lread.c
+++ b/src/lread.c
@@ -164,6 +164,8 @@ static int read_emacs_mule_char (int, int (*) (int, 
Lisp_Object),
 static void readevalloop (Lisp_Object, struct infile *, Lisp_Object, bool,
                           Lisp_Object, Lisp_Object,
                           Lisp_Object, Lisp_Object);
+
+static void build_load_history (Lisp_Object, bool);
 
 /* Functions that read one byte from the current source READCHARFUN
    or unreads one byte.  If the integer argument C is -1, it returns
@@ -1246,8 +1248,9 @@ Return t if the file exists and loads successfully.  */)
     }
 
 #ifdef HAVE_MODULES
-  if (suffix_p (found, MODULES_SUFFIX))
-    return unbind_to (count, Fmodule_load (found));
+  bool is_module = suffix_p (found, MODULES_SUFFIX);
+#else
+  bool is_module = false;
 #endif
 
   /* Check if we're stuck in a recursive load cycle.
@@ -1348,7 +1351,7 @@ Return t if the file exists and loads successfully.  */)
             } /* !load_prefer_newer */
        }
     }
-  else
+  else if (!is_module)
     {
       /* We are loading a source file (*.el).  */
       if (!NILP (Vload_source_file_function))
@@ -1375,7 +1378,7 @@ Return t if the file exists and loads successfully.  */)
       stream = NULL;
       errno = EINVAL;
     }
-  else
+  else if (!is_module)
     {
 #ifdef WINDOWSNT
       emacs_close (fd);
@@ -1386,9 +1389,23 @@ Return t if the file exists and loads successfully.  */)
       stream = fdopen (fd, fmode);
 #endif
     }
-  if (! stream)
-    report_file_error ("Opening stdio stream", file);
-  set_unwind_protect_ptr (fd_index, close_infile_unwind, stream);
+
+  if (is_module)
+    {
+      /* `module-load' uses the file name, so we can close the stream
+         now.  */
+      if (fd >= 0)
+        {
+          emacs_close (fd);
+          clear_unwind_protect (fd_index);
+        }
+    }
+  else
+    {
+      if (! stream)
+        report_file_error ("Opening stdio stream", file);
+      set_unwind_protect_ptr (fd_index, close_infile_unwind, stream);
+    }
 
   if (! NILP (Vpurify_flag))
     Vpreloaded_file_list = Fcons (Fpurecopy (file), Vpreloaded_file_list);
@@ -1398,6 +1415,8 @@ Return t if the file exists and loads successfully.  */)
       if (!safe_p)
        message_with_string ("Loading %s (compiled; note unsafe, not compiled 
in Emacs)...",
                 file, 1);
+      else if (is_module)
+        message_with_string ("Loading %s (module)...", file, 1);
       else if (!compiled)
        message_with_string ("Loading %s (source)...", file, 1);
       else if (newer)
@@ -1411,24 +1430,39 @@ Return t if the file exists and loads successfully.  */)
   specbind (Qinhibit_file_name_operation, Qnil);
   specbind (Qload_in_progress, Qt);
 
-  struct infile input;
-  input.stream = stream;
-  input.lookahead = 0;
-  infile = &input;
-
-  if (lisp_file_lexically_bound_p (Qget_file_char))
-    Fset (Qlexical_binding, Qt);
-
-  if (! version || version >= 22)
-    readevalloop (Qget_file_char, &input, hist_file_name,
-                 0, Qnil, Qnil, Qnil, Qnil);
+  if (is_module)
+    {
+#ifdef HAVE_MODULES
+      specbind (Qcurrent_load_list, Qnil);
+      LOADHIST_ATTACH (found);
+      Fmodule_load (found);
+      build_load_history (found, true);
+#else
+      /* This cannot happen.  */
+      emacs_abort ();
+#endif
+    }
   else
     {
-      /* We can't handle a file which was compiled with
-        byte-compile-dynamic by older version of Emacs.  */
-      specbind (Qload_force_doc_strings, Qt);
-      readevalloop (Qget_emacs_mule_file_char, &input, hist_file_name,
-                   0, Qnil, Qnil, Qnil, Qnil);
+      struct infile input;
+      input.stream = stream;
+      input.lookahead = 0;
+      infile = &input;
+
+      if (lisp_file_lexically_bound_p (Qget_file_char))
+        Fset (Qlexical_binding, Qt);
+
+      if (! version || version >= 22)
+        readevalloop (Qget_file_char, &input, hist_file_name,
+                      0, Qnil, Qnil, Qnil, Qnil);
+      else
+        {
+          /* We can't handle a file which was compiled with
+             byte-compile-dynamic by older version of Emacs.  */
+          specbind (Qload_force_doc_strings, Qt);
+          readevalloop (Qget_emacs_mule_file_char, &input, hist_file_name,
+                        0, Qnil, Qnil, Qnil, Qnil);
+        }
     }
   unbind_to (count, Qnil);
 
@@ -1449,6 +1483,8 @@ Return t if the file exists and loads successfully.  */)
       if (!safe_p)
        message_with_string ("Loading %s (compiled; note unsafe, not compiled 
in Emacs)...done",
                 file, 1);
+      else if (is_module)
+        message_with_string ("Loading %s (module)...done", file, 1);
       else if (!compiled)
        message_with_string ("Loading %s (source)...done", file, 1);
       else if (newer)
diff --git a/test/src/emacs-module-tests.el b/test/src/emacs-module-tests.el
index 052f5c2..4751638 100644
--- a/test/src/emacs-module-tests.el
+++ b/test/src/emacs-module-tests.el
@@ -17,6 +17,7 @@
 ;; You should have received a copy of the GNU General Public License
 ;; along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.  */
 
+(require 'cl-lib)
 (require 'ert)
 (require 'help-fns)
 
@@ -267,13 +268,21 @@ during garbage collection."
   (with-temp-buffer
     (let ((standard-output (current-buffer)))
       (describe-function-1 #'mod-test-sum)
-      (should (equal (buffer-substring-no-properties 1 (point-max))
-                     ;; FIXME: This should print the actual module
-                     ;; filename.
-                     "a module function in `src/emacs-module-tests.el'.
+      (should (equal
+               (buffer-substring-no-properties 1 (point-max))
+               (format "a module function in `data/emacs-module/mod-test%s'.
 
 (mod-test-sum a b)
 
-Return A + B")))))
+Return A + B"
+                       module-file-suffix))))))
+
+(ert-deftest module/load-history ()
+  "Check that Bug#30164 is fixed."
+  (load mod-test-file)
+  (cl-destructuring-bind (file &rest entries) (car load-history)
+    (should (equal (file-name-sans-extension file) mod-test-file))
+    (should (member '(provide . mod-test) entries))
+    (should (member '(defun . mod-test-sum) entries))))
 
 ;;; emacs-module-tests.el ends here