Mercurial > hg > xemacs-beta

comparison lisp/code-files.el @ 5916:1152e0091f8c

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Avoid confusion about ELC vs. source file encoding, #'load, #'load-internal. lisp/ChangeLog addition: 2015-06-03 Aidan Kehoe <kehoea@parhasard.net> * code-files.el (load): Revise this to respect load-ignore-out-of-date-elc-files, rather than leaving that to #'load-internal. Avoids a corner case where the source and the compiled file have different, incompatible encodings. Move the call to #'substitute-in-file-name here. No longer check for a zero-length filename, since #'load-internal no longer chokes on same and errors correctly. src/ChangeLog addition: 2015-06-03 Aidan Kehoe <kehoea@parhasard.net> * lread.c (Fload_internal): Delegate calling the handler and #'substitute-in-file-name to #'load. Error correctly with a zero-length file name, instead of giving a bus error on my machine. Delegate the check for out-of-date ELC files to #'load, avoiding a bug where the encoding of the ELC file and the source file differed. * lread.c (PRINT_LOADING_MESSAGE_1): This is simplified, now we no longer have to talk about out-of-date ELC files. tests/ChangeLog addition: 2015-06-03 Aidan Kehoe <kehoea@parhasard.net> * automated/file-tests.el: Gross sanity check for #'load and #'load-internal with a zero-length FILE, something that crashed until today.
author Aidan Kehoe <kehoea@parhasard.net>
date Wed, 03 Jun 2015 20:13:07 +0100
parents 308d34e9f07d
children
comparison
equal deleted inserted replaced
5915:1af53d35dd53 5916:1152e0091f8c
246 optional third arg NOMESSAGE is non-nil. 246 optional third arg NOMESSAGE is non-nil.
247 If optional fourth arg NOSUFFIX is non-nil, don't try adding suffixes 247 If optional fourth arg NOSUFFIX is non-nil, don't try adding suffixes
248 .elc, .el, or elements of `module-extensions' to the specified name FILE. 248 .elc, .el, or elements of `module-extensions' to the specified name FILE.
249 Return t if file exists." 249 Return t if file exists."
250 (declare (special load-modules-quietly)) 250 (declare (special load-modules-quietly))
251 (let ((handler (find-file-name-handler filename 'load)) 251 (let (handler path elc old (spaces ""))
252 (path nil)) 252 (cond
253 (if handler 253 ;; Maybe there's a handler.
254 (funcall handler 'load filename noerror nomessage nosuffix) 254 ((setq handler (find-file-name-handler filename 'load))
255 ;; First try to load a Lisp file 255 (funcall handler 'load filename noerror nomessage nosuffix))
256 (if (and (> (length filename) 0) 256 ;; Nope, no handler. Try to load a Lisp file.
257 (setq path (locate-file filename load-path 257 ((setq path
258 (and (not nosuffix) 258 (locate-file (setq filename (substitute-in-file-name filename))
259 '(".elc" ".el" ""))))) 259 load-path (and (not nosuffix) '(".elc" ".el" ""))))
260 ;; now use the internal load to actually load the file. 260 (setq elc
261 (load-internal 261 (not (mismatch
262 filename noerror nomessage nosuffix 262 ".elc" path :test (and (file-system-ignore-case-p path)
263 (let ((elc ; use string= instead of string-match to keep match-data. 263 #'equalp)
264 (equalp ".elc" (substring path -4)))) 264 :start2 (max 0 (- (length path) (length ".elc"))))))
265 (or (and (not elc) coding-system-for-read) ;prefer for source file 265 ;; Maybe the .elc is out of date with regard to the .el file. If so we
266 ;; find magic-cookie 266 ;; may need to prefer the .el file, or just to warn.
267 (let ((codesys 267 (when (and elc (or load-ignore-out-of-date-elc-files
268 (find-coding-system-magic-cookie-in-file path))) 268 load-warn-when-source-newer)
269 (when codesys 269 (file-newer-than-file-p (subseq path 0 -1) path))
270 (setq codesys (intern codesys)) 270 (setq old (if load-show-full-path-in-messages
271 (if (find-coding-system codesys) codesys))) 271 path
272 (if elc 272 (file-name-nondirectory path))
273 ;; if reading a byte-compiled file and we didn't find 273 nomessage (or nomessage t))
274 ;; a coding-system magic cookie, then use `binary'. 274 ;; Considered binding this within this function, but decided
275 ;; We need to guarantee that we never do autodetection 275 ;; against it, since it's most used for debugging, and
276 ;; on byte-compiled files because confusion here would 276 ;; encountering an out-of-date-ELC file should happen rarely
277 ;; be a very bad thing. Pre-existing byte-compiled 277 ;; enough that the infelicity of the double-loading message is
278 ;; files are always in the `binary' coding system. 278 ;; outweighed by the improvement in debugging:
279 ;; Also, byte-compiled files always use `lf' to terminate 279 ;load-always-display-messages nil)
280 ;; a line; don't risk confusion here either. 280 (if (and noninteractive load-in-progress)
281 'binary 281 (setq spaces " "))
282 (or (find-file-coding-system-for-read-from-filename path) 282 (when load-ignore-out-of-date-elc-files
283 ;; looking up in `file-coding-system-alist'. 283 (setq filename
284 ;; otherwise use `buffer-file-coding-system-for-read', 284 (if (not (mismatch ".elc" filename
285 ;; as normal 285 :start2 (max 0 (- (length filename)
286 buffer-file-coding-system-for-read) 286 (length ".elc")))))
287 )))) 287 (subseq filename 0 -1)
288 ;; The file name is invalid, or we want to load a binary module 288 (concat filename ".elc"))
289 (if (and (> (length filename) 0) 289 path (locate-file filename load-path)))
290 (locate-file filename module-load-path 290 (message "%s%s %s... (file %s is out-of-date)" spaces
291 (and (not nosuffix) module-extensions))) 291 (if (eq nomessage 'require) "Requiring" "Loading")
292 (if (featurep 'modules) 292 (if load-show-full-path-in-messages path filename) old))
293 (let ((load-modules-quietly nomessage)) 293 ;; Now use #'load-internal to actually load the file.
294 (declare-fboundp (load-module filename))) 294 (prog1
295 (signal 'file-error '("This XEmacs does not support modules"))) 295 (load-internal
296 (and (null noerror) 296 filename noerror nomessage nosuffix
297 (signal 'file-error (list "Cannot open load file" filename)))) 297 (or (and (not elc) coding-system-for-read) ;; Prefer for source
298 )))) 298 ;; find magic-cookie
299 (let ((codesys
300 (find-coding-system-magic-cookie-in-file path)))
301 (when codesys
302 (setq codesys (intern codesys))
303 (if (find-coding-system codesys) codesys)))
304 (if elc
305 ;; If reading a byte-compiled file and we didn't find a
306 ;; coding-system magic cookie, then use `binary'. We need
307 ;; to guarantee that we never do autodetection on
308 ;; byte-compiled files because confusion here would be a
309 ;; very bad thing. Pre-existing byte-compiled files are
310 ;; always in the `binary' coding system. Also,
311 ;; byte-compiled files always use `lf' to terminate a
312 ;; line; don't risk confusion here either.
313 'binary
314 (or (find-file-coding-system-for-read-from-filename path)
315 ;; looking up in `file-coding-system-alist'. otherwise
316 ;; use `buffer-file-coding-system-for-read', as normal
317 buffer-file-coding-system-for-read))))
318 (and old
319 (message "%s%s %s... done (file %s is out-of-date)" spaces
320 (if (eq nomessage 'require) "Requiring" "Loading")
321 (if load-show-full-path-in-messages path filename)
322 old))))
323 ;; Maybe there's a module.
324 ((locate-file filename module-load-path
325 (and (not nosuffix) module-extensions))
326 (let ((load-modules-quietly nomessage))
327 ;; This will just error if we don't have module support, no need to
328 ;; error specially ourselves.
329 (declare-fboundp (load-module filename))))
330 ;; Maybe we can't find the file.
331 (t (and (not noerror)
332 (signal 'file-error (list "Cannot open load file" filename)))))))
299 333
300 (defvar insert-file-contents-access-hook nil 334 (defvar insert-file-contents-access-hook nil
301 "A hook to make a file accessible before reading it. 335 "A hook to make a file accessible before reading it.
302 `insert-file-contents' calls this hook before doing anything else. 336 `insert-file-contents' calls this hook before doing anything else.
303 Called with two arguments: FILENAME and VISIT, the same as the 337 Called with two arguments: FILENAME and VISIT, the same as the