bug#5845: load-library vs. list-load-path-shadows

[Noam Postavsky <npostavs@users.sourceforge.net>]

[-- Attachment #1: Type: text/plain, Size: 1054 bytes --]

Should we just use case-insensitive compare for `windows-nt' systems?
The idea of using "the same heuristics" as `load' sounds nice, but as
far as I can tell, `load' just queries the file system directly. Doing
the same in `load-path-shadow-find' is far too slow (raises execution
time from 0.38s to 5.64s, and that's without any packages adding to
the load-path).

--- i/lisp/emacs-lisp/shadow.el
+++ w/lisp/emacs-lisp/shadow.el
@@ -123,7 +123,9 @@ load-path-shadows-find
         ;; XXX.elc (or vice-versa) when they are in the same directory.
         (setq files-seen-this-dir (cons file files-seen-this-dir))

-        (if (setq orig-dir (assoc file files))
+        (if (setq orig-dir (assoc file files
+                                      (if (memq system-type
'(windows-nt ms-dos))
+                      (lambda (f1 f2) (eq (compare-strings f1 nil nil
f2 nil nil t) t)))))
         ;; This file was seen before, we have a shadowing.
         ;; Report it unless the files are identical.
         (let ((base1 (concat (cdr orig-dir) "/" file))

[-- Attachment #2: naive-shadow-list.el --]
[-- Type: application/octet-stream, Size: 6651 bytes --]

;;; -*- lexical-binding: t -*-

(require 'shadow)

(when nil
  (naive-load-path-shadows-find)
  '("c:/Users/npostavs/src/emacs/bug-5845-load-path-case-shadow/AUTHORS"
   "c:/emacs-24.5/share/emacs/24.5/lisp/emacs-lisp/AUTHORS.elc")

  (load-path-shadows-find)
  nil
  (load-path-shadows-find-v2)
  '("c:/Users/npostavs/src/emacs/emacs-26/admin/AUTHORS"
   "c:/Users/npostavs/src/emacs/bug-5845-load-path-case-shadow/AUTHORS")
  
  (benchmark 1 '(load-path-shadows-find-v2))
  "Elapsed time: 0.381508s (0.028689s in 1 GCs)"

  (benchmark 1 '(naive-load-path-shadows-find))
  "Elapsed time: 5.637040s (0.825316s in 29 GCs)"

  (benchmark 1 '(load-path-shadows-find))
  "Elapsed time: 0.122000s (0.016000s in 2 GCs)")

(defun load-path-shadows-find-v2 (&optional path)
  "Return a list of Emacs Lisp files that create shadows.
This function does the work for `list-load-path-shadows'.

We traverse PATH looking for shadows, and return a \(possibly empty)
even-length list of files.  A file in this list at position 2i shadows
the file in position 2i+1.  Emacs Lisp file suffixes \(.el and .elc)
are stripped from the file names in the list.

See the documentation for `list-load-path-shadows' for further information."
  (let (true-names			; List of dirs considered.
	shadows				; List of shadowings, to be returned.
	files				; File names ever seen, with dirs.
	dir				; The dir being currently scanned.
	curr-files			; This dir's Emacs Lisp files.
	orig-dir			; Where the file was first seen.
	files-seen-this-dir		; Files seen so far in this dir.
	)				; The current file.
    (dolist (pp (or path load-path))
      (setq dir (directory-file-name (file-truename (or pp "."))))
      (if (member dir true-names)
	  ;; We have already considered this PATH redundant directory.
	  ;; Show the redundancy if we are interactive, unless the PATH
	  ;; dir is nil or "." (these redundant directories are just a
	  ;; result of the current working directory, and are therefore
	  ;; not always redundant).
	  (or noninteractive
	      (and pp
		   (not (string= pp "."))
		   (message "Ignoring redundant directory %s" pp)))

	(setq true-names (append true-names (list dir)))
	(setq dir (directory-file-name (or pp ".")))
	(setq curr-files (if (file-accessible-directory-p dir)
			     (directory-files dir nil ".\\.elc?\\(\\.gz\\)?$" t)))
	(and curr-files
	     (not noninteractive)
	     (message "Checking %d files in %s..." (length curr-files) dir))

	(setq files-seen-this-dir nil)

	(dolist (file curr-files)

	  (if (string-match "\\.gz$" file)
	      (setq file (substring file 0 -3)))
	  (setq file (substring
		      file 0 (if (string= (substring file -1) "c") -4 -3)))

	  ;; FILE now contains the current file name, with no suffix.
	  (unless (or (member file files-seen-this-dir)
		      ;; Ignore these files.
		      (member file (list "subdirs" "leim-list"
					 (file-name-sans-extension
					  dir-locals-file))))
	    ;; File has not been seen yet in this directory.
	    ;; This test prevents us declaring that XXX.el shadows
	    ;; XXX.elc (or vice-versa) when they are in the same directory.
	    (setq files-seen-this-dir (cons file files-seen-this-dir))

	    (if (setq orig-dir (assoc file files
				      (if (memq system-type '(windows-nt ms-dos))
					  (lambda (f1 f2) (eq (compare-strings f1 nil nil f2 nil nil t) t)))))
						   
		;; This file was seen before, we have a shadowing.
		;; Report it unless the files are identical.
		(let ((base1 (concat (cdr orig-dir) "/" file))
		      (base2 (concat dir "/" file)))
		  (if (not (and load-path-shadows-compare-text
				(load-path-shadows-same-file-or-nonexistent
				 (concat base1 ".el") (concat base2 ".el"))
				;; This is a bit strict, but safe.
				(load-path-shadows-same-file-or-nonexistent
				 (concat base1 ".elc") (concat base2 ".elc"))))
		      (setq shadows
			    (append shadows (list base1 base2)))))

	      ;; Not seen before, add it to the list of seen files.
	      (setq files (cons (cons file dir) files)))))))
    ;; Return the list of shadowings.
    shadows))

(defun naive-load-path-shadows-find (&optional path)
  "Return a list of Emacs Lisp files that create shadows.
This function does the work for `list-load-path-shadows'.

We traverse PATH looking for shadows, and return a \(possibly empty\)
even-length list of files.  A file in this list at position 2i shadows
the file in position 2i+1.  Emacs Lisp file suffixes \(.el and .elc\)
are stripped from the file names in the list.

See the documentation for `list-load-path-shadows' for further information."
  (let ((true-names nil)
        (path (or path load-path))
        (shadows nil))
    (while (cdr path)
      (let* ((pp (pop path))
             (dir (directory-file-name (file-truename (or pp "."))))
             curr-files)
        (if (member dir true-names)
            ;; We have already considered this PATH redundant directory.
            ;; Show the redundancy if we are interactive, unless the PATH
            ;; dir is nil or "." (these redundant directories are just a
            ;; result of the current working directory, and are therefore
            ;; not always redundant).
            (or noninteractive
                (and pp
                     (not (string= pp "."))
                     (message "Ignoring redundant directory %s" pp)))

          (setq true-names (append true-names (list dir)))
          (setq dir (directory-file-name (or pp ".")))
          (setq curr-files (if (file-accessible-directory-p dir)
                               (directory-files dir nil ".\\.elc?\\(\\.gz\\)?$" t)))
          (and curr-files
               (not noninteractive)
               (message "Checking %d files in %s..." (length curr-files) dir))

          (dolist (file curr-files)

            (if (string-match "\\.gz$" file)
                (setq file (substring file 0 -3)))
            (setq file (substring
                        file 0 (if (string= (substring file -1) "c") -4 -3)))

            ;; FILE now contains the current file name, with no suffix.
            (unless
                ;; Ignore these files.
                (member file (list "subdirs" "leim-list"
                                   (file-name-sans-extension
                                    dir-locals-file)))
              (let ((shadowed (locate-library file nil path)))
                (when shadowed
                  (setq shadows (append shadows (list (concat pp "/" file) shadowed))))))))))
    shadows))