Resolve symlinks before running git diff

git diff does not like symlink arguments.

Fixes #3740

Signed-off-by: Rudi Grinberg <[email protected]>

CHANGES.md

@@ -15,6 +15,8 @@ Unreleased
 - Fix `dune-package` installation when META templates are present (#3743, fixes
   #3746, @rgrinberg)
 
+- Resolve symlinks before running `$ git diff` (#3750, fixes #3740, @rgrinberg)
+
 2.7.0 (13/08/2020)
 ------------------
 

src/dune_engine/print_diff.ml

@@ -2,6 +2,11 @@ open! Stdune
 open Import
 open Fiber.O
 
+let resolve_link path file =
+  match Path.realpath path with
+  | None -> file
+  | Some p -> Path.to_absolute_filename p
+
 let print ?(skip_trailing_cr = Sys.win32) path1 path2 =
   let dir, file1, file2 =
     match
@@ -22,16 +27,19 @@ let print ?(skip_trailing_cr = Sys.win32) path1 path2 =
       ]
   in
   let normal_diff () =
-    let path, args, skip_trailing_cr_arg =
+    let path, args, skip_trailing_cr_arg, files =
       let which prog = Bin.which ~path:(Env.path Env.initial) prog in
       match which "git" with
       | Some path ->
         ( path
         , [ "diff"; "--no-index"; "--color=always"; "-u" ]
-        , "--ignore-cr-at-eol" )
+        , "--ignore-cr-at-eol"
+        , List.map
+            ~f:(fun (path, file) -> resolve_link path file)
+            [ (path1, file1); (path2, file2) ] )
       | None -> (
         match which "diff" with
-        | Some path -> (path, [ "-u" ], "--strip-trailing-cr")
+        | Some path -> (path, [ "-u" ], "--strip-trailing-cr", [ file1; file2 ])
         | None -> fallback () )
     in
     let args =
@@ -40,7 +48,7 @@ let print ?(skip_trailing_cr = Sys.win32) path1 path2 =
       else
         args
     in
-    let args = args @ [ file1; file2 ] in
+    let args = args @ files in
     Format.eprintf "%a@?" Loc.render (Loc.pp loc);
     let* () = Process.run ~dir ~env:Env.initial Strict path args in
     fallback ()

src/stdune/path.ml

@@ -1335,3 +1335,16 @@ let chmod ~mode ?(stats = None) ?(op = `Set) path =
         stats.st_perm land lnot mode
   in
   Unix.chmod (to_string path) mode
+
+let realpath t =
+  let path_s = to_absolute_filename t in
+  let stat = Unix.lstat path_s in
+  match stat.st_kind with
+  | S_LNK ->
+    Some
+      (let link = Unix.readlink path_s in
+       if Filename.is_relative link then
+         relative (parent_exn t) link
+       else
+         external_ (External.of_string link))
+  | _ -> None

src/stdune/path.mli

@@ -384,3 +384,6 @@ val chmod :
   -> ?op:[ `Add | `Remove | `Set ]
   -> t
   -> unit
+
+(** Emulated [realpath]. Returns [None] if the path isn't a symlink *)
+val realpath : t -> t option