Mercurial > hg > xemacs-beta

changeset 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 1af53d35dd53
children ffb5abc8dc4e
files lisp/ChangeLog lisp/code-files.el src/ChangeLog src/lread.c tests/ChangeLog tests/automated/file-tests.el
diffstat 6 files changed, 136 insertions(+), 122 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/ChangeLog	Fri May 29 17:06:24 2015 +0100
+++ b/lisp/ChangeLog	Wed Jun 03 20:13:07 2015 +0100
@@ -1,3 +1,14 @@
+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.
+
 2015-05-15  Aidan Kehoe  <kehoea@parhasard.net>
 
 	* simple.el:
--- a/lisp/code-files.el	Fri May 29 17:06:24 2015 +0100
+++ b/lisp/code-files.el	Wed Jun 03 20:13:07 2015 +0100
@@ -248,54 +248,88 @@
  .elc, .el, or elements of `module-extensions' to the specified name FILE.
 Return t if file exists."
   (declare (special load-modules-quietly))
-  (let ((handler (find-file-name-handler filename 'load))
-	(path nil))
-    (if handler
-	(funcall handler 'load filename noerror nomessage nosuffix)
-      ;; First try to load a Lisp file
-      (if (and (> (length filename) 0)
-	       (setq path (locate-file filename load-path
-				       (and (not nosuffix)
-					    '(".elc" ".el" "")))))
-	  ;; now use the internal load to actually load the file.
-	  (load-internal
-	   filename noerror nomessage nosuffix
-	   (let ((elc ; use string= instead of string-match to keep match-data.
-		  (equalp ".elc" (substring path -4))))
-	     (or (and (not elc) coding-system-for-read)	;prefer for source file
-		 ;; find magic-cookie
-		 (let ((codesys
-			(find-coding-system-magic-cookie-in-file path)))
-		   (when codesys
-		     (setq codesys (intern codesys))
-		     (if (find-coding-system codesys) codesys)))
-		 (if elc
-		     ;; if reading a byte-compiled file and we didn't find
-		     ;; a coding-system magic cookie, then use `binary'.
-		     ;; We need to guarantee that we never do autodetection
-		     ;; on byte-compiled files because confusion here would
-		     ;; be a very bad thing.  Pre-existing byte-compiled
-		     ;; files are always in the `binary' coding system.
-		     ;; Also, byte-compiled files always use `lf' to terminate
-		     ;; a line; don't risk confusion here either.
-		     'binary
-		   (or (find-file-coding-system-for-read-from-filename path)
-		       ;; looking up in `file-coding-system-alist'.
-		       ;; otherwise use `buffer-file-coding-system-for-read',
-		       ;; as normal
-		       buffer-file-coding-system-for-read)
-		   ))))
-	;; The file name is invalid, or we want to load a binary module
-	(if (and (> (length filename) 0)
-		 (locate-file filename module-load-path
-			      (and (not nosuffix) module-extensions)))
-	    (if (featurep 'modules)
-		(let ((load-modules-quietly nomessage))
-		  (declare-fboundp (load-module filename)))
-	      (signal 'file-error '("This XEmacs does not support modules")))
-	  (and (null noerror)
-	       (signal 'file-error (list "Cannot open load file" filename))))
-	))))
+  (let (handler path elc old (spaces ""))
+    (cond
+      ;; Maybe there's a handler.
+      ((setq handler (find-file-name-handler filename 'load))
+       (funcall handler 'load filename noerror nomessage nosuffix))
+      ;; Nope, no handler. Try to load a Lisp file.
+      ((setq path
+             (locate-file (setq filename (substitute-in-file-name filename))
+                          load-path (and (not nosuffix) '(".elc" ".el" ""))))
+       (setq elc
+             (not (mismatch
+                   ".elc" path :test (and (file-system-ignore-case-p path)
+                                          #'equalp)
+                   :start2 (max 0 (- (length path) (length ".elc"))))))
+       ;; Maybe the .elc is out of date with regard to the .el file. If so we
+       ;; may need to prefer the .el file, or just to warn.
+       (when (and elc (or load-ignore-out-of-date-elc-files
+                          load-warn-when-source-newer)
+                  (file-newer-than-file-p (subseq path 0 -1) path))
+         (setq old (if load-show-full-path-in-messages
+                       path
+                     (file-name-nondirectory path))
+               nomessage (or nomessage t))
+               ;; Considered binding this within this function, but decided
+               ;; against it, since it's most used for debugging, and
+               ;; encountering an out-of-date-ELC file should happen rarely
+               ;; enough that the infelicity of the double-loading message is
+               ;; outweighed by the improvement in debugging:
+               ;load-always-display-messages nil)
+         (if (and noninteractive load-in-progress)
+             (setq spaces "  "))
+         (when load-ignore-out-of-date-elc-files
+           (setq filename
+                 (if (not (mismatch ".elc" filename
+                                    :start2 (max 0 (- (length filename)
+                                                      (length ".elc")))))
+                     (subseq filename 0 -1)
+                   (concat filename ".elc"))
+                 path (locate-file filename load-path)))
+         (message "%s%s %s... (file %s is out-of-date)" spaces
+                  (if (eq nomessage 'require) "Requiring" "Loading")
+                  (if load-show-full-path-in-messages path filename) old))
+       ;; Now use #'load-internal to actually load the file.
+       (prog1
+           (load-internal
+            filename noerror nomessage nosuffix
+            (or (and (not elc) coding-system-for-read) ;; Prefer for source
+                ;; find magic-cookie
+                (let ((codesys
+                       (find-coding-system-magic-cookie-in-file path)))
+                  (when codesys
+                    (setq codesys (intern codesys))
+                    (if (find-coding-system codesys) codesys)))
+                (if elc
+                    ;; If reading a byte-compiled file and we didn't find a
+                    ;; coding-system magic cookie, then use `binary'.  We need
+                    ;; to guarantee that we never do autodetection on
+                    ;; byte-compiled files because confusion here would be a
+                    ;; very bad thing.  Pre-existing byte-compiled files are
+                    ;; always in the `binary' coding system.  Also,
+                    ;; byte-compiled files always use `lf' to terminate a
+                    ;; line; don't risk confusion here either.
+                    'binary
+                  (or (find-file-coding-system-for-read-from-filename path)
+                      ;; looking up in `file-coding-system-alist'.  otherwise
+                      ;; use `buffer-file-coding-system-for-read', as normal
+                      buffer-file-coding-system-for-read))))
+         (and old
+              (message "%s%s %s... done (file %s is out-of-date)" spaces
+                       (if (eq nomessage 'require) "Requiring" "Loading")
+                       (if load-show-full-path-in-messages path filename)
+                       old))))
+      ;; Maybe there's a module.
+      ((locate-file filename module-load-path
+                    (and (not nosuffix) module-extensions))
+       (let ((load-modules-quietly nomessage))
+         ;; This will just error if we don't have module support, no need to
+         ;; error specially ourselves.
+         (declare-fboundp (load-module filename))))
+      ;; Maybe we can't find the file.
+      (t (and (not noerror)
+              (signal 'file-error (list "Cannot open load file" filename)))))))
 
 (defvar insert-file-contents-access-hook nil
   "A hook to make a file accessible before reading it.
--- a/src/ChangeLog	Fri May 29 17:06:24 2015 +0100
+++ b/src/ChangeLog	Wed Jun 03 20:13:07 2015 +0100
@@ -1,3 +1,16 @@
+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.
+
 2015-05-15  Aidan Kehoe  <kehoea@parhasard.net>
 
 	* buffer.c:
--- a/src/lread.c	Fri May 29 17:06:24 2015 +0100
+++ b/src/lread.c	Wed Jun 03 20:13:07 2015 +0100
@@ -532,42 +532,26 @@
   int fd = -1;
   int speccount = specpdl_depth ();
   int source_only = 0;
-  /* NEWER and OLDER are filenames w/o directory, used in loading messages
-     to e.g. warn of newer .el files when the .elc is being loaded. */
+  /* NEWER is a filename without directory, used in loading messages when
+     load-ignore-elc-files is non-nil. */
   Lisp_Object newer   = Qnil;
-  Lisp_Object older   = Qnil;
-  Lisp_Object handler = Qnil;
   Lisp_Object found   = Qnil;
   Lisp_Object retval;
-  struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
+  struct gcpro gcpro1, gcpro2, gcpro3;
   int reading_elc = 0;
   int from_require = EQ (nomessage, Qrequire);
   int message_p = NILP (nomessage) || load_always_display_messages;
-  struct stat s1, s2;
   Ibyte *spaces = alloca_ibytes (load_in_progress * 2 + 10);
   int i;
   PROFILE_DECLARE ();
 
-  GCPRO4 (file, newer, older, found);
   CHECK_STRING (file);
+  CHECK_SYMBOL (used_codesys); /* Either nil or another symbol to write to. */
+
+  GCPRO3 (file, newer, found);
 
   PROFILE_RECORD_ENTERING_SECTION (Qload_internal);
 
-  /* If file name is magic, call the handler.  */
-  handler = Ffind_file_name_handler (file, Qload);
-  if (!NILP (handler))
-    {
-      retval = call5 (handler, Qload, file, noerror, nomessage, nosuffix);
-      goto done;
-    }
-
-  /* Do this after the handler to avoid
-     the need to gcpro noerror, nomessage and nosuffix.
-     (Below here, we care only whether they are nil or not.)  */
-  file = Fsubstitute_in_file_name (file);
-  if (!NILP (used_codesys))
-    CHECK_SYMBOL (used_codesys);
-
   if (noninteractive)
     {
       for (i = 0; i < load_in_progress * 2; i++)
@@ -580,7 +564,17 @@
   /* Avoid weird lossage with null string as arg,
      since it would try to load a directory as a Lisp file.
      Unix truly sucks. */
-  if (XSTRING_LENGTH (file) > 0)
+  if (XSTRING_LENGTH (file) == 0)
+    {
+      if (NILP (noerror))
+        signal_error (Qfile_error, "Cannot open load file", file);
+      else
+        {
+          retval = Qnil;
+          goto done;
+        }
+    }
+  else
     {
       Ibyte *foundstr;
       int foundlen;
@@ -611,44 +605,6 @@
 	 differ. --ben */
       if (load_ignore_elc_files)
 	newer = Ffile_name_nondirectory (found);
-      else if ((load_warn_when_source_newer ||
-		load_ignore_out_of_date_elc_files) &&
-	       !memcmp (".elc", foundstr + foundlen - 4, 4))
-	{
-	  if (! qxe_fstat (fd, &s1))	/* can't fail, right? */
-	    {
-	      int result;
-	      /* temporarily hack the 'c' off the end of the filename */
-	      foundstr[foundlen - 1] = '\0';
-	      result = qxe_stat (foundstr, &s2);
-	      if (result >= 0 &&
-		  (unsigned) s1.st_mtime < (unsigned) s2.st_mtime)
-		{
-		  /* .elc exists and is out-of-date wrt .el */
-		  Lisp_Object el_name = make_string (foundstr, foundlen - 1);
-		  struct gcpro nngcpro1;
-		  NNGCPRO1 (el_name);
-		  newer = Ffile_name_nondirectory (el_name);
-		  if (load_ignore_out_of_date_elc_files)
-		    {
-		      int newfd =
-			locate_file_open_or_access_file
-			(XSTRING_DATA (el_name), -1);
-
-		      if (newfd >= 0)
-			{
-			  older = Ffile_name_nondirectory (found);
-			  found = el_name;
-			  retry_close (fd);
-			  fd = newfd;
-			}
-		    }
-		  NNUNGCPRO;
-		}
-	      /* put the 'c' back on (kludge-o-rama) */
-	      foundstr[foundlen - 1] = 'c';
-	    }
-	}
       else if (load_warn_when_source_only &&
 	       /* `found' ends in ".el" */
 	       !memcmp (".el", foundstr + foundlen - 3, 3) &&
@@ -671,19 +627,6 @@
 		 XSTRING_DATA (load_show_full_path_in_messages ?	\
 			       found : newer));				\
     }									\
-  else if (!NILP (older))						\
-    {									\
-      assert (load_ignore_out_of_date_elc_files);			\
-      message (loading done " (file %s is out-of-date)", spaces,	\
-	       XSTRING_DATA (load_show_full_path_in_messages ?		\
-			     found : newer),				\
-	       XSTRING_DATA (older));					\
-    }									\
-  else if (!NILP (newer))						\
-    message (loading done " (file %s is newer)", spaces,		\
-	     XSTRING_DATA (load_show_full_path_in_messages ?		\
-			   found : file),				\
-	     XSTRING_DATA (newer));					\
   else if (source_only)							\
     message (loading done " (file %s.elc does not exist)", spaces,	\
 	     XSTRING_DATA (load_show_full_path_in_messages ?		\
--- a/tests/ChangeLog	Fri May 29 17:06:24 2015 +0100
+++ b/tests/ChangeLog	Wed Jun 03 20:13:07 2015 +0100
@@ -1,3 +1,9 @@
+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.
+
 2015-05-29  Aidan Kehoe  <kehoea@parhasard.net>
 
 	* automated/lisp-tests.el:
--- a/tests/automated/file-tests.el	Fri May 29 17:06:24 2015 +0100
+++ b/tests/automated/file-tests.el	Wed Jun 03 20:13:07 2015 +0100
@@ -40,4 +40,11 @@
   do
   (Assert (equal (file-truename (file-truename file)) (file-truename file))))
 
+;;
+;; Gross sanity check with #'load and a zero-length filename:
+(Check-Error file-error (load ""))
+(Assert (eq nil (load "" t)))
+(Check-Error file-error (load-internal ""))
+(Assert (eq nil (load-internal "" t)))
 
+;;; end of file-tests.el