Merge branch 'master' into migration-manual

CHANGES.md

@@ -84,6 +84,13 @@ next
 - Present the `menhir` stanza as an extension with its own version
   (#901, @diml)
 
+- 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 (#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

@@ -975,7 +975,7 @@ Jbuilder accepts three kinds of preprocessing:
 - ``no_preprocessing``, meaning that files are given as it to the compiler, this
   is the default
 - ``(action <action>)`` to preprocess files using the given action
-- ``(pps (<ppx-rewriters-and-flags>))`` to preprocess files using the given list
+- ``(pps <ppx-rewriters-and-flags>)`` to preprocess files using the given list
   of ppx rewriters
 
 Note that in any cases, files are preprocessed only once. Jbuilder doesn't use
@@ -1006,14 +1006,15 @@ The equivalent of a ``-pp <command>`` option passed to the OCaml compiler is
 Preprocessing with ppx rewriters
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 
-``<ppx-rewriters-and-flags>`` is expected to be a list where each element is
+``<ppx-rewriters-and-flags>`` is expected to be a sequence where each
-either a command line flag if starting with a ``-`` or the name of a library.
+element is either a command line flag if starting with a ``-`` or the
-Additionally, any sub-list will be treated as a list of command line arguments.
+name of a library.  If you want to pass command line flags that do not
-So for instance from the following ``preprocess`` field:
+start with a ``-``, you can separate library names from flags using
+``--``. So for instance from the following ``preprocess`` field:
 
    .. code:: scheme
 
-       (preprocess (pps (ppx1 -foo ppx2 (-bar 42))))
+       (preprocess (pps ppx1 -foo ppx2 -- -bar 42))
 
 The list of libraries will be ``ppx1`` and ``ppx2`` and the command line
 arguments will be: ``-foo -bar 42``.
@@ -1212,6 +1213,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:
@@ -1351,6 +1355,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
@@ -1361,6 +1368,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,29 @@ struct
            Write_file (fn, s))
         ; "diff",
           (path >>= fun file1 ->
-           path >>| fun file2 ->
+           path >>= fun file2 ->
-           Diff { optional = false; file1; file2 })
+           Stanza.file_kind () >>| fun kind ->
+           let mode =
+             match kind with
+             | Jbuild -> Diff_mode.Text_jbuild
+             | Dune   -> Text
+           in
+           Diff { optional = false; file1; file2; mode })
         ; "diff?",
           (path >>= fun file1 ->
+           path >>= fun file2 ->
+           Stanza.file_kind () >>| fun kind ->
+           let mode =
+             match kind with
+             | Jbuild -> Diff_mode.Text_jbuild
+             | Dune   -> 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 +152,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 +189,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 +224,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; file2; mode } ->
-      Diff { optional; file1 = f_path ~dir file1; file2 = f_path ~dir file2 }
+      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 +455,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 +547,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 +855,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 +877,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 +1009,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/jbuild.ml

@@ -181,29 +181,53 @@ end = struct
   let compare = String.compare
 end
 
-module Pp_or_flags = struct
+module Pps_and_flags = struct
-  type t =
+  module Jbuild_syntax = struct
-    | PP of Loc.t * Pp.t
+    let of_string ~loc s =
-    | Flags of string list
+      if String.is_prefix s ~prefix:"-" then
+        Right [s]
+      else
+        Left (loc, Pp.of_string s)
 
-  let of_string ~loc s =
+    let item =
-    if String.is_prefix s ~prefix:"-" then
+      peek raw >>= function
-      Flags [s]
+      | Atom _ | Quoted_string _ -> plain_string of_string
-    else
+      | List _ -> list string >>| fun l -> Right l
-      PP (loc, Pp.of_string s)
+
+    let split l =
+      let pps, flags =
+        List.partition_map l ~f:(fun x -> x)
+      in
+      (pps, List.concat flags)
+
+    let t = list item >>| split
+  end
+
+  module Dune_syntax = struct
+    let rec parse acc_pps acc_flags =
+      eos >>= function
+      | true ->
+        return (List.rev acc_pps, List.rev acc_flags)
+      | false ->
+        plain_string (fun ~loc s -> (loc, s)) >>= fun (loc, s) ->
+        match s with
+        | "--" ->
+          repeat string >>= fun flags ->
+          return (List.rev acc_pps, List.rev_append acc_flags flags)
+        | s when String.is_prefix s ~prefix:"-" ->
+          parse acc_pps (s :: acc_flags)
+        | _ ->
+          parse ((loc, Pp.of_string s) :: acc_pps) acc_flags
+
+    let t = parse [] []
+  end
 
   let t =
