Avoid bogus abbreviated file names if HOME changes

* lisp/files.el (abbreviate-file-name):
If HOME changes, ignore `abbreviated-home-dir'.  (Bug#19657#20)
* test/lisp/files-tests.el (files-test-abbreviated-home-dir): New.

diff --git a/lisp/files.el b/lisp/files.el
index 96d7ae7cf167e7592e3d5a1e7756fed2464c2a6a..d8b38a9f169bdd28da9e6c93d70544982bbbb3fe 100644 (file)
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -1859,9 +1859,9 @@ home directory is a root directory) and removes automounter prefixes
 
 When this function is first called, it caches the user's home
 directory as a regexp in `abbreviated-home-dir', and reuses it
-afterwards.  Lisp programs that temporarily set the home directory
-to a different value should let-bind `abbreviated-home-dir' for
-the modified home directory to take effect."
+afterwards (so long as the home directory does not change;
+if you want to permanently change your home directory after having
+started Emacs, set `abbreviated-home-dir' to nil so it will be recalculated)."
   ;; Get rid of the prefixes added by the automounter.
   (save-match-data
     (if (and automount-dir-prefix
@@ -1883,29 +1883,37 @@ the modified home directory to take effect."
       ;; give time for directory-abbrev-alist to be set properly.
       ;; We include a slash at the end, to avoid spurious matches
       ;; such as `/usr/foobar' when the home dir is `/usr/foo'.
-      (or abbreviated-home-dir
-         (setq abbreviated-home-dir
-               (let ((abbreviated-home-dir "$foo"))
-                  (setq abbreviated-home-dir
-                        (concat "\\`"
-                                (abbreviate-file-name (expand-file-name "~"))
-                                "\\(/\\|\\'\\)"))
-                  ;; Depending on whether default-directory does or
-                  ;; doesn't include non-ASCII characters, the value
-                  ;; of abbreviated-home-dir could be multibyte or
-                  ;; unibyte.  In the latter case, we need to decode
-                  ;; it.  Note that this function is called for the
-                  ;; first time (from startup.el) when
-                  ;; locale-coding-system is already set up.
-                  (if (multibyte-string-p abbreviated-home-dir)
-                      abbreviated-home-dir
-                    (decode-coding-string abbreviated-home-dir
-                                          (if (eq system-type 'windows-nt)
-                                              'utf-8
-                                            locale-coding-system))))))
+      (unless abbreviated-home-dir
+        (put 'abbreviated-home-dir 'home (expand-file-name "~"))
+        (setq abbreviated-home-dir
+              (let ((abbreviated-home-dir "$foo"))
+                (setq abbreviated-home-dir
+                      (concat "\\`"
+                              (abbreviate-file-name
+                               (get 'abbreviated-home-dir 'home))
+                              "\\(/\\|\\'\\)"))
+                ;; Depending on whether default-directory does or
+                ;; doesn't include non-ASCII characters, the value
+                ;; of abbreviated-home-dir could be multibyte or
+                ;; unibyte.  In the latter case, we need to decode
+                ;; it.  Note that this function is called for the
+                ;; first time (from startup.el) when
+                ;; locale-coding-system is already set up.
+                (if (multibyte-string-p abbreviated-home-dir)
+                    abbreviated-home-dir
+                  (decode-coding-string abbreviated-home-dir
+                                        (if (eq system-type 'windows-nt)
+                                            'utf-8
+                                          locale-coding-system))))))
 
       ;; If FILENAME starts with the abbreviated homedir,
+      ;; and ~ hasn't changed since abbreviated-home-dir was set,
       ;; make it start with `~' instead.
+      ;; If ~ has changed, we ignore abbreviated-home-dir rather than
+      ;; invalidating it, on the assumption that a change in HOME
+      ;; is likely temporary (eg for testing).
+      ;; FIXME Is it even worth caching abbreviated-home-dir?
+      ;; Ref: https://debbugs.gnu.org/19657#20
       (if (and (string-match abbreviated-home-dir filename)
               ;; If the home dir is just /, don't change it.
               (not (and (= (match-end 0) 1)
@@ -1914,7 +1922,9 @@ the modified home directory to take effect."
               ;; Novell Netware allows drive letters beyond `Z:'.
               (not (and (memq system-type '(ms-dos windows-nt cygwin))
                         (save-match-data
-                          (string-match "^[a-zA-`]:/$" filename)))))
+                          (string-match "^[a-zA-`]:/$" filename))))
+               (equal (get 'abbreviated-home-dir 'home)
+                      (expand-file-name "~")))
          (setq filename
                (concat "~"
                        (match-string 1 filename)

diff --git a/test/lisp/files-tests.el b/test/lisp/files-tests.el
index 285a884b6958b4491a6258451495fa92e38e9f34..732b3c023791350b00e0d70fc7c2d1bd4a037c93 100644 (file)
--- a/test/lisp/files-tests.el
+++ b/test/lisp/files-tests.el
@@ -411,5 +411,19 @@ name (Bug#28412)."
     (should (file-directory-p (concat (file-name-as-directory dest2) "a")))
     (delete-directory dir 'recursive)))
 
+(ert-deftest files-test-abbreviated-home-dir ()
+  "Test that changing HOME does not confuse `abbreviate-file-name'.
+See <https://debbugs.gnu.org/19657#20>."
+  (let* ((homedir temporary-file-directory)
+         (process-environment (cons (format "HOME=%s" homedir)
+                                    process-environment))
+         (abbreviated-home-dir nil)
+         (testfile (expand-file-name "foo" homedir))
+         (old (file-truename (abbreviate-file-name testfile)))
+         (process-environment (cons (format "HOME=%s"
+                                            (expand-file-name "bar" homedir))
+                                    process-environment)))
+    (should (equal old (file-truename (abbreviate-file-name testfile))))))
+
 (provide 'files-tests)
 ;;; files-tests.el ends here