From 018416f18b8bfe49f782f783a697caa1c103468f Mon Sep 17 00:00:00 2001 From: Jeremie Dimino Date: Tue, 16 Apr 2019 16:32:19 +0100 Subject: [PATCH 1/9] Start support for passing extra cookies to ppx rewriters Signed-off-by: Jeremie Dimino --- src/lib_kind.ml | 55 ++++++++++++++++++++++++++++++++++++++++++------ src/lib_kind.mli | 17 +++++++++++++-- 2 files changed, 64 insertions(+), 8 deletions(-) diff --git a/src/lib_kind.ml b/src/lib_kind.ml index 181769b9131..6c7418acaf4 100644 --- a/src/lib_kind.ml +++ b/src/lib_kind.ml @@ -1,7 +1,44 @@ +module Ppx_args = struct + module Cookie = struct + type t = + { name : string + ; value : String_with_vars.t + } + + let decode = + let open Stanza.Decoder in + let+ name = string + and+ value = String_with_vars.decode in + return { name; value } + + let encode { name; value } = + let open Dune_lang.Encoder in + List + [ string name + ; String_with_vars.encode value + ] + end + + type t = + { cookies : Cookies.t list + } + + let decode = + let open Stanza.Decoder in + fields + (let+ cookies = field "cookies" (list Cookie.decode) ~default:[] in + { cookies }) + + let encode { cookies } = + let open Dune_lang.Encoder in + record_fields + [ field_l "cookies" Cookies.encode cookies ] +end + type t = | Normal - | Ppx_deriver - | Ppx_rewriter + | Ppx_deriver of Ppx_args.t + | Ppx_rewriter of Ppx_args.t let decode = let open Dune_lang.Decoder in @@ -12,8 +49,14 @@ let decode = ] let encode t = - Dune_lang.Encoder.string ( + let open Dune_lang.Encoder in + match match t with - | Normal -> "normal" - | Ppx_deriver -> "ppx_deriver" - | Ppx_rewriter -> "ppx_rewriter") + | Normal -> Dune_lang.atom "normal" + | Ppx_deriver x -> + List (Dune_lang.atom "ppx_deriver" :: Ppx_args.encode x) + | Ppx_rewriter x -> + List (Dune_lang.atom "ppx_rewriter" :: Ppx_args.encode x) + with + | List [x] -> x + | x -> x diff --git a/src/lib_kind.mli b/src/lib_kind.mli index 291b9da3775..c07e79eec95 100644 --- a/src/lib_kind.mli +++ b/src/lib_kind.mli @@ -1,6 +1,19 @@ +module Ppx_args : sig + module Cookie = struct + type t = + { name : string + ; value : String_with_vars.t + } + end + + type t = + { cookies : Cookies.t list + } +end + type t = | Normal - | Ppx_deriver - | Ppx_rewriter + | Ppx_deriver of Ppx_args.t + | Ppx_rewriter of Ppx_args.t include Dune_lang.Conv with type t := t From 221893703fcd8b994fac18b357a41532391a48fa Mon Sep 17 00:00:00 2001 From: Marc Lasson Date: Wed, 8 May 2019 12:15:17 +0200 Subject: [PATCH 2/9] New feature: cookies in ppx_rewriter/deriver Signed-off-by: Marc Lasson --- src/gen_meta.ml | 8 +- src/install_rules.ml | 4 +- src/lib_kind.ml | 33 ++-- src/lib_kind.mli | 4 +- src/lib_rules.ml | 2 +- src/merlin.ml | 9 +- src/preprocessing.ml | 152 ++++++++++++------ src/preprocessing.mli | 11 +- src/stdune/map.ml | 6 + src/stdune/map_intf.ml | 1 + .../dune-ppx-driver-system/driver-tests/dune | 52 +++++- .../test-cases/dune-ppx-driver-system/run.t | 37 +++-- 12 files changed, 211 insertions(+), 108 deletions(-) diff --git a/src/gen_meta.ml b/src/gen_meta.ml index a054203bc37..16b9b6c3037 100644 --- a/src/gen_meta.ml +++ b/src/gen_meta.ml @@ -75,7 +75,7 @@ let gen_lib pub_name lib ~version = let preds = match Lib.kind lib with | Normal -> [] - | Ppx_rewriter | Ppx_deriver -> [Pos "ppx_driver"] + | Ppx_rewriter _ | Ppx_deriver _ -> [Pos "ppx_driver"] in let lib_deps = Lib.Meta.requires lib in let ppx_rt_deps = Lib.Meta.ppx_runtime_deps lib in @@ -95,7 +95,7 @@ let gen_lib pub_name lib ~version = ] ; (match Lib.kind lib with | Normal -> [] - | Ppx_rewriter | Ppx_deriver -> + | Ppx_rewriter _ | Ppx_deriver _ -> (* Deprecated ppx method support *) let no_ppx_driver = Neg "ppx_driver" and no_custom_ppx = Neg "custom_ppx" in List.concat @@ -107,10 +107,10 @@ let gen_lib pub_name lib ~version = ] ; match Lib.kind lib with | Normal -> assert false - | Ppx_rewriter -> + | Ppx_rewriter _ -> [ rule "ppx" [no_ppx_driver; no_custom_ppx] Set "./ppx.exe --as-ppx" ] - | Ppx_deriver -> + | Ppx_deriver _ -> [ rule "requires" [no_ppx_driver; no_custom_ppx] Add "ppx_deriving" ; rule "ppxopt" [no_ppx_driver; no_custom_ppx] Set diff --git a/src/install_rules.ml b/src/install_rules.ml index ab479cc0160..a555d6825af 100644 --- a/src/install_rules.ml +++ b/src/install_rules.ml @@ -152,8 +152,8 @@ let init_meta sctx ~dir = let lib_ppxs sctx ~(lib : Dune_file.Library.t) ~scope ~dir_kind = match lib.kind with - | Normal | Ppx_deriver -> [] - | Ppx_rewriter -> + | Normal | Ppx_deriver _ -> [] + | Ppx_rewriter _ -> let name = Dune_file.Library.best_name lib in match (dir_kind : Dune_lang.File_syntax.t) with | Dune -> diff --git a/src/lib_kind.ml b/src/lib_kind.ml index 6c7418acaf4..0a319465d03 100644 --- a/src/lib_kind.ml +++ b/src/lib_kind.ml @@ -7,32 +7,36 @@ module Ppx_args = struct let decode = let open Stanza.Decoder in - let+ name = string - and+ value = String_with_vars.decode in - return { name; value } + let* () = Syntax.since Stanza.syntax (1, 10) in + enter + (let+ name = string + and+ value = String_with_vars.decode in + { name; value }) let encode { name; value } = - let open Dune_lang.Encoder in + let open Dune_lang in List - [ string name + [ Encoder.string name ; String_with_vars.encode value ] end type t = - { cookies : Cookies.t list + { cookies : Cookie.t list } let decode = let open Stanza.Decoder in - fields - (let+ cookies = field "cookies" (list Cookie.decode) ~default:[] in - { cookies }) + let args = + let+ cookies = field "cookies" (list Cookie.decode) ~default:[] in + {cookies} + in + fields args let encode { cookies } = let open Dune_lang.Encoder in record_fields - [ field_l "cookies" Cookies.encode cookies ] + [ field_l "cookies" Cookie.encode cookies ] end type t = @@ -42,14 +46,13 @@ type t = let decode = let open Dune_lang.Decoder in - enum - [ "normal" , Normal - ; "ppx_deriver" , Ppx_deriver - ; "ppx_rewriter" , Ppx_rewriter + sum + [ "normal" , return Normal + ; "ppx_deriver" , (let+ args = Ppx_args.decode in Ppx_deriver args) + ; "ppx_rewriter" , (let+ args = Ppx_args.decode in Ppx_rewriter args) ] let encode t = - let open Dune_lang.Encoder in match match t with | Normal -> Dune_lang.atom "normal" diff --git a/src/lib_kind.mli b/src/lib_kind.mli index c07e79eec95..2755c58fca6 100644 --- a/src/lib_kind.mli +++ b/src/lib_kind.mli @@ -1,5 +1,5 @@ module Ppx_args : sig - module Cookie = struct + module Cookie : sig type t = { name : string ; value : String_with_vars.t @@ -7,7 +7,7 @@ module Ppx_args : sig end type t = - { cookies : Cookies.t list + { cookies : Cookie.t list } end diff --git a/src/lib_rules.ml b/src/lib_rules.ml index 7d360c24e1d..6328dd45998 100644 --- a/src/lib_rules.ml +++ b/src/lib_rules.ml @@ -77,7 +77,7 @@ module Gen (P : sig val sctx : Super_context.t end) = struct ; Dyn (fun (_, _, _, library_flags) -> As library_flags) ; As (match lib.kind with | Normal -> [] - | Ppx_deriver | Ppx_rewriter -> ["-linkall"]) + | Ppx_deriver _ | Ppx_rewriter _ -> ["-linkall"]) ; Dyn (fun (cm_files, _, _, _) -> Deps cm_files) ; Hidden_targets (match mode with diff --git a/src/merlin.ml b/src/merlin.ml index 42d7aecd4c9..9f40cddd002 100644 --- a/src/merlin.ml +++ b/src/merlin.ml @@ -127,14 +127,11 @@ let pp_flags sctx ~expander ~dir_kind { preprocess; libname; _ } = (Super_context.context sctx).version with | Pps { loc = _; pps; flags; staged = _ } -> begin - match Preprocessing.get_ppx_driver sctx ~scope ~dir_kind pps with + match Preprocessing.get_ppx_driver sctx ~expander ~lib_name:libname ~flags ~scope ~dir_kind pps with | Error _ -> None - | Ok exe -> - let flags = List.map ~f:(Expander.expand_str expander) flags in + | Ok (exe, flags) -> (Path.to_absolute_filename exe - :: "--as-ppx" - :: Preprocessing.cookie_library_name libname - @ flags) + :: "--as-ppx" :: flags) |> List.map ~f:quote_for_merlin |> String.concat ~sep:" " |> Filename.quote diff --git a/src/preprocessing.ml b/src/preprocessing.ml index 21071ebd903..4099de729e2 100644 --- a/src/preprocessing.ml +++ b/src/preprocessing.ml @@ -477,9 +477,70 @@ let get_compat_ppx_exe sctx ~name ~kind = in ppx_exe sctx ~key ~dir_kind:Jbuild -let get_ppx_driver sctx ~loc ~scope ~dir_kind pps = +let args_of_cookies cookies = + List.map ~f:(fun (name, value) -> + ["--cookie"; sprintf "%s=%S" name value] + ) cookies |> List.flatten + +let library_name_cookie : Lib_kind.Ppx_args.Cookie.t = + { + name = "library_name"; + value = String_with_vars.make_var Loc.none "library_name" + } +let get_cookies ~loc ~expander ~lib_name libs = + let expander = + match lib_name with + | None -> expander + | Some name -> + let bindings = + Pform.Map.singleton "library_name" + (Values [String (Lib_name.Local.to_string name)]) + in + Expander.add_bindings expander ~bindings + in + try + Ok (libs + |> List.map ~f: + (fun t -> + match Lib.kind t with + | Normal -> [] + | Ppx_rewriter {cookies} + | Ppx_deriver {cookies} -> + List.map ~f:(fun {Lib_kind.Ppx_args.Cookie.name; value} -> + (name, (Expander.expand_str expander value, Lib.name t))) + (if lib_name = None then cookies else library_name_cookie :: cookies) + ) + |> List.flatten + |> String.Map.of_list_reducei ~f: + (fun name ((val1, lib1) as res) (val2, lib2) -> + if String.equal val1 val2 then + res + else + let lib1 = Lib_name.to_string lib1 in + let lib2 = Lib_name.to_string lib2 in + Errors.fail loc "%a" Fmt.text + (sprintf "%s and %s have inconsistent requests for cookie \"%s\"; \ + %s requests \"%s\" and %s requests \"%s\"" + lib1 lib2 name + lib1 val1 + lib2 val2) + ) + |> String.Map.foldi ~init:[] + ~f:(fun name (value, _) acc -> (name, value) :: acc) + |> List.rev) + with exn -> Error exn + +let ppx_driver_and_flags_internal sctx ~expander ~lib_name ~flags ~dir_kind libs = + let open Result.O in + let flags = List.map ~f:(Expander.expand_str expander) flags in + let+ cookies = get_cookies ~loc:Loc.none ~lib_name ~expander libs in + let sctx = SC.host sctx in + ppx_driver_exe sctx libs ~dir_kind, flags @ args_of_cookies cookies + +let ppx_driver_and_flags sctx ~lib_name ~expander ~scope ~loc ~dir_kind ~flags pps = let open Result.O in let* libs = Lib.DB.resolve_pps (Scope.libs scope) pps in + let* exe, flags = ppx_driver_and_flags_internal sctx ~expander ~lib_name ~flags ~dir_kind libs in let+ driver = match (dir_kind : Dune_lang.File_syntax.t) with | Dune -> @@ -489,15 +550,11 @@ let get_ppx_driver sctx ~loc ~scope ~dir_kind pps = | Jbuild -> Ok (Jbuild_driver.get_driver pps) in - (ppx_driver_exe (SC.host sctx) libs ~dir_kind, driver) + (exe, driver, flags) + let workspace_root_var = String_with_vars.virt_var __POS__ "workspace_root" -let cookie_library_name lib_name = - match lib_name with - | None -> [] - | Some name -> - ["--cookie"; sprintf "library-name=%S" (Lib_name.Local.to_string name)] (* Generate rules for the reason modules in [modules] and return a a new module with only OCaml sources *) @@ -584,26 +641,24 @@ let lint_module sctx ~dir ~expander ~dep_kind ~lint ~lib_name ~scope ~dir_kind = if staged then Errors.fail loc "Staged ppx rewriters cannot be used as linters."; - let flags = List.map ~f:(Expander.expand_str expander) flags in - let args : _ Arg_spec.t = - S [ As flags - ; As (cookie_library_name lib_name) - ] - in let corrected_suffix = ".lint-corrected" in - let driver_and_flags = + let driver_flags_and_args = let open Result.O in - let+ (exe, driver) = - get_ppx_driver sctx ~loc ~scope ~dir_kind pps in - (exe, - let bindings = - Pform.Map.singleton "corrected-suffix" - (Values [String corrected_suffix]) - in - let expander = Expander.add_bindings expander ~bindings in - Build.memoize "ppx flags" - (Expander.expand_and_eval_set expander driver.info.lint_flags - ~standard:(Build.return []))) + let+ (exe, driver, driver_flags) = + ppx_driver_and_flags sctx ~expander ~loc ~lib_name ~flags ~dir_kind ~scope pps + in + let flags = + let bindings = + Pform.Map.singleton "corrected-suffix" + (Values [String corrected_suffix]) + in + let expander = Expander.add_bindings expander ~bindings in + Build.memoize "ppx flags" + (Expander.expand_and_eval_set expander driver.info.lint_flags + ~standard:(Build.return [])) + in + let args : _ Arg_spec.t = S [ As driver_flags ] in + (exe, flags, args) in (fun ~source ~ast -> Module.iter ast ~f:(fun kind src -> @@ -611,15 +666,16 @@ let lint_module sctx ~dir ~expander ~dep_kind ~lint ~lib_name ~scope ~dir_kind = ~loc:None (promote_correction ~suffix:corrected_suffix (Option.value_exn (Module.file source kind)) - (Build.of_result_map driver_and_flags ~f:(fun (exe, flags) -> - flags >>> - Build.run ~dir:(SC.context sctx).build_dir - (Ok exe) - [ args - ; Ml_kind.ppx_driver_flag kind - ; Dep src.path - ; Dyn (fun x -> As x) - ])))))) + (Build.of_result_map driver_flags_and_args + ~f:(fun (exe, flags, args) -> + flags >>> + Build.run ~dir:(SC.context sctx).build_dir + (Ok exe) + [ args + ; Ml_kind.ppx_driver_flag kind + ; Dep src.path + ; Dyn (fun x -> As x) + ])))))) in fun ~(source : Module.t) ~ast -> Per_module.get lint (Module.name source) ~source ~ast) @@ -660,26 +716,21 @@ let make sctx ~dir ~expander ~dep_kind ~lint ~preprocess if lint then lint_module ~ast ~source:m; ast) | Pps { loc; pps; flags; staged } -> - let flags = List.map ~f:(Expander.expand_str expander) flags in if not staged then begin - let args : _ Arg_spec.t = - S [ As flags - ; As (cookie_library_name lib_name) - ] - in let corrected_suffix = ".ppx-corrected" in let driver_and_flags = let open Result.O in - let+ (exe, driver) = get_ppx_driver sctx ~loc ~scope ~dir_kind pps in + let+ (exe, driver, flags) = ppx_driver_and_flags sctx ~expander ~loc ~lib_name ~flags ~dir_kind ~scope pps in + let args : _ Arg_spec.t = S [ As flags ] in (exe, - let bindings = + (let bindings = Pform.Map.singleton "corrected-suffix" (Values [String corrected_suffix]) in let expander = Expander.add_bindings expander ~bindings in Build.memoize "ppx flags" (Expander.expand_and_eval_set expander driver.info.flags - ~standard:(Build.return ["--as-ppx"]))) + ~standard:(Build.return ["--as-ppx"]))), args) in (fun m ~lint -> let ast = setup_reason_rules sctx m in @@ -692,7 +743,7 @@ let make sctx ~dir ~expander ~dep_kind ~lint ~preprocess >>> Build.of_result_map driver_and_flags ~targets:[dst] - ~f:(fun (exe, flags) -> + ~f:(fun (exe, flags, args) -> flags >>> Build.run ~dir:(SC.context sctx).build_dir @@ -705,8 +756,9 @@ let make sctx ~dir ~expander ~dep_kind ~lint ~preprocess end else begin let pp_flags = Build.of_result ( let open Result.O in - let+ (exe, driver) = - get_ppx_driver sctx ~loc ~scope ~dir_kind pps in + let+ (exe, driver, flags) = + ppx_driver_and_flags sctx ~expander ~loc ~scope ~dir_kind ~flags ~lib_name pps + in Build.memoize "ppx command" (Build.path exe >>> @@ -721,7 +773,6 @@ let make sctx ~dir ~expander ~dep_kind ~lint ~preprocess [ [Path.reach exe ~from:(SC.context sctx).build_dir] ; driver_flags ; flags - ; cookie_library_name lib_name ]) ~f:quote_for_shell |> String.concat ~sep:" " @@ -742,8 +793,7 @@ let pp_modules t ?(lint=true) modules = let pp_module_as t ?(lint=true) name m = Per_module.get t name m ~lint -let get_ppx_driver sctx ~scope ~dir_kind pps = +let get_ppx_driver sctx ~expander ~scope ~lib_name ~flags ~dir_kind pps = let open Result.O in - let+ libs = Lib.DB.resolve_pps (Scope.libs scope) pps in - let sctx = SC.host sctx in - ppx_driver_exe sctx libs ~dir_kind + let* libs = Lib.DB.resolve_pps (Scope.libs scope) pps in + ppx_driver_and_flags_internal sctx ~expander ~lib_name ~flags ~dir_kind libs diff --git a/src/preprocessing.mli b/src/preprocessing.mli index c42ac3ceec1..31d83870105 100644 --- a/src/preprocessing.mli +++ b/src/preprocessing.mli @@ -38,13 +38,16 @@ val pp_module_as -> Module.t -> Module.t -(** Get a path to a cached ppx driver *) +(** Get a path to a cached ppx driver with some extra flags for cookies. *) val get_ppx_driver : Super_context.t + -> expander:Expander.t -> scope:Scope.t + -> lib_name:Lib_name.Local.t option + -> flags:String_with_vars.t list -> dir_kind:Dune_lang.File_syntax.t -> (Loc.t * Lib_name.t) list - -> Path.t Or_exn.t + -> (Path.t * string list) Or_exn.t module Compat_ppx_exe_kind : sig (** [Dune] for directories using a [dune] file, and [Jbuild driver] @@ -61,8 +64,4 @@ val get_compat_ppx_exe -> kind:Compat_ppx_exe_kind.t -> Path.t -(** [cookie_library_name lib_name] is ["--cookie"; lib_name] if [lib_name] is not - [None] *) -val cookie_library_name : Lib_name.Local.t option -> string list - val gen_rules : Super_context.t -> string list -> unit diff --git a/src/stdune/map.ml b/src/stdune/map.ml index cb1d76a02b0..8b5c72a63df 100644 --- a/src/stdune/map.ml +++ b/src/stdune/map.ml @@ -128,6 +128,12 @@ module Make(Key : Comparable.S) : S with type key = Key.t = struct List.fold_left l ~init:empty ~f:(fun acc (key, data) -> let x = Option.value (find acc key) ~default:init in add acc key (f x data)) + + let of_list_reducei l ~f = + List.fold_left l ~init:empty ~f:(fun acc (key, data) -> + match find acc key with + | None -> add acc key data + | Some x -> add acc key (f key x data)) let of_list_multi l = List.fold_left (List.rev l) ~init:empty ~f:(fun acc (key, data) -> diff --git a/src/stdune/map_intf.ml b/src/stdune/map_intf.ml index 156124f2ccd..a410b50f555 100644 --- a/src/stdune/map_intf.ml +++ b/src/stdune/map_intf.ml @@ -66,6 +66,7 @@ module type S = sig val of_list_multi : (key * 'a) list -> 'a list t val of_list_reduce : (key * 'a) list -> f:('a -> 'a -> 'a) -> 'a t + val of_list_reducei : (key * 'a) list -> f:(key -> 'a -> 'a -> 'a) -> 'a t (** Return a map of [(k, v)] bindings such that: diff --git a/test/blackbox-tests/test-cases/dune-ppx-driver-system/driver-tests/dune b/test/blackbox-tests/test-cases/dune-ppx-driver-system/driver-tests/dune index 018ee4a39a9..53a8886cbb7 100644 --- a/test/blackbox-tests/test-cases/dune-ppx-driver-system/driver-tests/dune +++ b/test/blackbox-tests/test-cases/dune-ppx-driver-system/driver-tests/dune @@ -19,9 +19,17 @@ (modules foo3) (preprocess (pps ppx_other))) +; Incompatible cookies +(library + (name foo4) + (public_name foo.4) + (modules foo4) + (preprocess (pps ppx3 ppx4))) + (rule (with-stdout-to foo1.ml (echo ""))) (rule (with-stdout-to foo2.ml (echo ""))) (rule (with-stdout-to foo3.ml (echo ""))) +(rule (with-stdout-to foo4.ml (echo ""))) (library (name ppx1) @@ -37,6 +45,20 @@ (modules ()) (libraries driver2)) +(library + (name ppx3) + (public_name foo.ppx3) + (kind (ppx_rewriter (cookies (germany "spritzgeback")))) + (modules ()) + (libraries driver2)) + +(library + (name ppx4) + (public_name foo.ppx4) + (kind (ppx_rewriter (cookies (germany "lebkuchen") (library-name "%{library_name}")))) + (modules ()) + (libraries driver2)) + (library (name driver1) (public_name foo.driver1) @@ -62,10 +84,22 @@ (rule (with-stdout-to test_ppx_args.ml (echo ""))) +(library + (name ppx_with_cookies_print_args) + (kind (ppx_rewriter + (cookies (italy "%{env:ITALY=undefined}") + (france "%{env:FRANCE=undefined}")))) + (modules ()) + (libraries driver_print_args)) + +(env (_ (env-vars (ITALY "Biscotti") (FRANCE "Petit Beurre") (AMERICA "Oreo") (ENGLAND "Snickerdoodle")))) + (library (name test_ppx_args) (modules test_ppx_args) - (preprocess (pps -arg1 driver_print_args -arg2 -- -foo bar))) + (preprocess + (pps -arg1 driver_print_args ppx_with_cookies_print_args -arg2 -arg3=%{env:AMERICA=undefined} -- + -foo bar %{env:ENGLAND=undefined}))) (library (name driver_print_tool) @@ -80,13 +114,19 @@ "\| Ast_mapper.default_mapper)) ))) -(rule (with-stdout-to test_ppx_staged.ml (echo ""))) +(library + (name ppx_with_cookies_print_tool) + (kind (ppx_rewriter + (cookies (italy "%{env:ITALY=undefined}") + (france "%{env:FRANCE=undefined}")))) + (modules ()) + (libraries driver_print_tool)) -(env (_ (env-vars (FOO baz)))) +(rule (with-stdout-to test_ppx_staged.ml (echo ""))) (library (name test_ppx_staged) (modules test_ppx_staged) - (preprocess - (staged_pps -arg1 driver_print_tool -arg2 -arg3=%{env:FOO=undefined} -- - -foo bar %{env:FOO=undefined}))) + (preprocess + (staged_pps -arg1 driver_print_tool ppx_with_cookies_print_tool -arg2 -arg3=%{env:AMERICA=undefined} -- + -foo bar %{env:ENGLAND=undefined}))) 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 8ed58b5d08b..957dcfc9e56 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 @@ -31,6 +31,15 @@ Not compatible with Dune using ocaml-migrate-parsetree, ppxlib or ppx_driver. [1] +Incompatible Cookies + + $ dune build --root driver-tests foo4.cma + Entering directory 'driver-tests' + Error: foo.ppx3 and foo.ppx4 have inconsistent requests for cookie "germany"; + foo.ppx3 requests "spritzgeback" and foo.ppx4 requests + "lebkuchen" + [1] + Same, but with error pointing to .ppx $ dune build --root driver-tests .ppx/foo.ppx1+foo.ppx2/ppx.exe @@ -54,21 +63,27 @@ Test the argument syntax $ dune build --root driver-tests test_ppx_args.cma Entering directory 'driver-tests' ppx test_ppx_args.pp.ml - .ppx/eb9468425030036114a3b9ffa4c89e4d/ppx.exe + .ppx/fb8f5a35329c41c0aef8d783a2c365db/ppx.exe -arg1 -arg2 + -arg3=Oreo -foo bar + Snickerdoodle + --cookie + france="Petit Beurre" --cookie - library-name="test_ppx_args" + italy="Biscotti" + --cookie + library_name="test_ppx_args" -o test_ppx_args.pp.ml --impl test_ppx_args.ml --as-ppx - File "dune", line 68, characters 13-60: - 68 | (preprocess (pps -arg1 driver_print_args -arg2 -- -foo bar))) - ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ + File "dune", line 101, characters 3-138: + 101 | (pps -arg1 driver_print_args ppx_with_cookies_print_args -arg2 -arg3=%{env:AMERICA=undefined} -- + 102 | -foo bar %{env:ENGLAND=undefined}))) Error: rule failed to generate the following targets: - test_ppx_args.pp.ml [1] @@ -79,10 +94,10 @@ Test that going throught the -ppx option of the compiler works Entering directory 'driver-tests' ocamldep .test_ppx_staged.objs/test_ppx_staged.ml.d tool name: ocamldep - args:--as-ppx -arg1 -arg2 -arg3=baz -foo bar baz --cookie library-name="test_ppx_staged" + args:--as-ppx -arg1 -arg2 -arg3=Oreo -foo bar Snickerdoodle --cookie france="Petit Beurre" --cookie italy="Biscotti" --cookie library_name="test_ppx_staged" ocamlc .test_ppx_staged.objs/byte/test_ppx_staged.{cmi,cmo,cmt} tool name: ocamlc - args:--as-ppx -arg1 -arg2 -arg3=baz -foo bar baz --cookie library-name="test_ppx_staged" + args:--as-ppx -arg1 -arg2 -arg3=Oreo -foo bar Snickerdoodle --cookie france="Petit Beurre" --cookie italy="Biscotti" --cookie library_name="test_ppx_staged" Test using installed drivers @@ -96,8 +111,6 @@ Test using installed drivers -arg2 -foo bar - --cookie - library-name="driveruser" -o driveruser.pp.ml --impl @@ -119,8 +132,6 @@ Test using installed drivers -arg2 -foo bar - --cookie - library-name="driveruser" -o driveruser.pp.ml --impl @@ -144,8 +155,6 @@ Test using installed drivers -arg2 -foo bar - --cookie - library-name="driveruser" -o driveruser.pp.ml --impl @@ -190,8 +199,6 @@ Test using installed drivers -arg2 -foo bar - --cookie - library-name="driveruser" -o driveruser.pp.ml --impl From b9cbf9696680b9938b694d21a39ba79348c37c69 Mon Sep 17 00:00:00 2001 From: Marc Lasson Date: Wed, 8 May 2019 12:16:20 +0200 Subject: [PATCH 3/9] Unit tests for lib_kind encode/decode Signed-off-by: Marc Lasson --- test/unit-tests/dune | 10 ++++ test/unit-tests/lib_kind.mlt | 102 +++++++++++++++++++++++++++++++++++ 2 files changed, 112 insertions(+) create mode 100644 test/unit-tests/lib_kind.mlt diff --git a/test/unit-tests/dune b/test/unit-tests/dune index 20c11a5e796..832135b467b 100644 --- a/test/unit-tests/dune +++ b/test/unit-tests/dune @@ -120,6 +120,16 @@ (run %{exe:expect_test.exe} %{t}) (diff? %{t} %{t}.corrected))))) +(alias + (name runtest) + (deps (:t lib_kind.mlt) + (glob_files %{project_root}/src/.dune.objs/byte/*.cmi) + (glob_files %{project_root}/src/stdune/.stdune.objs/byte/*.cmi)) + (action (chdir %{project_root} + (progn + (run %{exe:expect_test.exe} %{t}) + (diff? %{t} %{t}.corrected))))) + (alias (name runtest) (deps (:t string.mlt) diff --git a/test/unit-tests/lib_kind.mlt b/test/unit-tests/lib_kind.mlt new file mode 100644 index 00000000000..bb9dfd2a8dd --- /dev/null +++ b/test/unit-tests/lib_kind.mlt @@ -0,0 +1,102 @@ +(* -*- tuareg -*- *) +open Dune;; +open! Stdune;; + +let sexp_pp = Dune_lang.pp Dune;; +#install_printer sexp_pp;; + +let decode_string ~version s = + try + Ok (Dune_lang.Decoder.parse Lib_kind.decode (Univ_map.singleton (Syntax.key Stanza.syntax) version) + (Dune_lang.parse_string ~fname:"" ~mode:Dune_lang.Parser.Mode.Single s)) + with exn -> Error exn +[%%expect{| +val sexp_pp : Format.formatter -> Dune_lang.t -> unit = +val decode_string : + version:Syntax.Version.t -> string -> (Lib_kind.t, exn) Stdune.result = + +|}] + +let all_tests = + [ + "normal"; + "ppx_deriver"; + "ppx_rewriter"; + "(ppx_deriver (cookies))"; + "(ppx_rewriter (cookies))"; + "(ppx_deriver (cookies (\"Name with Space\" \"Value with Space\")))"; + "(ppx_deriver (cookies (name1 value1) (name2 value2) (name3 value3)))"; + "(ppx_rewriter (cookies (name1 value1) (name2 value2) (name3 value3)))"; + ] + +let decodes_1_10 = List.map (decode_string ~version:(1,10)) all_tests +[%%expect{| +val all_tests : string list = + ["normal"; "ppx_deriver"; "ppx_rewriter"; "(ppx_deriver (cookies))"; + "(ppx_rewriter (cookies))"; + "(ppx_deriver (cookies (\"Name with Space\" \"Value with Space\")))"; + "(ppx_deriver (cookies (name1 value1) (name2 value2) (name3 value3)))"; + "(ppx_rewriter (cookies (name1 value1) (name2 value2) (name3 value3)))"] +val decodes_1_10 : (Lib_kind.t, exn) Stdune.result list = + [Ok Normal; Ok (Ppx_deriver {cookies = []}); + Ok (Ppx_rewriter {cookies = []}); Ok (Ppx_deriver {cookies = []}); + Ok (Ppx_rewriter {cookies = []}); + Ok (Ppx_deriver {cookies = [{name = "Name with Space"; value = }]}); + Ok + (Ppx_deriver + {cookies = + [{name = "name1"; value = }; + {name = "name2"; value = }; + {name = "name3"; value = }]}); + Ok + (Ppx_rewriter + {cookies = + [{name = "name1"; value = }; + {name = "name2"; value = }; + {name = "name3"; value = }]})] +|}] + +let decodes_1_9 = List.map (decode_string ~version:(1,8)) all_tests +[%%expect{| +val decodes_1_9 : (Lib_kind.t, exn) Stdune.result list = + [Ok Normal; Ok (Ppx_deriver {cookies = []}); + Ok (Ppx_rewriter {cookies = []}); Ok (Ppx_deriver {cookies = []}); + Ok (Ppx_rewriter {cookies = []}); + Error + (Loc_error + ({start = {pos_fname = ""; pos_lnum = 1; pos_bol = 0; pos_cnum = 13}; + stop = {pos_fname = ""; pos_lnum = 1; pos_bol = 0; pos_cnum = 61}}, + "'cookies' is only available since version 1.10 of the dune language")); + Error + (Loc_error + ({start = {pos_fname = ""; pos_lnum = 1; pos_bol = 0; pos_cnum = 13}; + stop = {pos_fname = ""; pos_lnum = 1; pos_bol = 0; pos_cnum = 67}}, + "'cookies' is only available since version 1.10 of the dune language")); + Error + (Loc_error + ({start = {pos_fname = ""; pos_lnum = 1; pos_bol = 0; pos_cnum = 14}; + stop = {pos_fname = ""; pos_lnum = 1; pos_bol = 0; pos_cnum = 68}}, + "'cookies' is only available since version 1.10 of the dune language"))] +|}] + +let encode = function + | Error _ -> None + | Ok e -> Some (Lib_kind.encode e) + +let encodes_1_10 = List.map encode decodes_1_10 +[%%expect{| +val encode : (Lib_kind.t, 'a) Stdune.result -> Dune_lang.t option = +val encodes_1_10 : Dune_lang.t option list = + [Some normal; Some ppx_deriver; Some ppx_rewriter; Some ppx_deriver; + Some ppx_rewriter; + Some (ppx_deriver (cookies ("Name with Space" "Value with Space"))); + Some (ppx_deriver (cookies (name1 value1) (name2 value2) (name3 value3))); + Some (ppx_rewriter (cookies (name1 value1) (name2 value2) (name3 value3)))] +|}] + +let encodes_1_9 = List.map encode decodes_1_9 +[%%expect{| +val encodes_1_9 : Dune_lang.t option list = + [Some normal; Some ppx_deriver; Some ppx_rewriter; Some ppx_deriver; + Some ppx_rewriter; None; None; None] +|}] From c52ee1ef92f96fa97326b5c4dd41bfc2b59d9e36 Mon Sep 17 00:00:00 2001 From: Marc Lasson Date: Wed, 8 May 2019 13:04:44 +0200 Subject: [PATCH 4/9] Update CHANGES Signed-off-by: Marc Lasson --- CHANGES.md | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/CHANGES.md b/CHANGES.md index 2c30fd348e2..65ee876bd55 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -28,6 +28,10 @@ unreleased - Allow %{...} variables in pps flags (#2076, @mlasson review by @diml and @aalekseyev). +- Add a 'cookies' option to ppx_rewriter/deriver flags in library stanzas + (#2106, @mlasson @diml). This allow to specify cookie requests from + variables expanded at each invocation of the preprocessor. + - Add more opam metadata and use it to generate `.opam` files. In particular, a `package` field has been added to specify package specific information. (#2017, #2091, @avsm, @jonludlam, @rgrinberg) From eff295ad15375e08e1b9c5e7f3993a7b7b7ab3bc Mon Sep 17 00:00:00 2001 From: Marc Lasson Date: Wed, 8 May 2019 13:15:43 +0200 Subject: [PATCH 5/9] Update doc Signed-off-by: Marc Lasson --- doc/dune-files.rst | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/doc/dune-files.rst b/doc/dune-files.rst index 06b6458292a..0ff7bd33a43 100644 --- a/doc/dune-files.rst +++ b/doc/dune-files.rst @@ -140,7 +140,12 @@ to use the :ref:`include_subdirs` stanza. available choices are ``ppx_rewriter`` and ``ppx_deriver`` and must be set when the library is intended to be used as a ppx rewriter or a ``[@@deriving ...]`` plugin. The reason why ``ppx_rewriter`` and ``ppx_deriver`` are split - is historical and hopefully we won't need two options soon + is historical and hopefully we won't need two options soon. Both ppx kinds + support an optional field ``(cookies )`` where ```` is a + list of pairs ``( )`` with ```` being th cookie name and + ```` is a string that supports `Variables expansion`_ evaluated + by each invocation of the preprocessor (note: libraries that share + cookies with the same name should agree on their expanded value) - ``(ppx_runtime_libraries ())`` is for when the library is a ppx rewriter or a ``[@@deriving ...]`` plugin and has runtime dependencies. You From 40c61fd262704e04d48823a8ae53bd68428a2af5 Mon Sep 17 00:00:00 2001 From: Marc Lasson Date: Wed, 8 May 2019 22:52:57 +0200 Subject: [PATCH 6/9] Forbid cookie name with '=' Signed-off-by: Marc Lasson --- src/lib_kind.ml | 14 +++++++++++--- 1 file changed, 11 insertions(+), 3 deletions(-) diff --git a/src/lib_kind.ml b/src/lib_kind.ml index 0a319465d03..51811009536 100644 --- a/src/lib_kind.ml +++ b/src/lib_kind.ml @@ -9,9 +9,17 @@ module Ppx_args = struct let open Stanza.Decoder in let* () = Syntax.since Stanza.syntax (1, 10) in enter - (let+ name = string - and+ value = String_with_vars.decode in - { name; value }) + ( + let+ name = plain_string + (fun loc str -> + if String.contains str '=' then + Errors.fail loc "Character '=' is not allowed in cookie names" + else + str + ) + and+ value = String_with_vars.decode in + { name; value } + ) let encode { name; value } = let open Dune_lang in From dae0bddc6ebb5f602cb807199b7af2cc6408e011 Mon Sep 17 00:00:00 2001 From: Marc Lasson Date: Thu, 9 May 2019 15:43:56 +0200 Subject: [PATCH 7/9] Implement reviewer's suggestions Signed-off-by: Marc Lasson --- doc/dune-files.rst | 2 +- src/lib_kind.ml | 12 ++-- src/merlin.ml | 4 +- src/preprocessing.ml | 59 ++++++++++--------- src/preprocessing.mli | 3 +- .../test-cases/dune-ppx-driver-system/run.t | 11 ++++ 6 files changed, 52 insertions(+), 39 deletions(-) diff --git a/doc/dune-files.rst b/doc/dune-files.rst index 0ff7bd33a43..21ec92c9e8d 100644 --- a/doc/dune-files.rst +++ b/doc/dune-files.rst @@ -142,7 +142,7 @@ to use the :ref:`include_subdirs` stanza. ...]`` plugin. The reason why ``ppx_rewriter`` and ``ppx_deriver`` are split is historical and hopefully we won't need two options soon. Both ppx kinds support an optional field ``(cookies )`` where ```` is a - list of pairs ``( )`` with ```` being th cookie name and + list of pairs ``( )`` with ```` being the cookie name and ```` is a string that supports `Variables expansion`_ evaluated by each invocation of the preprocessor (note: libraries that share cookies with the same name should agree on their expanded value) diff --git a/src/lib_kind.ml b/src/lib_kind.ml index 51811009536..318dc89b4ed 100644 --- a/src/lib_kind.ml +++ b/src/lib_kind.ml @@ -10,13 +10,13 @@ module Ppx_args = struct let* () = Syntax.since Stanza.syntax (1, 10) in enter ( - let+ name = plain_string - (fun loc str -> - if String.contains str '=' then + let+ name = plain_string + (fun ~loc str -> + if String.contains str '=' then Errors.fail loc "Character '=' is not allowed in cookie names" - else - str - ) + else + str + ) and+ value = String_with_vars.decode in { name; value } ) diff --git a/src/merlin.ml b/src/merlin.ml index 9f40cddd002..cd632fa1b70 100644 --- a/src/merlin.ml +++ b/src/merlin.ml @@ -126,8 +126,8 @@ let pp_flags sctx ~expander ~dir_kind { preprocess; libname; _ } = match Dune_file.Preprocess.remove_future_syntax preprocess (Super_context.context sctx).version with - | Pps { loc = _; pps; flags; staged = _ } -> begin - match Preprocessing.get_ppx_driver sctx ~expander ~lib_name:libname ~flags ~scope ~dir_kind pps with + | Pps { loc; pps; flags; staged = _ } -> begin + match Preprocessing.get_ppx_driver sctx ~loc ~expander ~lib_name:libname ~flags ~scope ~dir_kind pps with | Error _ -> None | Ok (exe, flags) -> (Path.to_absolute_filename exe diff --git a/src/preprocessing.ml b/src/preprocessing.ml index 4099de729e2..08773087144 100644 --- a/src/preprocessing.ml +++ b/src/preprocessing.ml @@ -477,30 +477,22 @@ let get_compat_ppx_exe sctx ~name ~kind = in ppx_exe sctx ~key ~dir_kind:Jbuild -let args_of_cookies cookies = - List.map ~f:(fun (name, value) -> - ["--cookie"; sprintf "%s=%S" name value] - ) cookies |> List.flatten - -let library_name_cookie : Lib_kind.Ppx_args.Cookie.t = - { - name = "library_name"; - value = String_with_vars.make_var Loc.none "library_name" - } let get_cookies ~loc ~expander ~lib_name libs = - let expander = + let expander, library_name_cookie = match lib_name with - | None -> expander - | Some name -> + | None -> expander, None + | Some lib_name -> + let library_name = Lib_name.Local.to_string lib_name in let bindings = Pform.Map.singleton "library_name" - (Values [String (Lib_name.Local.to_string name)]) + (Values [String library_name]) in - Expander.add_bindings expander ~bindings + Expander.add_bindings expander ~bindings, + Some ("library_name", (library_name, Lib_name.of_local (loc, lib_name))) in try Ok (libs - |> List.map ~f: + |> List.concat_map ~f: (fun t -> match Lib.kind t with | Normal -> [] @@ -508,9 +500,13 @@ let get_cookies ~loc ~expander ~lib_name libs = | Ppx_deriver {cookies} -> List.map ~f:(fun {Lib_kind.Ppx_args.Cookie.name; value} -> (name, (Expander.expand_str expander value, Lib.name t))) - (if lib_name = None then cookies else library_name_cookie :: cookies) + cookies ) - |> List.flatten + |> (fun l -> + match library_name_cookie with + | None -> l + | Some cookie -> cookie :: l + ) |> String.Map.of_list_reducei ~f: (fun name ((val1, lib1) as res) (val2, lib2) -> if String.equal val1 val2 then @@ -519,28 +515,33 @@ let get_cookies ~loc ~expander ~lib_name libs = let lib1 = Lib_name.to_string lib1 in let lib2 = Lib_name.to_string lib2 in Errors.fail loc "%a" Fmt.text - (sprintf "%s and %s have inconsistent requests for cookie \"%s\"; \ - %s requests \"%s\" and %s requests \"%s\"" + (sprintf "%s and %s have inconsistent requests for cookie %S; \ + %s requests %S and %s requests %S" lib1 lib2 name lib1 val1 lib2 val2) ) |> String.Map.foldi ~init:[] ~f:(fun name (value, _) acc -> (name, value) :: acc) - |> List.rev) + |> List.rev + |> List.concat_map ~f: + (fun (name, value) -> + ["--cookie"; sprintf "%s=%S" name value] + ) + ) with exn -> Error exn -let ppx_driver_and_flags_internal sctx ~expander ~lib_name ~flags ~dir_kind libs = +let ppx_driver_and_flags_internal sctx ~loc ~expander ~lib_name ~flags ~dir_kind libs = let open Result.O in let flags = List.map ~f:(Expander.expand_str expander) flags in - let+ cookies = get_cookies ~loc:Loc.none ~lib_name ~expander libs in + let+ cookies = get_cookies ~loc ~lib_name ~expander libs in let sctx = SC.host sctx in - ppx_driver_exe sctx libs ~dir_kind, flags @ args_of_cookies cookies + ppx_driver_exe sctx libs ~dir_kind, flags @ cookies let ppx_driver_and_flags sctx ~lib_name ~expander ~scope ~loc ~dir_kind ~flags pps = let open Result.O in let* libs = Lib.DB.resolve_pps (Scope.libs scope) pps in - let* exe, flags = ppx_driver_and_flags_internal sctx ~expander ~lib_name ~flags ~dir_kind libs in + let* exe, flags = ppx_driver_and_flags_internal sctx ~loc ~expander ~lib_name ~flags ~dir_kind libs in let+ driver = match (dir_kind : Dune_lang.File_syntax.t) with | Dune -> @@ -642,7 +643,7 @@ let lint_module sctx ~dir ~expander ~dep_kind ~lint ~lib_name ~scope ~dir_kind = Errors.fail loc "Staged ppx rewriters cannot be used as linters."; let corrected_suffix = ".lint-corrected" in - let driver_flags_and_args = + let driver_and_flags = let open Result.O in let+ (exe, driver, driver_flags) = ppx_driver_and_flags sctx ~expander ~loc ~lib_name ~flags ~dir_kind ~scope pps @@ -666,7 +667,7 @@ let lint_module sctx ~dir ~expander ~dep_kind ~lint ~lib_name ~scope ~dir_kind = ~loc:None (promote_correction ~suffix:corrected_suffix (Option.value_exn (Module.file source kind)) - (Build.of_result_map driver_flags_and_args + (Build.of_result_map driver_and_flags ~f:(fun (exe, flags, args) -> flags >>> Build.run ~dir:(SC.context sctx).build_dir @@ -793,7 +794,7 @@ let pp_modules t ?(lint=true) modules = let pp_module_as t ?(lint=true) name m = Per_module.get t name m ~lint -let get_ppx_driver sctx ~expander ~scope ~lib_name ~flags ~dir_kind pps = +let get_ppx_driver sctx ~loc ~expander ~scope ~lib_name ~flags ~dir_kind pps = let open Result.O in let* libs = Lib.DB.resolve_pps (Scope.libs scope) pps in - ppx_driver_and_flags_internal sctx ~expander ~lib_name ~flags ~dir_kind libs + ppx_driver_and_flags_internal sctx ~loc ~expander ~lib_name ~flags ~dir_kind libs diff --git a/src/preprocessing.mli b/src/preprocessing.mli index 31d83870105..2bcf754e149 100644 --- a/src/preprocessing.mli +++ b/src/preprocessing.mli @@ -41,9 +41,10 @@ val pp_module_as (** Get a path to a cached ppx driver with some extra flags for cookies. *) val get_ppx_driver : Super_context.t + -> loc:Loc.t -> expander:Expander.t -> scope:Scope.t - -> lib_name:Lib_name.Local.t option + -> lib_name:Lib_name.Local.t option -> flags:String_with_vars.t list -> dir_kind:Dune_lang.File_syntax.t -> (Loc.t * Lib_name.t) list 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 957dcfc9e56..1633932e732 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 @@ -35,6 +35,9 @@ Incompatible Cookies $ dune build --root driver-tests foo4.cma Entering directory 'driver-tests' + File "dune", line 27, characters 13-28: + 27 | (preprocess (pps ppx3 ppx4))) + ^^^^^^^^^^^^^^^ Error: foo.ppx3 and foo.ppx4 have inconsistent requests for cookie "germany"; foo.ppx3 requests "spritzgeback" and foo.ppx4 requests "lebkuchen" @@ -111,6 +114,8 @@ Test using installed drivers -arg2 -foo bar + --cookie + library_name="driveruser" -o driveruser.pp.ml --impl @@ -132,6 +137,8 @@ Test using installed drivers -arg2 -foo bar + --cookie + library_name="driveruser" -o driveruser.pp.ml --impl @@ -155,6 +162,8 @@ Test using installed drivers -arg2 -foo bar + --cookie + library_name="driveruser" -o driveruser.pp.ml --impl @@ -199,6 +208,8 @@ Test using installed drivers -arg2 -foo bar + --cookie + library_name="driveruser" -o driveruser.pp.ml --impl From 4551f0f02cbd4fcb52b1a34537689c5d9f95b4f0 Mon Sep 17 00:00:00 2001 From: Marc Lasson Date: Thu, 9 May 2019 17:49:14 +0200 Subject: [PATCH 8/9] Remove lib_kind unit test Signed-off-by: Marc Lasson --- test/unit-tests/dune | 10 ---- test/unit-tests/lib_kind.mlt | 102 ----------------------------------- 2 files changed, 112 deletions(-) delete mode 100644 test/unit-tests/lib_kind.mlt diff --git a/test/unit-tests/dune b/test/unit-tests/dune index 832135b467b..20c11a5e796 100644 --- a/test/unit-tests/dune +++ b/test/unit-tests/dune @@ -120,16 +120,6 @@ (run %{exe:expect_test.exe} %{t}) (diff? %{t} %{t}.corrected))))) -(alias - (name runtest) - (deps (:t lib_kind.mlt) - (glob_files %{project_root}/src/.dune.objs/byte/*.cmi) - (glob_files %{project_root}/src/stdune/.stdune.objs/byte/*.cmi)) - (action (chdir %{project_root} - (progn - (run %{exe:expect_test.exe} %{t}) - (diff? %{t} %{t}.corrected))))) - (alias (name runtest) (deps (:t string.mlt) diff --git a/test/unit-tests/lib_kind.mlt b/test/unit-tests/lib_kind.mlt deleted file mode 100644 index bb9dfd2a8dd..00000000000 --- a/test/unit-tests/lib_kind.mlt +++ /dev/null @@ -1,102 +0,0 @@ -(* -*- tuareg -*- *) -open Dune;; -open! Stdune;; - -let sexp_pp = Dune_lang.pp Dune;; -#install_printer sexp_pp;; - -let decode_string ~version s = - try - Ok (Dune_lang.Decoder.parse Lib_kind.decode (Univ_map.singleton (Syntax.key Stanza.syntax) version) - (Dune_lang.parse_string ~fname:"" ~mode:Dune_lang.Parser.Mode.Single s)) - with exn -> Error exn -[%%expect{| -val sexp_pp : Format.formatter -> Dune_lang.t -> unit = -val decode_string : - version:Syntax.Version.t -> string -> (Lib_kind.t, exn) Stdune.result = - -|}] - -let all_tests = - [ - "normal"; - "ppx_deriver"; - "ppx_rewriter"; - "(ppx_deriver (cookies))"; - "(ppx_rewriter (cookies))"; - "(ppx_deriver (cookies (\"Name with Space\" \"Value with Space\")))"; - "(ppx_deriver (cookies (name1 value1) (name2 value2) (name3 value3)))"; - "(ppx_rewriter (cookies (name1 value1) (name2 value2) (name3 value3)))"; - ] - -let decodes_1_10 = List.map (decode_string ~version:(1,10)) all_tests -[%%expect{| -val all_tests : string list = - ["normal"; "ppx_deriver"; "ppx_rewriter"; "(ppx_deriver (cookies))"; - "(ppx_rewriter (cookies))"; - "(ppx_deriver (cookies (\"Name with Space\" \"Value with Space\")))"; - "(ppx_deriver (cookies (name1 value1) (name2 value2) (name3 value3)))"; - "(ppx_rewriter (cookies (name1 value1) (name2 value2) (name3 value3)))"] -val decodes_1_10 : (Lib_kind.t, exn) Stdune.result list = - [Ok Normal; Ok (Ppx_deriver {cookies = []}); - Ok (Ppx_rewriter {cookies = []}); Ok (Ppx_deriver {cookies = []}); - Ok (Ppx_rewriter {cookies = []}); - Ok (Ppx_deriver {cookies = [{name = "Name with Space"; value = }]}); - Ok - (Ppx_deriver - {cookies = - [{name = "name1"; value = }; - {name = "name2"; value = }; - {name = "name3"; value = }]}); - Ok - (Ppx_rewriter - {cookies = - [{name = "name1"; value = }; - {name = "name2"; value = }; - {name = "name3"; value = }]})] -|}] - -let decodes_1_9 = List.map (decode_string ~version:(1,8)) all_tests -[%%expect{| -val decodes_1_9 : (Lib_kind.t, exn) Stdune.result list = - [Ok Normal; Ok (Ppx_deriver {cookies = []}); - Ok (Ppx_rewriter {cookies = []}); Ok (Ppx_deriver {cookies = []}); - Ok (Ppx_rewriter {cookies = []}); - Error - (Loc_error - ({start = {pos_fname = ""; pos_lnum = 1; pos_bol = 0; pos_cnum = 13}; - stop = {pos_fname = ""; pos_lnum = 1; pos_bol = 0; pos_cnum = 61}}, - "'cookies' is only available since version 1.10 of the dune language")); - Error - (Loc_error - ({start = {pos_fname = ""; pos_lnum = 1; pos_bol = 0; pos_cnum = 13}; - stop = {pos_fname = ""; pos_lnum = 1; pos_bol = 0; pos_cnum = 67}}, - "'cookies' is only available since version 1.10 of the dune language")); - Error - (Loc_error - ({start = {pos_fname = ""; pos_lnum = 1; pos_bol = 0; pos_cnum = 14}; - stop = {pos_fname = ""; pos_lnum = 1; pos_bol = 0; pos_cnum = 68}}, - "'cookies' is only available since version 1.10 of the dune language"))] -|}] - -let encode = function - | Error _ -> None - | Ok e -> Some (Lib_kind.encode e) - -let encodes_1_10 = List.map encode decodes_1_10 -[%%expect{| -val encode : (Lib_kind.t, 'a) Stdune.result -> Dune_lang.t option = -val encodes_1_10 : Dune_lang.t option list = - [Some normal; Some ppx_deriver; Some ppx_rewriter; Some ppx_deriver; - Some ppx_rewriter; - Some (ppx_deriver (cookies ("Name with Space" "Value with Space"))); - Some (ppx_deriver (cookies (name1 value1) (name2 value2) (name3 value3))); - Some (ppx_rewriter (cookies (name1 value1) (name2 value2) (name3 value3)))] -|}] - -let encodes_1_9 = List.map encode decodes_1_9 -[%%expect{| -val encodes_1_9 : Dune_lang.t option list = - [Some normal; Some ppx_deriver; Some ppx_rewriter; Some ppx_deriver; - Some ppx_rewriter; None; None; None] -|}] From 5e6bff48e1a5ffe758e505f5f2065df5c02d5d09 Mon Sep 17 00:00:00 2001 From: Marc Lasson Date: Thu, 9 May 2019 18:36:30 +0200 Subject: [PATCH 9/9] Fix accidental regression Signed-off-by: Marc Lasson --- src/preprocessing.ml | 2 +- .../test-cases/dune-ppx-driver-system/run.t | 14 +++++++------- 2 files changed, 8 insertions(+), 8 deletions(-) diff --git a/src/preprocessing.ml b/src/preprocessing.ml index 08773087144..a03633dd25f 100644 --- a/src/preprocessing.ml +++ b/src/preprocessing.ml @@ -488,7 +488,7 @@ let get_cookies ~loc ~expander ~lib_name libs = (Values [String library_name]) in Expander.add_bindings expander ~bindings, - Some ("library_name", (library_name, Lib_name.of_local (loc, lib_name))) + Some ("library-name", (library_name, Lib_name.of_local (loc, lib_name))) in try Ok (libs 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 1633932e732..587bd0cc27c 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 @@ -78,7 +78,7 @@ Test the argument syntax --cookie italy="Biscotti" --cookie - library_name="test_ppx_args" + library-name="test_ppx_args" -o test_ppx_args.pp.ml --impl @@ -97,10 +97,10 @@ Test that going throught the -ppx option of the compiler works Entering directory 'driver-tests' ocamldep .test_ppx_staged.objs/test_ppx_staged.ml.d tool name: ocamldep - args:--as-ppx -arg1 -arg2 -arg3=Oreo -foo bar Snickerdoodle --cookie france="Petit Beurre" --cookie italy="Biscotti" --cookie library_name="test_ppx_staged" + args:--as-ppx -arg1 -arg2 -arg3=Oreo -foo bar Snickerdoodle --cookie france="Petit Beurre" --cookie italy="Biscotti" --cookie library-name="test_ppx_staged" ocamlc .test_ppx_staged.objs/byte/test_ppx_staged.{cmi,cmo,cmt} tool name: ocamlc - args:--as-ppx -arg1 -arg2 -arg3=Oreo -foo bar Snickerdoodle --cookie france="Petit Beurre" --cookie italy="Biscotti" --cookie library_name="test_ppx_staged" + args:--as-ppx -arg1 -arg2 -arg3=Oreo -foo bar Snickerdoodle --cookie france="Petit Beurre" --cookie italy="Biscotti" --cookie library-name="test_ppx_staged" Test using installed drivers @@ -115,7 +115,7 @@ Test using installed drivers -foo bar --cookie - library_name="driveruser" + library-name="driveruser" -o driveruser.pp.ml --impl @@ -138,7 +138,7 @@ Test using installed drivers -foo bar --cookie - library_name="driveruser" + library-name="driveruser" -o driveruser.pp.ml --impl @@ -163,7 +163,7 @@ Test using installed drivers -foo bar --cookie - library_name="driveruser" + library-name="driveruser" -o driveruser.pp.ml --impl @@ -209,7 +209,7 @@ Test using installed drivers -foo bar --cookie - library_name="driveruser" + library-name="driveruser" -o driveruser.pp.ml --impl