master 95b1eacd47: Fix handling of UNCs in 'parse-colon-path

[Eli Zaretskii]

branch: master
commit 95b1eacd4750da7329380aabcb383a8f9d96a59b
Author: Eli Zaretskii <eliz@gnu.org>
Commit: Eli Zaretskii <eliz@gnu.org>

    Fix handling of UNCs in 'parse-colon-path
    
    * lisp/files.el (parse-colon-path): Don't remove the second
    leading slash on systems that support UNCs.  (Bug#57353)
    
    * test/lisp/files-tests.el (files-tests-bug-21454): Update
    expected results.
    (files-colon-path): Add a new test pattern.
---
 lisp/files.el            | 15 ++++++++++-----
 test/lisp/files-tests.el | 10 +++++++---
 2 files changed, 17 insertions(+), 8 deletions(-)

diff --git a/lisp/files.el b/lisp/files.el
index 8596d9a839..740e09055b 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -851,15 +851,20 @@ resulting list of directory names.  For an empty path 
element (i.e.,
 a leading or trailing separator, or two adjacent separators), return
 nil (meaning `default-directory') as the associated list element."
   (when (stringp search-path)
-    (let ((spath (substitute-env-vars search-path)))
+    (let ((spath (substitute-env-vars search-path))
+          (double-slash-special-p
+           (memq system-type '(windows-nt cygwin ms-dos))))
       (mapcar (lambda (f)
                 (if (equal "" f) nil
                   (let ((dir (file-name-as-directory f)))
                     ;; Previous implementation used `substitute-in-file-name'
-                    ;; which collapse multiple "/" in front.  Do the same for
-                    ;; backward compatibility.
-                    (if (string-match "\\`/+" dir)
-                        (substring dir (1- (match-end 0))) dir))))
+                    ;; which collapses multiple "/" in front, while
+                    ;; preserving double slash where it matters.  Do
+                    ;; the same for backward compatibility.
+                    (if (string-match "\\`//+" dir)
+                        (substring dir (- (match-end 0)
+                                          (if double-slash-special-p 2 1)))
+                      dir))))
               (split-string spath path-separator)))))
 
 (defun cd-absolute (dir)
diff --git a/test/lisp/files-tests.el b/test/lisp/files-tests.el
index 54ada08800..20c712226e 100644
--- a/test/lisp/files-tests.el
+++ b/test/lisp/files-tests.el
@@ -221,8 +221,8 @@ form.")
                 ("x:/foo//bar/" "y:/bar/qux/" "z:/qux/foo/"))
                ("x:/foo/bar" "$FOO/baz/;z:/qux/foo/"
                 ("x:/foo/bar/baz/" "z:/qux/foo/"))
-               ("//foo/bar/" "$FOO/baz/;/qux/foo/"
-                ("/foo/bar//baz/" "/qux/foo/")))
+               ("///foo/bar/" "$FOO/baz/;/qux/foo/"
+                ("//foo/bar//baz/" "/qux/foo/")))
            '(("/foo/bar//baz/:/bar/foo/baz//" nil
               ("/foo/bar//baz/" "/bar/foo/baz//"))
              ("/foo/bar/:/bar/qux/:/qux/foo" nil
@@ -1504,7 +1504,11 @@ See <https://debbugs.gnu.org/36401>."
     (should (equal (parse-colon-path "/foo//bar/baz")
                    '("/foo//bar/baz/"))))
   (should (equal (parse-colon-path (concat "." path-separator "/tmp"))
-                 '("./" "/tmp/"))))
+                 '("./" "/tmp/")))
+  (should (equal (parse-colon-path (concat "/foo" path-separator "///bar"))
+                 (if (memq system-type '(windows-nt cygwin ms-dos))
+                     '("/foo/" "//bar/")
+                   '("/foo/" "/bar/")))))
 
 (ert-deftest files-test-magic-mode-alist-doctype ()
   "Test that DOCTYPE and variants put files in mhtml-mode."