1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2026-01-04 11:00:45 -08:00

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.
This commit is contained in:
Michael Albinus 2022-11-04 15:39:58 +01:00
parent f0f960050b
commit 5d6e919a90
4 changed files with 14 additions and 15 deletions

View 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)

View 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))
(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)))
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))

View 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

View 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)))