]> git.eshelyaron.com Git - emacs.git/commitdiff
Fix calling file name handler for `load'.
authorMichael Albinus <michael.albinus@gmx.de>
Fri, 4 Nov 2022 14:39:58 +0000 (15:39 +0100)
committerMichael Albinus <michael.albinus@gmx.de>
Fri, 4 Nov 2022 14:39:58 +0000 (15:39 +0100)
* 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.

lisp/net/ange-ftp.el
lisp/net/tramp.el
src/lread.c
test/lisp/net/tramp-tests.el

index 6ffa65a2dde5415c837526861f21d1e090ffb468..d6d0fb9a259f15cb2ae4b13d50bced5c1a112310 100644 (file)
@@ -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)
index 9552e51c48deb5d9cdca40dd5166504500ba183c..b08bc63e8a2972e1a536737660e9af47f77e06b2 100644 (file)
@@ -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))
index dfa4d9afb51c2e89e8a88280e0b011ebe9b9bc1c..957bc6895ef668a89b361b0115b69ca7dd521438 100644 (file)
@@ -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
index 2db44494388df67b2410fed7f37c0e66448cba7d..46fef558bf2fdc3b296247696d1db436010b0b2f 100644 (file)
@@ -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)))