-    peek raw >>= function
+    Syntax.get_exn Stanza.syntax >>= fun ver ->
-    | Atom _ | Quoted_string _ -> plain_string of_string
+    if ver < (1, 0) then
-    | List _ -> list string >>| fun l -> Flags l
+      Jbuild_syntax.t
-
+    else
-  let split l =
+      Dune_syntax.t
-    let pps, flags =
-      List.partition_map l ~f:(function
-        | PP (loc, pp) -> Left (loc, pp)
-        | Flags s      -> Right s)
-    in
-    (pps, List.concat flags)
 end
 
 module Dep_conf = struct
@@ -277,8 +301,7 @@ module Preprocess = struct
          Action (loc, x))
       ; "pps",
         (loc >>= fun loc ->
-         list Pp_or_flags.t >>| fun l ->
+         Pps_and_flags.t >>| fun (pps, flags) ->
-         let pps, flags = Pp_or_flags.split l in
          Pps { loc; pps; flags })
       ]
 

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/stanza.ml

@@ -11,3 +11,12 @@ let syntax =
     [ (0, 0) (* Jbuild syntax *)
     ; (1, 0)
     ]
+
+module File_kind = struct
+  type t = Jbuild | Dune
+end
+
+let file_kind () =
+  let open Sexp.Of_sexp in
+  Syntax.get_exn syntax >>| fun ver ->
+  if ver < (1, 0) then File_kind.Jbuild else Dune

src/stanza.mli

@@ -16,3 +16,10 @@ end
     the Jbuild language while versions from [(1, 0)] correspond to the
     Dune one. *)
 val syntax : Syntax.t
+
+module File_kind : sig
+  type t = Jbuild | Dune
+end
+
+(** Whether we are parsing a [jbuild] or [dune] file. *)
+val file_kind : unit -> (File_kind.t, _) Sexp.Of_sexp.parser

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 =
-let compare_files fn1 fn2 = String.compare (read_file fn1) (read_file fn2)
+  let s1 = read_file fn1 in
+  let s2 = read_file fn2 in
+  String.compare s1 s2
 
-let buf_len = 65_536
+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/dune-ppx-driver-system/dune

@@ -3,21 +3,21 @@
  ((name foo1)
   (public_name foo.1)
   (modules (foo1))
-  (preprocess (pps ()))))
+  (preprocess (pps))))
 
 ; Too many drivers
 (library
  ((name foo2)
   (public_name foo.2)
   (modules (foo2))
-  (preprocess (pps (ppx1 ppx2)))))
+  (preprocess (pps ppx1 ppx2))))
 
 ; Incompatible with Dune
 (library
  ((name foo3)
   (public_name foo.3)
   (modules (foo3))
-  (preprocess (pps (ppx_other)))))
+  (preprocess (pps ppx_other))))
 
 (rule (with-stdout-to foo1.ml (echo "")))
 (rule (with-stdout-to foo2.ml (echo "")))
@@ -54,3 +54,15 @@
   (public_name foo.ppx-other)
   (modules ())
   (kind ppx_rewriter)))
+
+(library
+ ((name driver_print_args)
+  (modules ())
+  (ppx.driver ((main "(fun () -> Array.iter print_endline Sys.argv)")))))
+
+(rule (with-stdout-to test_ppx_args.ml (echo "")))
+
+(library
+ ((name test_ppx_args)
+  (modules (test_ppx_args))
+  (preprocess (pps -arg1 driver_print_args -arg2 -- -foo bar))))

test/blackbox-tests/test-cases/dune-ppx-driver-system/run.t

@@ -1,14 +1,14 @@
 No ppx driver found
 
   $ dune build foo1.cma
