Make (diff ...) work on Windows

- make (diff ...) trailing cr on Win32
- add a (cmp ...) action for comparing binary files
- add a test and run it in AppVeyor

Fix #844

Signed-off-by: Jeremie Dimino <jeremie@dimino.org>

CHANGES.md

@@ -86,7 +86,10 @@ next
 
 - Improve the syntax of flags in `(pps ...)`. Now instead of `(pps
   (ppx1 -arg1 ppx2 (-foo x)))` one should write `(pps ppx1 -arg ppx2
-  -- -foo x)` which looks nicer (#..., @diml)
+  -- -foo x)` which looks nicer (#910, @diml)
+
+- Make `(diff a b)` ignore trailing cr on Windows and add `(cmp a b)` for
+  comparing binary files (#904, fix #844, @diml)
 
 1.0+beta20 (10/04/2018)
 -----------------------

appveyor.yml

@@ -8,6 +8,8 @@ build_script:
   - cd "%APPVEYOR_BUILD_FOLDER%"
   - ocaml bootstrap.ml
   - boot.exe --dev
+  - copy _build\install\default\bin\dune.exe dune.exe
+  - dune.exe build @test\blackbox-tests\windows-diff
 
 artifacts:
   - path: _build/log

doc/jbuild.rst

@@ -1209,6 +1209,9 @@ The following constructions are available:
 - ``(diff? <file1> <file2>)`` is the same as ``(diff <file1>
   <file2>)`` except that it is ignored when ``<file1>`` or ``<file2>``
   doesn't exists
+- ``(cmp <file1> <file2>)`` is similar to ``(run cmp <file1>
+  <file2>)`` but allows promotion.  See `Diffing and promotion`_ for
+  more details
 
 As mentioned ``copy#`` inserts a line directive at the beginning of
 the destination file. More precisely, it inserts the following line:
@@ -1348,6 +1351,9 @@ However, it is different for the following reason:
 
      $ opam install patdiff
 
+- on Windows, both ``(diff a b)`` and ``(diff? a b)`` normalize the end of
+  lines before comparing the files
+
 - since ``(diff a b)`` is a builtin action, Jbuilder knowns that ``a``
   and ``b`` are needed and so you don't need to specify them
   explicitly as dependencies
@@ -1358,6 +1364,10 @@ However, it is different for the following reason:
 
 - it allows promotion. See below
 
+Note that ``(cmp a b)`` does no end of lines normalization and doesn't
+print a diff when the files differ. ``cmp`` is meant to be used with
+binary files.
+
 Promotion
 ~~~~~~~~~
 

src/action.ml

@@ -10,6 +10,8 @@ module Outputs = struct
     | Outputs -> "outputs"
 end
 
+module Diff_mode = Action_intf.Diff_mode
+
 module Make_ast
     (Program : Sexp.Sexpable)
     (Path    : Sexp.Sexpable)
@@ -86,12 +88,21 @@ struct
            Write_file (fn, s))
         ; "diff",
           (path >>= fun file1 ->
-           path >>| fun file2 ->
-           Diff { optional = false; file1; file2 })
+           path >>= fun file2 ->
+           Syntax.get_exn Stanza.syntax >>| fun ver ->
+           let mode = if ver < (1, 0) then Diff_mode.Text_jbuild else Text in
+           Diff { optional = false; file1; file2; mode })
         ; "diff?",
           (path >>= fun file1 ->
+           path >>= fun file2 ->
+           Syntax.get_exn Stanza.syntax >>| fun ver ->
+           let mode = if ver < (1, 0) then Diff_mode.Text_jbuild else Text in
+           Diff { optional = true; file1; file2; mode })
+        ; "cmp",
+          (Syntax.since Stanza.syntax (1, 0) >>= fun () ->
+           path >>= fun file1 ->
            path >>| fun file2 ->
-           Diff { optional = true; file1; file2 })
+           Diff { optional = false; file1; file2; mode = Binary })
         ])
 
   let rec sexp_of_t : _ -> Sexp.t =
@@ -133,9 +144,12 @@ struct
     | Mkdir x       -> List [Sexp.unsafe_atom_of_string "mkdir"; path x]
     | Digest_files paths -> List [Sexp.unsafe_atom_of_string "digest-files";
                                   List (List.map paths ~f:path)]
-    | Diff { optional = false; file1; file2 } ->
+    | Diff { optional; file1; file2; mode = Binary} ->
+      assert (not optional);
+      List [Sexp.unsafe_atom_of_string "cmp"; path file1; path file2]
+    | Diff { optional = false; file1; file2; mode = _ } ->
       List [Sexp.unsafe_atom_of_string "diff"; path file1; path file2]
-    | Diff { optional = true; file1; file2 } ->
+    | Diff { optional = true; file1; file2; mode = _ } ->
       List [Sexp.unsafe_atom_of_string "diff?"; path file1; path file2]
     | Merge_files_into (srcs, extras, target) ->
       List
@@ -167,7 +181,8 @@ struct
   let remove_tree path = Remove_tree path
   let mkdir path = Mkdir path
   let digest_files files = Digest_files files
-  let diff ?(optional=false) file1 file2 = Diff { optional; file1; file2 }
+  let diff ?(optional=false) ?(mode=Diff_mode.Text) file1 file2 =
+    Diff { optional; file1; file2; mode }
 end
 
 module Make_mapper
@@ -201,8 +216,12 @@ module Make_mapper
     | Remove_tree x -> Remove_tree (f_path ~dir x)
     | Mkdir x -> Mkdir (f_path ~dir x)
     | Digest_files x -> Digest_files (List.map x ~f:(f_path ~dir))
-    | Diff { optional; file1; file2 } ->
-      Diff { optional; file1 = f_path ~dir file1; file2 = f_path ~dir file2 }
+    | Diff { optional; file1; file2; mode } ->
+      Diff { optional
+           ; file1 = f_path ~dir file1
+           ; file2 = f_path ~dir file2
+           ; mode
+           }
     | Merge_files_into (sources, extras, target) ->
       Merge_files_into
         (List.map sources ~f:(f_path ~dir),
@@ -428,10 +447,11 @@ module Unexpanded = struct
         end
       | Digest_files x ->
         Digest_files (List.map x ~f:(E.path ~dir ~f))
-      | Diff { optional; file1; file2 } ->
+      | Diff { optional; file1; file2; mode } ->
         Diff { optional
              ; file1 = E.path ~dir ~f file1
              ; file2 = E.path ~dir ~f file2
+             ; mode
              }
       | Merge_files_into (sources, extras, target) ->
         Merge_files_into
@@ -519,10 +539,11 @@ module Unexpanded = struct
       Mkdir res
     | Digest_files x ->
       Digest_files (List.map x ~f:(E.path ~dir ~f))
-    | Diff { optional; file1; file2 } ->
+    | Diff { optional; file1; file2; mode } ->
       Diff { optional
            ; file1 = E.path ~dir ~f file1
            ; file2 = E.path ~dir ~f file2
+           ; mode
            }
     | Merge_files_into (sources, extras, target) ->
       Merge_files_into
@@ -826,9 +847,14 @@ let rec exec t ~ectx ~dir ~env ~stdout_to ~stderr_to =
         (Marshal.to_string data [])
     in
     exec_echo stdout_to s
-  | Diff { optional; file1; file2 } ->
+  | Diff { optional; file1; file2; mode } ->
+    let compare_files =
+      match mode with
+      | Text_jbuild | Binary -> Io.compare_files
+      | Text -> Io.compare_text_files
+    in
     if (optional && not (Path.exists file1 && Path.exists file2)) ||
-       Io.compare_files file1 file2 = Eq then
+       compare_files file1 file2 = Eq then
       Fiber.return ()
     else begin
       let is_copied_from_source_tree file =
@@ -843,7 +869,13 @@ let rec exec t ~ectx ~dir ~env ~stdout_to ~stderr_to =
           ; dst = Option.value_exn (Path.drop_build_context file1)
           }
       end;
-      Print_diff.print file1 file2
+      if mode = Binary then
+        die "@{<error>Error@}: Files %s and %s differ."
+          (Path.to_string_maybe_quoted file1)
+          (Path.to_string_maybe_quoted file2)
+      else
+        Print_diff.print file1 file2
+          ~skip_trailing_cr:(mode = Text && Sys.win32)
     end
   | Merge_files_into (sources, extras, target) ->
     let lines =
@@ -969,7 +1001,7 @@ module Infer = struct
       | Ignore (_, t) -> infer acc t
       | Progn l -> List.fold_left l ~init:acc ~f:infer
       | Digest_files l -> List.fold_left l ~init:acc ~f:(+<)
-      | Diff { optional; file1; file2 } ->
+      | Diff { optional; file1; file2; mode = _ } ->
         if optional then acc else acc +< file1 +< file2
       | Merge_files_into (sources, _extras, target) ->
         List.fold_left sources ~init:acc ~f:(+<) +@ target

src/action.mli

@@ -1,6 +1,7 @@
 open! Import
 
 module Outputs : module type of struct include Action_intf.Outputs end
+module Diff_mode : module type of struct include Action_intf.Diff_mode end
 
 (** result of the lookup of a program, the path to it or information about the
     failure and possibly a hint how to fix it *)

src/action_intf.ml

@@ -7,6 +7,13 @@ module Outputs = struct
     | Outputs (** Both Stdout and Stderr *)
 end
 
+module Diff_mode = struct
+  type t =
+    | Binary      (** no diffing, just raw comparison      *)
+    | Text        (** diffing after newline normalization  *)
+    | Text_jbuild (** diffing but no newline normalization *)
+end
+
 module type Ast = sig
   type program
   type path
@@ -17,6 +24,7 @@ module type Ast = sig
 
     type t =
       { optional : bool
+      ; mode     : Diff_mode.t
       ; file1    : path
       ; file2    : path
       }
@@ -73,5 +81,5 @@ module type Helpers = sig
   val remove_tree : path -> t
   val mkdir : path -> t
   val digest_files : path list -> t
-  val diff : ?optional:bool -> Path.t -> Path.t -> t
+  val diff : ?optional:bool -> ?mode:Diff_mode.t -> Path.t -> Path.t -> t
 end

src/print_diff.ml

@@ -2,7 +2,7 @@ open Import
 
 open Fiber.O
 
-let print path1 path2 =
+let print ?(skip_trailing_cr=Sys.win32) path1 path2 =
   let dir, file1, file2 =
     match
       Path.extract_build_context_dir path1,
@@ -24,7 +24,12 @@ let print path1 path2 =
     | None -> fallback ()
     | Some prog ->
       Format.eprintf "%a@?" Loc.print loc;
-      Process.run ~dir ~env:Env.initial Strict prog ["-u"; file1; file2]
+      Process.run ~dir ~env:Env.initial Strict prog
+        (List.concat
+           [ ["-u"]
+           ; if skip_trailing_cr then ["--strip-trailing-cr"] else []
+           ; [ file1; file2 ]
+           ])
       >>= fun () ->
       fallback ()
   in

src/print_diff.mli

@@ -1,4 +1,4 @@
 open Stdune
 
 (** Diff two files that are expected not to match. *)
-val print : Path.t -> Path.t -> _ Fiber.t
+val print : ?skip_trailing_cr:bool -> Path.t -> Path.t -> _ Fiber.t

src/stdune/io.ml

@@ -77,10 +77,52 @@ let copy_file ~src ~dst =
       ~f:(fun oc ->
         copy_channels ic oc))
 
-(* TODO: diml: improve this *)
-let compare_files fn1 fn2 = String.compare (read_file fn1) (read_file fn2)
-
-let buf_len = 65_536
+let compare_files fn1 fn2 =
+  let s1 = read_file fn1 in
+  let s2 = read_file fn2 in
+  String.compare s1 s2
+
+let read_file_and_normalize_eols fn =
+  if not Sys.win32 then
+    read_file fn
+  else begin
+    let src = read_file fn in
+    let len = String.length src in
+    let dst = Bytes.create len in
+    let rec find_next_crnl i =
+      match String.index_from src i '\r' with
+      | exception Not_found -> None
+      | j ->
+        if j + 1 < len && src.[j + 1] = '\n' then
+          Some j
+        else
+          find_next_crnl (j + 1)
+    in
+    let rec loop src_pos dst_pos =
+      match find_next_crnl src_pos with
+      | None ->
+        let len =
+          if len > src_pos && src.[len - 1] = '\r' then
+            len - 1 - src_pos
+          else
+            len - src_pos
+        in
+        Bytes.blit_string src src_pos dst dst_pos len;
+        Bytes.sub_string dst 0 (dst_pos + len)
+      | Some i ->
+        let len = i - src_pos in
+        Bytes.blit_string src src_pos dst dst_pos len;
+        let dst_pos = dst_pos + len in
+        Bytes.set dst dst_pos '\n';
+        loop (i + 2) (dst_pos + 1)
+    in
+    loop 0 0
+  end
+
+let compare_text_files fn1 fn2 =
+  let s1 = read_file_and_normalize_eols fn1 in
+  let s2 = read_file_and_normalize_eols fn2 in
+  String.compare s1 s2
 
 module Sexp = struct
   let load ?lexer path ~mode =

src/stdune/io.mli

@@ -17,6 +17,7 @@ val read_file : ?binary:bool -> Path.t -> string
 val write_file : ?binary:bool -> Path.t -> string -> unit
 
 val compare_files : Path.t -> Path.t -> Ordering.t
+val compare_text_files : Path.t -> Path.t -> Ordering.t
 
 val write_lines : Path.t -> string list -> unit
 
@@ -29,7 +30,3 @@ val read_all : in_channel -> string
 module Sexp : sig
   val load : ?lexer:Usexp.Lexer.t -> Path.t -> mode:'a Sexp.Parser.Mode.t -> 'a
 end
-
-(**/**)
-(* used in jbuild_load *)
-val buf_len : int

test/blackbox-tests/dune.inc

@@ -556,6 +556,14 @@
     test-cases/utop
     (progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))))
 
+(alias
+ ((name windows-diff)
+  (deps ((package dune) (source_tree test-cases/windows-diff)))
+  (action
+   (chdir
+    test-cases/windows-diff
+    (progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))))
+
 (alias
  ((name runtest)
   (deps
@@ -622,7 +630,8 @@
     (alias select)
     (alias syntax-versioning)
     (alias use-meta)
-    (alias utop)))))
+    (alias utop)
+    (alias windows-diff)))))
 
 (alias
  ((name runtest-no-deps)
@@ -681,7 +690,8 @@
     (alias scope-ppx-bug)
     (alias select)
     (alias syntax-versioning)
-    (alias use-meta)))))
+    (alias use-meta)
+    (alias windows-diff)))))
 
 (alias ((name runtest-disabled) (deps ((alias reason)))))
 

test/blackbox-tests/test-cases/windows-diff/dune

@@ -0,0 +1,14 @@
+(executables ((names (hello hexdump))))
+
+(rule (with-stdout-to hello.output (run ./hello.exe)))
+
+(alias
+ ((name   runtest)
+  (action (diff hello.expected hello.output))))
+
+(rule (with-stdout-to a (echo "toto\n")))
+(rule (with-stdout-to b (echo "toto\r\n")))
+
+(alias
+ ((name   cmp)
+  (action (cmp a b))))

test/blackbox-tests/test-cases/windows-diff/dune-project

@@ -0,0 +1 @@
+(lang dune 1.0)

test/blackbox-tests/test-cases/windows-diff/hello.expected

@@ -0,0 +1 @@
+Hello, world!

test/blackbox-tests/test-cases/windows-diff/hello.ml

@@ -0,0 +1 @@
+let () = print_endline "Hello, world!"

test/blackbox-tests/test-cases/windows-diff/hello.wrong-output

@@ -0,0 +1 @@
+blah