From: Michael Albinus <michael.albinus@gmx.de>
Date: Fri, 4 Nov 2022 14:39:58 +0000 (+0100)
Subject: Fix calling file name handler for `load'.
X-Git-Tag: emacs-29.0.90~1616^2~309
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=5d6e919a90bc3ad3c73f9c6b20b25837d283af0e;p=emacs.git

Fix calling file name handler for `load'.

* lisp/net/ange-ftp.el (ange-ftp-load): Add MUST-SUFFIX argument.

* lisp/net/tramp.el (tramp-handle-load): Adapt MUST_SUFFIX test.

* src/lread.c (Fload): Call handler with must_suffix.

* test/lisp/net/tramp-tests.el (tramp-test27-load): Extend test.
---

diff --git a/lisp/net/ange-ftp.el b/lisp/net/ange-ftp.el
index 6ffa65a2dde..d6d0fb9a259 100644
--- a/lisp/net/ange-ftp.el
+++ b/lisp/net/ange-ftp.el
@@ -4242,7 +4242,7 @@ directory, so that Emacs will know its current contents."
 	  ((eq identification 'localname) localname)
 	  (t (ange-ftp-replace-name-component file ""))))))
 
-(defun ange-ftp-load (file &optional noerror nomessage nosuffix)
+(defun ange-ftp-load (file &optional noerror nomessage nosuffix must-suffix)
   (if (ange-ftp-ftp-name file)
       (let ((tryfiles (if nosuffix
 			  (list file)
@@ -4264,7 +4264,7 @@ directory, so that Emacs will know its current contents."
 	  (or noerror
 	      (signal 'file-error (list "Cannot open load file" file)))
 	  nil))
-    (ange-ftp-real-load file noerror nomessage nosuffix)))
+    (ange-ftp-real-load file noerror nomessage nosuffix must-suffix)))
 
 ;; Calculate default-unhandled-directory for a given ange-ftp buffer.
 (defun ange-ftp-unhandled-file-name-directory (_filename)
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index 9552e51c48d..b08bc63e8a2 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -4584,14 +4584,9 @@ Do not set it manually, it is used buffer-local in `tramp-get-lock-pid'.")
 	     (setq file (concat file ".elc")))
 	    ((file-exists-p (concat file ".el"))
 	     (setq file (concat file ".el")))))
-    (when must-suffix
-      ;; The first condition is always true for absolute file names.
-      ;; Included for safety's sake.
-      (unless (or (file-name-directory file)
-		  (string-match-p (rx ".el" (? "c") eos) file))
-	(tramp-error
-	 v 'file-error
-	 "File `%s' does not include a `.el' or `.elc' suffix" file)))
+    (when (and must-suffix (not (string-match-p (rx ".el" (? "c") eos) file)))
+      (tramp-error
+       v 'file-error "File `%s' does not include a `.el' or `.elc' suffix" file))
     (unless (or noerror (file-exists-p file))
       (tramp-error v 'file-missing file))
     (if (not (file-exists-p file))
diff --git a/src/lread.c b/src/lread.c
index dfa4d9afb51..957bc6895ef 100644
--- a/src/lread.c
+++ b/src/lread.c
@@ -1236,7 +1236,8 @@ Return t if the file exists and loads successfully.  */)
   /* If file name is magic, call the handler.  */
   handler = Ffind_file_name_handler (file, Qload);
   if (!NILP (handler))
-    return call5 (handler, Qload, file, noerror, nomessage, nosuffix);
+    return
+      call6 (handler, Qload, file, noerror, nomessage, nosuffix, must_suffix);
 
   /* The presence of this call is the result of a historical accident:
      it used to be in every file-operation and when it got removed
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el
index 2db44494388..46fef558bf2 100644
--- a/test/lisp/net/tramp-tests.el
+++ b/test/lisp/net/tramp-tests.el
@@ -4616,10 +4616,13 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
 	      (load tmp-name 'noerror 'nomessage))
 	    (should-not (featurep 'tramp-test-load))
 	    (write-region "(provide 'tramp-test-load)" nil tmp-name)
-	    ;; `load' in lread.c does not pass `must-suffix'.  Why?
-	    ;;(should-error
-	    ;; (load tmp-name nil 'nomessage 'nosuffix 'must-suffix)
-	    ;; :type 'file-error)
+	    ;; `load' in lread.c passes `must-suffix' since Emacs 29.
+	    ;; In Ange-FTP, `must-suffix' is ignored.
+	    (when (and (tramp--test-emacs29-p)
+                       (not (tramp--test-ange-ftp-p)))
+	      (should-error
+	       (load tmp-name nil 'nomessage 'nosuffix 'must-suffix)
+	       :type 'file-error))
 	    (load tmp-name nil 'nomessage 'nosuffix)
 	    (should (featurep 'tramp-test-load)))