From: Lars Ingebrigtsen <larsi@gnus.org>
Date: Thu, 26 Aug 2021 17:28:34 +0000 (+0200)
Subject: Fix problem with symlinks in compile buffers
X-Git-Tag: emacs-28.0.90~1297
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=ee2ffd9c9eb33a17307f36ff58caec1ba79878d2;p=emacs.git

Fix problem with symlinks in compile buffers

* lisp/progmodes/compile.el (compilation-find-file): Avoid
`expand-file-name' when computing the file names, because that will
reliably give the wrong result when there's symlinks and ".."
involved (bug#8035).
---

diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el
index 1fb6124ab56..af7b8292b74 100644
--- a/lisp/progmodes/compile.el
+++ b/lisp/progmodes/compile.el
@@ -2951,7 +2951,8 @@ attempts to find a file whose name is produced by (format FMT FILENAME)."
             fmts formats)
       ;; For each directory, try each format string.
       (while (and fmts (null buffer))
-        (setq name (expand-file-name (format (car fmts) filename) thisdir)
+        (setq name (file-truename
+                    (file-name-concat thisdir (format (car fmts) filename)))
               buffer (and (file-exists-p name)
                           (find-file-noselect name))
               fmts (cdr fmts)))
@@ -2973,7 +2974,8 @@ attempts to find a file whose name is produced by (format FMT FILENAME)."
         (setq thisdir (car dirs)
               fmts formats)
         (while (and fmts (null buffer))
-          (setq name (expand-file-name (format (car fmts) filename) thisdir)
+          (setq name (file-truename
+                      (file-name-concat thisdir (format (car fmts) filename)))
                 buffer (and (file-exists-p name)
                             (find-file-noselect name))
                 fmts (cdr fmts)))
@@ -3016,7 +3018,8 @@ attempts to find a file whose name is produced by (format FMT FILENAME)."
               (ding) (sit-for 2))
              ((and (file-directory-p name)
                    (not (file-exists-p
-                         (setq name (expand-file-name filename name)))))
+                         (setq name (file-truename
+                                     (file-name-concat name filename))))))
               (message "No `%s' in directory %s" filename origname)
               (ding) (sit-for 2))
              (t