From 76040d1eae4464b468481231c15e7fb86f4b11d8 Mon Sep 17 00:00:00 2001 From: Noam Postavsky Date: Tue, 16 Jan 2018 16:26:56 -0500 Subject: [PATCH] Handle case-insensitive filenames for load-path shadows (Bug#5845) * lisp/emacs-lisp/shadow.el (load-path-shadows-find): Check for shadowing with case-insensitive matching for files of case-insensitive directories (as determined by `file-name-case-insensitive-p'). * test/lisp/emacs-lisp/shadow-tests.el: New test. * test/lisp/emacs-lisp/shadow-resources/p1/foo.el: * test/lisp/emacs-lisp/shadow-resources/p2/FOO.el: New test files. --- lisp/emacs-lisp/shadow.el | 10 ++++- test/lisp/emacs-lisp/shadow-resources/p1/foo.el | 1 + test/lisp/emacs-lisp/shadow-resources/p2/FOO.el | 1 + test/lisp/emacs-lisp/shadow-tests.el | 49 +++++++++++++++++++++++++ 4 files changed, 59 insertions(+), 2 deletions(-) create mode 100644 test/lisp/emacs-lisp/shadow-resources/p1/foo.el create mode 100644 test/lisp/emacs-lisp/shadow-resources/p2/FOO.el create mode 100644 test/lisp/emacs-lisp/shadow-tests.el diff --git a/lisp/emacs-lisp/shadow.el b/lisp/emacs-lisp/shadow.el index 88a494fdd40..1788f0d71f7 100644 --- a/lisp/emacs-lisp/shadow.el +++ b/lisp/emacs-lisp/shadow.el @@ -78,6 +78,7 @@ See the documentation for `list-load-path-shadows' for further information." shadows ; List of shadowings, to be returned. files ; File names ever seen, with dirs. dir ; The dir being currently scanned. + dir-case-insensitive ; `file-name-case-insentive-p' for dir. 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. @@ -104,6 +105,9 @@ See the documentation for `list-load-path-shadows' for further information." (message "Checking %d files in %s..." (length curr-files) dir)) (setq files-seen-this-dir nil) + ;; We assume that case sensitivity of a directory applies to + ;; its files. + (setq dir-case-insensitive (file-name-case-insensitive-p dir)) (dolist (file curr-files) @@ -123,10 +127,12 @@ See the documentation for `list-load-path-shadows' for further information." ;; 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 + (when dir-case-insensitive + (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)) + (let ((base1 (concat (cdr orig-dir) "/" (car orig-dir))) (base2 (concat dir "/" file))) (if (not (and load-path-shadows-compare-text (load-path-shadows-same-file-or-nonexistent diff --git a/test/lisp/emacs-lisp/shadow-resources/p1/foo.el b/test/lisp/emacs-lisp/shadow-resources/p1/foo.el new file mode 100644 index 00000000000..465038bee5e --- /dev/null +++ b/test/lisp/emacs-lisp/shadow-resources/p1/foo.el @@ -0,0 +1 @@ +;;; This file intentionally left blank. diff --git a/test/lisp/emacs-lisp/shadow-resources/p2/FOO.el b/test/lisp/emacs-lisp/shadow-resources/p2/FOO.el new file mode 100644 index 00000000000..465038bee5e --- /dev/null +++ b/test/lisp/emacs-lisp/shadow-resources/p2/FOO.el @@ -0,0 +1 @@ +;;; This file intentionally left blank. diff --git a/test/lisp/emacs-lisp/shadow-tests.el b/test/lisp/emacs-lisp/shadow-tests.el new file mode 100644 index 00000000000..9d4969fe8bb --- /dev/null +++ b/test/lisp/emacs-lisp/shadow-tests.el @@ -0,0 +1,49 @@ +;;; shadow-tests.el --- Test suite for shadow. -*- lexical-binding: t -*- + +;; Copyright (C) 2018 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Code: + +(require 'ert) +(require 'shadow) +(eval-when-compile (require 'cl-lib)) + +(defconst shadow-tests-data-directory + (expand-file-name "lisp/emacs-lisp/shadow-resources" + (or (getenv "EMACS_TEST_DIRECTORY") + (expand-file-name "../../.." + (or load-file-name + buffer-file-name)))) + "Directory for shadow test files.") + +(ert-deftest shadow-case-insensitive () + "Test shadowing for case insensitive filenames." + ;; Override `file-name-case-insentive-p' so we test the same thing + ;; regardless of what file system we're running on. + (cl-letf (((symbol-function 'file-name-case-insensitive-p) (lambda (_f) t))) + (should (equal (list (expand-file-name "p1/foo" shadow-tests-data-directory) + (expand-file-name "p2/FOO" shadow-tests-data-directory)) + (load-path-shadows-find + (list (expand-file-name "p1/" shadow-tests-data-directory) + (expand-file-name "p2/" shadow-tests-data-directory)))))) + (cl-letf (((symbol-function 'file-name-case-insensitive-p) (lambda (_f) nil))) + (should-not (load-path-shadows-find + (list (expand-file-name "p1/" shadow-tests-data-directory) + (expand-file-name "p2/" shadow-tests-data-directory)))))) + +;;; shadow-tests.el ends here. -- 2.11.4.GIT