From 0eb302252e55f4540ede9ee82684acf03ada100c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?J=C3=A9r=C3=A9mie=20Dimino?= Date: Mon, 25 Jun 2018 07:56:35 +0100 Subject: [PATCH 1/3] Improve the syntax of ppx rewriters and flags (#910) - old syntax: (pps (ppx1 -arg1 ppx2 (-foo x))) - new syntax: (pps ppx1 -arg ppx2 -- -foo x) Signed-off-by: Jeremie Dimino --- CHANGES.md | 4 ++ doc/jbuild.rst | 13 ++-- src/jbuild.ml | 67 +++++++++++++------ .../test-cases/dune-ppx-driver-system/dune | 18 ++++- .../test-cases/dune-ppx-driver-system/run.t | 25 ++++++- .../test-cases/js_of_ocaml/bin/dune | 2 +- .../test-cases/js_of_ocaml/lib/dune | 2 +- .../test-cases/merlin-tests/lib/dune | 4 +- test/blackbox-tests/test-cases/meta-gen/dune | 2 +- 9 files changed, 98 insertions(+), 39 deletions(-) diff --git a/CHANGES.md b/CHANGES.md index 5d66d8e6..3e560fa9 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -84,6 +84,10 @@ 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 (#..., @diml) + 1.0+beta20 (10/04/2018) ----------------------- diff --git a/doc/jbuild.rst b/doc/jbuild.rst index 166b54d4..e2c78ec9 100644 --- a/doc/jbuild.rst +++ b/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 )`` to preprocess files using the given action -- ``(pps ())`` to preprocess files using the given list +- ``(pps )`` 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 `` option passed to the OCaml compiler is Preprocessing with ppx rewriters ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -```` is expected to be a list where each element is -either a command line flag if starting with a ``-`` or the name of a library. -Additionally, any sub-list will be treated as a list of command line arguments. -So for instance from the following ``preprocess`` field: +```` is expected to be a sequence where each +element is either a command line flag if starting with a ``-`` or the +name of a library. If you want to pass command line flags that do not +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``. diff --git a/src/jbuild.ml b/src/jbuild.ml index 42ef6583..c0368d24 100644 --- a/src/jbuild.ml +++ b/src/jbuild.ml @@ -181,29 +181,53 @@ end = struct let compare = String.compare end -module Pp_or_flags = struct - type t = - | PP of Loc.t * Pp.t - | Flags of string list +module Pps_and_flags = struct + module Jbuild_syntax = struct + let of_string ~loc s = + if String.is_prefix s ~prefix:"-" then + Right [s] + else + Left (loc, Pp.of_string s) - let of_string ~loc s = - if String.is_prefix s ~prefix:"-" then - Flags [s] - else - PP (loc, Pp.of_string s) + let item = + peek raw >>= function + | Atom _ | Quoted_string _ -> plain_string of_string + | List _ -> list string >>| fun l -> Right l + + 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 - | Atom _ | Quoted_string _ -> plain_string of_string - | List _ -> list string >>| fun l -> Flags l - - let split l = - let pps, flags = - List.partition_map l ~f:(function - | PP (loc, pp) -> Left (loc, pp) - | Flags s -> Right s) - in - (pps, List.concat flags) + Syntax.get_exn Stanza.syntax >>= fun ver -> + if ver < (1, 0) then + Jbuild_syntax.t + else + Dune_syntax.t 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 -> - let pps, flags = Pp_or_flags.split l in + Pps_and_flags.t >>| fun (pps, flags) -> Pps { loc; pps; flags }) ] diff --git a/test/blackbox-tests/test-cases/dune-ppx-driver-system/dune b/test/blackbox-tests/test-cases/dune-ppx-driver-system/dune index b38b91fb..50555afa 100644 --- a/test/blackbox-tests/test-cases/dune-ppx-driver-system/dune +++ b/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)))) diff --git a/test/blackbox-tests/test-cases/dune-ppx-driver-system/run.t b/test/blackbox-tests/test-cases/dune-ppx-driver-system/run.t index dc7881e2..02951b61 100644 --- a/test/blackbox-tests/test-cases/dune-ppx-driver-system/run.t +++ b/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] diff --git a/test/blackbox-tests/test-cases/js_of_ocaml/bin/dune b/test/blackbox-tests/test-cases/js_of_ocaml/bin/dune index ea11bfdb..f59a2896 100644 --- a/test/blackbox-tests/test-cases/js_of_ocaml/bin/dune +++ b/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)) )) diff --git a/test/blackbox-tests/test-cases/js_of_ocaml/lib/dune b/test/blackbox-tests/test-cases/js_of_ocaml/lib/dune index 535c3012..4c39619a 100644 --- a/test/blackbox-tests/test-cases/js_of_ocaml/lib/dune +++ b/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)) )) diff --git a/test/blackbox-tests/test-cases/merlin-tests/lib/dune b/test/blackbox-tests/test-cases/merlin-tests/lib/dune index 02d88c23..14bb78e3 100644 --- a/test/blackbox-tests/test-cases/merlin-tests/lib/dune +++ b/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)))) diff --git a/test/blackbox-tests/test-cases/meta-gen/dune b/test/blackbox-tests/test-cases/meta-gen/dune index 2ca20128..bacf12d5 100644 --- a/test/blackbox-tests/test-cases/meta-gen/dune +++ b/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) From f46a6aae53cc92df090abdb825be3e94adec1505 Mon Sep 17 00:00:00 2001 From: Jeremie Dimino Date: Wed, 20 Jun 2018 16:49:26 +0100 Subject: [PATCH 2/3] 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 --- CHANGES.md | 5 +- appveyor.yml | 2 + doc/jbuild.rst | 10 ++++ src/action.ml | 60 ++++++++++++++----- src/action.mli | 1 + src/action_intf.ml | 10 +++- src/print_diff.ml | 9 ++- src/print_diff.mli | 2 +- src/stdune/io.ml | 48 ++++++++++++++- src/stdune/io.mli | 5 +- test/blackbox-tests/dune.inc | 14 ++++- .../test-cases/windows-diff/dune | 14 +++++ .../test-cases/windows-diff/dune-project | 1 + .../test-cases/windows-diff/hello.expected | 1 + .../test-cases/windows-diff/hello.ml | 1 + .../windows-diff/hello.wrong-output | 1 + .../test-cases/windows-diff/hexdump.ml | 19 ++++++ .../test-cases/windows-diff/run.t | 14 +++++ 18 files changed, 189 insertions(+), 28 deletions(-) create mode 100644 test/blackbox-tests/test-cases/windows-diff/dune create mode 100644 test/blackbox-tests/test-cases/windows-diff/dune-project create mode 100644 test/blackbox-tests/test-cases/windows-diff/hello.expected create mode 100644 test/blackbox-tests/test-cases/windows-diff/hello.ml create mode 100644 test/blackbox-tests/test-cases/windows-diff/hello.wrong-output create mode 100644 test/blackbox-tests/test-cases/windows-diff/hexdump.ml create mode 100644 test/blackbox-tests/test-cases/windows-diff/run.t diff --git a/CHANGES.md b/CHANGES.md index 3e560fa9..c71edf52 100644 --- a/CHANGES.md +++ b/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) ----------------------- diff --git a/appveyor.yml b/appveyor.yml index 7830c5c7..a4264584 100644 --- a/appveyor.yml +++ b/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 diff --git a/doc/jbuild.rst b/doc/jbuild.rst index e2c78ec9..501c1991 100644 --- a/doc/jbuild.rst +++ b/doc/jbuild.rst @@ -1209,6 +1209,9 @@ The following constructions are available: - ``(diff? )`` is the same as ``(diff )`` except that it is ignored when ```` or ```` doesn't exists +- ``(cmp )`` is similar to ``(run cmp + )`` 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 ~~~~~~~~~ diff --git a/src/action.ml b/src/action.ml index ea9f8f76..24870fed 100644 --- a/src/action.ml +++ b/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@}: 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 diff --git a/src/action.mli b/src/action.mli index e3972fdd..a1612ad1 100644 --- a/src/action.mli +++ b/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 *) diff --git a/src/action_intf.ml b/src/action_intf.ml index 9c7c663f..4f4a8c07 100644 --- a/src/action_intf.ml +++ b/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 diff --git a/src/print_diff.ml b/src/print_diff.ml index 0cf03568..b5fe1bfe 100644 --- a/src/print_diff.ml +++ b/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 diff --git a/src/print_diff.mli b/src/print_diff.mli index e813d059..439c2e65 100644 --- a/src/print_diff.mli +++ b/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 diff --git a/src/stdune/io.ml b/src/stdune/io.ml index 28cdec76..faaf865c 100644 --- a/src/stdune/io.ml +++ b/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 compare_files fn1 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 = diff --git a/src/stdune/io.mli b/src/stdune/io.mli index ee76ad88..3b4a85f0 100644 --- a/src/stdune/io.mli +++ b/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 diff --git a/test/blackbox-tests/dune.inc b/test/blackbox-tests/dune.inc index ee00881c..bd2b03fa 100644 --- a/test/blackbox-tests/dune.inc +++ b/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))))) diff --git a/test/blackbox-tests/test-cases/windows-diff/dune b/test/blackbox-tests/test-cases/windows-diff/dune new file mode 100644 index 00000000..675ef6ca --- /dev/null +++ b/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)))) diff --git a/test/blackbox-tests/test-cases/windows-diff/dune-project b/test/blackbox-tests/test-cases/windows-diff/dune-project new file mode 100644 index 00000000..de4fc209 --- /dev/null +++ b/test/blackbox-tests/test-cases/windows-diff/dune-project @@ -0,0 +1 @@ +(lang dune 1.0) diff --git a/test/blackbox-tests/test-cases/windows-diff/hello.expected b/test/blackbox-tests/test-cases/windows-diff/hello.expected new file mode 100644 index 00000000..af5626b4 --- /dev/null +++ b/test/blackbox-tests/test-cases/windows-diff/hello.expected @@ -0,0 +1 @@ +Hello, world! diff --git a/test/blackbox-tests/test-cases/windows-diff/hello.ml b/test/blackbox-tests/test-cases/windows-diff/hello.ml new file mode 100644 index 00000000..37c4191c --- /dev/null +++ b/test/blackbox-tests/test-cases/windows-diff/hello.ml @@ -0,0 +1 @@ +let () = print_endline "Hello, world!" diff --git a/test/blackbox-tests/test-cases/windows-diff/hello.wrong-output b/test/blackbox-tests/test-cases/windows-diff/hello.wrong-output new file mode 100644 index 00000000..d6d9d34c --- /dev/null +++ b/test/blackbox-tests/test-cases/windows-diff/hello.wrong-output @@ -0,0 +1 @@ +blah \ No newline at end of file diff --git a/test/blackbox-tests/test-cases/windows-diff/hexdump.ml b/test/blackbox-tests/test-cases/windows-diff/hexdump.ml new file mode 100644 index 00000000..841501a6 --- /dev/null +++ b/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 () diff --git a/test/blackbox-tests/test-cases/windows-diff/run.t b/test/blackbox-tests/test-cases/windows-diff/run.t new file mode 100644 index 00000000..59650f09 --- /dev/null +++ b/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] From daa4be3dd8e690ca1e39ec827f2872762ac3adf1 Mon Sep 17 00:00:00 2001 From: Jeremie Dimino Date: Mon, 25 Jun 2018 08:11:54 +0100 Subject: [PATCH 3/3] Add Stanza.file_kind Signed-off-by: Jeremie Dimino --- src/action.ml | 16 ++++++++++++---- src/stanza.ml | 9 +++++++++ src/stanza.mli | 7 +++++++ 3 files changed, 28 insertions(+), 4 deletions(-) diff --git a/src/action.ml b/src/action.ml index 24870fed..ce4f5cba 100644 --- a/src/action.ml +++ b/src/action.ml @@ -89,14 +89,22 @@ struct ; "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 + 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 -> - Syntax.get_exn Stanza.syntax >>| fun ver -> - let mode = if ver < (1, 0) then Diff_mode.Text_jbuild else Text in + 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 () -> diff --git a/src/stanza.ml b/src/stanza.ml index a82b9f9e..478870f5 100644 --- a/src/stanza.ml +++ b/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 diff --git a/src/stanza.mli b/src/stanza.mli index d7d1800d..76e15002 100644 --- a/src/stanza.mli +++ b/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