-  File "dune", line 6, characters 14-22:
+  File "dune", line 6, characters 14-19:
   Error: You must specify at least one ppx rewriter.
   [1]
 
 Too many drivers
 
   $ dune build foo2.cma
-  File "dune", line 13, characters 14-31:
+  File "dune", line 13, characters 14-29:
   Error: Too many incompatible ppx drivers were found: foo.driver2 and
   foo.driver1.
   [1]
@@ -16,7 +16,7 @@ Too many drivers
 Not compatible with Dune
 
   $ dune build foo3.cma
-  File "dune", line 20, characters 14-31:
+  File "dune", line 20, characters 14-29:
   Error: No ppx driver were found. It seems that ppx_other is not compatible
   with Dune. Examples of ppx rewriters that are compatible with Dune are ones
   using ocaml-migrate-parsetree, ppxlib or ppx_driver.
@@ -37,3 +37,22 @@ Same, but with error pointing to .ppx
   Examples of ppx rewriters that are compatible with Dune are ones using
   ocaml-migrate-parsetree, ppxlib or ppx_driver.
   [1]
+
+Test the argument syntax
+
+  $ dune build test_ppx_args.cma
+           ppx test_ppx_args.pp.ml
+  .ppx/driver_print_args@foo/ppx.exe
+  -arg1
+  -arg2
+  -foo
+  bar
+  --cookie
+  library-name="test_ppx_args"
+  -o
+  test_ppx_args.pp.ml
+  --impl
+  test_ppx_args.ml
+  Error: Rule failed to generate the following targets:
+  - test_ppx_args.pp.ml
+  [1]

test/blackbox-tests/test-cases/js_of_ocaml/bin/dune

@@ -4,5 +4,5 @@
   (js_of_ocaml (
     (flags (:standard))
     (javascript_files (runtime.js))))
-  (preprocess (pps (js_of_ocaml-ppx)))
+  (preprocess (pps js_of_ocaml-ppx))
   ))

test/blackbox-tests/test-cases/js_of_ocaml/lib/dune

@@ -4,5 +4,5 @@
   (js_of_ocaml ((flags (--pretty))
                 (javascript_files (runtime.js))))
   (c_names (stubs))
-  (preprocess (pps (js_of_ocaml-ppx)))
+  (preprocess (pps js_of_ocaml-ppx))
   ))

test/blackbox-tests/test-cases/merlin-tests/lib/dune

@@ -2,9 +2,9 @@
  ((name foo)
   (libraries (bytes unix findlib))
   (modules ())
-  (preprocess (pps (fooppx)))))
+  (preprocess (pps fooppx))))
 
 (library
  ((name bar)
   (modules ())
-  (preprocess (pps (fooppx)))))
+  (preprocess (pps fooppx))))

test/blackbox-tests/test-cases/meta-gen/dune

@@ -39,7 +39,7 @@
   (public_name foobar.ppd)
   (synopsis "pp'd with a rewriter")
   (libraries (foobar))
-  (preprocess (pps (foobar_rewriter)))))
+  (preprocess (pps foobar_rewriter))))
 
 (alias
  ((name runtest)

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

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

@@ -0,0 +1,19 @@
+let () =
+  let ic = open_in_bin Sys.argv.(1) in
+  let col = ref 0 in
+  try
+    while true do
+      let x = Char.code (input_char ic) in
+      (match !col with
+       | 0 -> ()
+       | 8 -> print_string "  "
+       | _ -> print_char ' ');
+      incr col;
+      Printf.printf "%02x" x;
+      if !col = 16 then begin
+        print_newline ();
+        col := 0;
+      end
+    done
+  with End_of_file ->
+    if !col <> 0 then print_newline ()

test/blackbox-tests/test-cases/windows-diff/run.t

@@ -0,0 +1,14 @@
+  $ dune runtest
+
+  $ cp hello.wrong-output hello.expected
+  $ dune runtest --diff-command false 2>&1 | sed 's/.*false.*/DIFF/;s/.*internal.*/DIFF/'
+  DIFF
+  DIFF
+  $ dune promote
+  Promoting _build/default/hello.output to hello.expected.
+  $ cat hello.expected
+  Hello, world!
+
+  $ dune build @cmp
+  Error: Files _build/default/a and _build/default/b differ.
+  [1]