From 2257a2057b61d4801666e996352325bf8816b98f Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Thu, 21 Jun 2018 01:12:53 +0630 Subject: [PATCH 1/2] Add templates to Usexp.t directly Templates are now directly in dune's sexp language. The syntax is change to %{} from ${} and $(). Old templates are still supported in jbuild files. Other changes in this PR: * Removal of ! patterns in variables * Strict expansion for templates in dune files. Missing vars are now an error * Using the correct syntax to parse included files in dune * Improvements to the tests * Syntax aware pretty printing of sexps. Now you must pass Dune vs. Jbuild to print sexps Signed-off-by: Rudi Grinberg --- bin/main.ml | 3 +- doc/project-layout-specification.rst | 27 +++ src/action.ml | 21 +- src/action.mli | 4 +- src/build.ml | 6 +- src/build.mli | 2 +- src/build_system.ml | 6 +- src/configurator/v1.ml | 2 +- src/dep_path.ml | 5 +- src/dune_project.ml | 2 +- src/file_tree.ml | 2 +- src/file_tree.mli | 2 +- src/gen_rules.ml | 7 +- src/install_rules.ml | 2 +- src/jbuild.ml | 17 +- src/loc.ml | 7 +- src/main.ml | 2 +- src/ordered_set_lang.ml | 29 ++- src/ordered_set_lang.mli | 7 +- src/report_error.ml | 4 +- src/stdune/path.ml | 1 + src/stdune/sexp.ml | 17 +- src/stdune/sexp.mli | 9 + src/string_with_vars.ml | 338 +++++++++++++++------------ src/string_with_vars.mli | 34 ++- src/super_context.ml | 70 +++--- src/usexp/atom.ml | 9 +- src/usexp/dune_lexer.mll | 176 ++++++++++++-- src/usexp/escape.ml | 67 ++++++ src/usexp/escape.mli | 4 + src/usexp/import.ml | 26 +++ src/usexp/lexer.mli | 1 + src/usexp/lexer_shared.ml | 1 + src/usexp/lexer_shared.mli | 1 + src/usexp/loc.ml | 18 ++ src/usexp/loc.mli | 8 + src/usexp/sexp.ml | 7 + src/usexp/sexp.mli | 7 + src/usexp/template.ml | 101 ++++++++ src/usexp/template.mli | 30 +++ src/usexp/types.ml | 28 +++ src/usexp/usexp.ml | 168 ++++--------- src/usexp/usexp.mli | 51 ++-- src/vfile_kind.ml | 2 +- test/blackbox-tests/gen_tests.ml | 28 ++- test/unit-tests/action.mlt | 4 +- test/unit-tests/expect_test.mll | 37 ++- test/unit-tests/import_dot_map.mlt | 3 +- test/unit-tests/jbuild.mlt | 30 ++- test/unit-tests/path.mlt | 81 ++++--- test/unit-tests/sexp.mlt | 311 ++++++++++++++++++------ test/unit-tests/sexp_tests.ml | 4 +- test/unit-tests/tests.mlt | 16 +- 53 files changed, 1262 insertions(+), 583 deletions(-) create mode 100644 src/usexp/escape.ml create mode 100644 src/usexp/escape.mli create mode 100644 src/usexp/import.ml create mode 100644 src/usexp/loc.ml create mode 100644 src/usexp/loc.mli create mode 100644 src/usexp/sexp.ml create mode 100644 src/usexp/sexp.mli create mode 100644 src/usexp/template.ml create mode 100644 src/usexp/template.mli create mode 100644 src/usexp/types.ml diff --git a/bin/main.ml b/bin/main.ml index a76e7ccb..d51cd98f 100644 --- a/bin/main.ml +++ b/bin/main.ml @@ -1383,7 +1383,8 @@ let printenv = in Build_system.do_build setup.build_system ~request >>| fun l -> - let pp ppf = Format.fprintf ppf "@[(@,@[%a@]@]@,)" (Format.pp_print_list Sexp.pp) in + let pp ppf = Format.fprintf ppf "@[(@,@[%a@]@]@,)" + (Format.pp_print_list (Sexp.pp Dune)) in match l with | [(_, env)] -> Format.printf "%a@." pp env diff --git a/doc/project-layout-specification.rst b/doc/project-layout-specification.rst index 28bab232..9a0a72c9 100644 --- a/doc/project-layout-specification.rst +++ b/doc/project-layout-specification.rst @@ -62,6 +62,9 @@ special characters. Special characters are: For instance ``hello`` or ``+`` are valid atoms. +Note that backslashes inside atoms have no special meaning are always +interpreted as plain backslashes characters. + Strings ------- @@ -80,6 +83,7 @@ sequences: - ``\xHH``, a backslach followed by two hexidecimal characters to represent the character with ASCII code ``HH`` in hexadecimal - ``\\``, a double backslash to represent a single backslash +- ``\%{`` to represent ``%{`` (see :ref:`variables`) Additionally, a backslash that comes just before the end of the line is used to skip the newline up to the next non-space character. For @@ -137,6 +141,29 @@ descriptions. For instance: (body This is a simple example of using S-expressions)) +.. _variables: + +Variables +--------- + +Dune allows variables in a few places. Their interpretation often +depend on the context in which they appear. + +The syntax of variables is as follow: + +.. code:: + + %{var} + +or, for more complex forms that take an argument: + +.. code:: + + %{fun:arg} + +In order to write a plain ``%{``, you need to write ``\%{`` in a +string. + .. _opam-files: dune-project files diff --git a/src/action.ml b/src/action.ml index ce4f5cba..c0c7586e 100644 --- a/src/action.ml +++ b/src/action.ml @@ -341,8 +341,6 @@ let prog_and_args_of_values p ~dir = | String s :: xs -> (Unresolved.Program.of_string ~dir s, Value.L.to_strings ~dir xs) -module SW = String_with_vars - module Unexpanded = struct module type Uast = Action_intf.Ast with type program = String_with_vars.t @@ -355,7 +353,7 @@ module Unexpanded = struct let t = let open Sexp.Of_sexp in peek raw >>= function - | Atom _ | Quoted_string _ as sexp -> + | Template _ | Atom _ | Quoted_string _ as sexp -> of_sexp_errorf (Sexp.Ast.loc sexp) "if you meant for this to be executed with bash, write (bash \"...\") instead" | List _ -> t @@ -365,7 +363,8 @@ module Unexpanded = struct Loc.fail loc "(mkdir ...) is not supported for paths outside of the workspace:\n\ \ %a\n" - Sexp.pp (List [Sexp.unsafe_atom_of_string "mkdir"; Path.sexp_of_t path]) + (Sexp.pp Dune) + (List [Sexp.unsafe_atom_of_string "mkdir"; Path.sexp_of_t path]) module Partial = struct module Program = Unresolved.Program @@ -450,7 +449,7 @@ module Unexpanded = struct | Left path -> Mkdir path | Right tmpl -> let path = E.path ~dir ~f x in - check_mkdir (SW.loc tmpl) path; + check_mkdir (String_with_vars.loc tmpl) path; Mkdir path end | Digest_files x -> @@ -511,7 +510,7 @@ module Unexpanded = struct | Left dir -> Chdir (res, partial_expand t ~dir ~map_exe ~f) | Right fn -> - let loc = SW.loc fn in + let loc = String_with_vars.loc fn in Loc.fail loc "This directory cannot be evaluated statically.\n\ This is not allowed by jbuilder" @@ -542,7 +541,7 @@ module Unexpanded = struct | Mkdir x -> let res = E.path ~dir ~f x in (match res with - | Left path -> check_mkdir (SW.loc x) path + | Left path -> check_mkdir (String_with_vars.loc x) path | Right _ -> ()); Mkdir res | Digest_files x -> @@ -649,7 +648,8 @@ module Promotion = struct | l -> Io.write_file db_file (String.concat ~sep:"" - (List.map l ~f:(fun x -> Sexp.to_string (File.sexp_of_t x) ^ "\n"))) + (List.map l ~f:(fun x -> + Sexp.to_string ~syntax:Dune (File.sexp_of_t x) ^ "\n"))) end let load_db () = @@ -1062,7 +1062,8 @@ module Infer = struct match fn with | Left fn -> { acc with targets = Path.Set.add acc.targets fn } | Right sw -> - Loc.fail (SW.loc sw) "Cannot determine this target statically." + Loc.fail (String_with_vars.loc sw) + "Cannot determine this target statically." let ( +< ) acc fn = match fn with | Left fn -> { acc with deps = Path.Set.add acc.deps fn } @@ -1095,7 +1096,7 @@ module Infer = struct module Unexp = Make(Unexpanded.Uast)(S_unexp)(Outcome_unexp)(struct open Outcome_unexp let ( +@ ) acc fn = - if SW.is_var fn ~name:"null" then + if String_with_vars.is_var fn ~name:"null" then acc else { acc with targets = fn :: acc.targets } diff --git a/src/action.mli b/src/action.mli index a1612ad1..229fd681 100644 --- a/src/action.mli +++ b/src/action.mli @@ -83,7 +83,7 @@ module Unexpanded : sig : t -> dir:Path.t -> map_exe:(Path.t -> Path.t) - -> f:(Loc.t -> String.t -> Value.t list option) + -> f:(String_with_vars.Var.t -> Value.t list option) -> Unresolved.t end @@ -91,7 +91,7 @@ module Unexpanded : sig : t -> dir:Path.t -> map_exe:(Path.t -> Path.t) - -> f:(Loc.t -> string -> Value.t list option) + -> f:(String_with_vars.Var.t -> Value.t list option) -> Partial.t end diff --git a/src/build.ml b/src/build.ml index 37aa7c24..94310da1 100644 --- a/src/build.ml +++ b/src/build.ml @@ -151,10 +151,12 @@ let strings p = >>^ fun l -> List.map l ~f:Scanf.unescaped -let read_sexp p = +let read_sexp p syntax = contents p >>^ fun s -> - Usexp.parse_string s ~fname:(Path.to_string p) ~mode:Single + Usexp.parse_string s + ~lexer:(File_tree.Dune_file.Kind.lexer syntax) + ~fname:(Path.to_string p) ~mode:Single let if_file_exists p ~then_ ~else_ = If_file_exists (p, ref (Undecided (then_, else_))) diff --git a/src/build.mli b/src/build.mli index 00c57a96..aed438c6 100644 --- a/src/build.mli +++ b/src/build.mli @@ -91,7 +91,7 @@ val lines_of : Path.t -> ('a, string list) t val strings : Path.t -> ('a, string list) t (** Load an S-expression from a file *) -val read_sexp : Path.t -> (unit, Sexp.Ast.t) t +val read_sexp : Path.t -> Usexp.syntax -> (unit, Sexp.Ast.t) t (** Evaluates to [true] if the file is present on the file system or is the target of a rule. *) diff --git a/src/build_system.ml b/src/build_system.ml index 9df2913f..80c8f56f 100644 --- a/src/build_system.ml +++ b/src/build_system.ml @@ -29,7 +29,7 @@ module Promoted_to_delete = struct Io.write_file fn (String.concat ~sep:"" (List.map (Path.Set.to_list db) ~f:(fun p -> - Sexp.to_string (Path.sexp_of_t p) ^ "\n"))) + Sexp.to_string ~syntax:Dune (Path.sexp_of_t p) ^ "\n"))) end let files_in_source_tree_to_delete () = @@ -1226,7 +1226,7 @@ let update_universe t = 0 in make_local_dirs t (Path.Set.singleton Path.build_dir); - Io.write_file universe_file (Sexp.to_string (Sexp.To_sexp.int n)) + Io.write_file universe_file (Sexp.to_string ~syntax:Dune (Sexp.To_sexp.int n)) let do_build t ~request = entry_point t ~f:(fun () -> @@ -1561,7 +1561,7 @@ module Alias = struct let add_action build_system t ~context ?(locks=[]) ~stamp action = let def = get_alias_def build_system t in - def.actions <- { stamp = Digest.string (Sexp.to_string stamp) + def.actions <- { stamp = Digest.string (Sexp.to_string ~syntax:Dune stamp) ; action ; locks ; context diff --git a/src/configurator/v1.ml b/src/configurator/v1.ml index a084c4b8..149d3e78 100644 --- a/src/configurator/v1.ml +++ b/src/configurator/v1.ml @@ -488,7 +488,7 @@ end let write_flags fname s = let path = Path.in_source fname in let sexp = Usexp.List(List.map ~f:Usexp.atom_or_quoted_string s) in - Io.write_file path (Usexp.to_string sexp) + Io.write_file path (Usexp.to_string sexp ~syntax:Dune) let main ?(args=[]) ~name f = let ocamlc = ref ( diff --git a/src/dep_path.ml b/src/dep_path.ml index d93f5b25..6d014424 100644 --- a/src/dep_path.ml +++ b/src/dep_path.ml @@ -14,8 +14,9 @@ module Entry = struct | Library (path, lib_name) -> sprintf "library %S in %s" lib_name (Path.to_string_maybe_quoted path) | Preprocess l -> - Sexp.to_string (List [Sexp.unsafe_atom_of_string "pps"; - Sexp.To_sexp.(list string) l]) + Sexp.to_string ~syntax:Dune + (List [ Sexp.unsafe_atom_of_string "pps" + ; Sexp.To_sexp.(list string) l]) | Loc loc -> Loc.to_file_colon_line loc diff --git a/src/dune_project.ml b/src/dune_project.ml index cfabeb1a..6badd128 100644 --- a/src/dune_project.ml +++ b/src/dune_project.ml @@ -279,7 +279,7 @@ module Extension = struct if not !dune_project_edited then begin dune_project_edited := true; Project_file_edit.append project_file - (Sexp.to_string + (Sexp.to_string ~syntax:Dune (List [ Sexp.atom "using" ; Sexp.atom name ; Sexp.atom (Syntax.Version.to_string version) diff --git a/src/file_tree.ml b/src/file_tree.ml index 043feb9d..50b1b252 100644 --- a/src/file_tree.ml +++ b/src/file_tree.ml @@ -2,7 +2,7 @@ open! Import module Dune_file = struct module Kind = struct - type t = Dune | Jbuild + type t = Usexp.syntax = Jbuild | Dune let of_basename = function | "dune" -> Dune diff --git a/src/file_tree.mli b/src/file_tree.mli index 487bb6ea..f48975db 100644 --- a/src/file_tree.mli +++ b/src/file_tree.mli @@ -4,7 +4,7 @@ open! Import module Dune_file : sig module Kind : sig - type t = Dune | Jbuild + type t = Usexp.syntax = Jbuild | Dune val lexer : t -> Sexp.Lexer.t end diff --git a/src/gen_rules.ml b/src/gen_rules.ml index 0502cb4e..8f9ed8d4 100644 --- a/src/gen_rules.ml +++ b/src/gen_rules.ml @@ -107,9 +107,10 @@ module Gen(P : Install_rules.Params) = struct \nThis will become an error in the future." (let tag = Sexp.unsafe_atom_of_string "modules_without_implementation" in - Sexp.to_string (List [ tag - ; Sexp.To_sexp.(list string) should_be_listed - ])) + Sexp.to_string ~syntax:Dune + (List [ tag + ; Sexp.To_sexp.(list string) should_be_listed + ])) | Some loc -> Loc.warn loc "The following modules must be listed here as they don't \ diff --git a/src/install_rules.ml b/src/install_rules.ml index 789c2c12..3c679e40 100644 --- a/src/install_rules.ml +++ b/src/install_rules.ml @@ -39,7 +39,7 @@ module Gen(P : Install_params) = struct let gen_lib_dune_file lib = SC.add_rule sctx (Build.arr (fun () -> - Format.asprintf "%a@." Sexp.pp + Format.asprintf "%a@." (Sexp.pp Dune) (Lib.Sub_system.dump_config lib |> Installed_dune_file.gen)) >>> Build.write_file_dyn (lib_dune_file ~dir:(Lib.src_dir lib) ~name:(Lib.name lib))) diff --git a/src/jbuild.ml b/src/jbuild.ml index 3b30a999..ef288beb 100644 --- a/src/jbuild.ml +++ b/src/jbuild.ml @@ -191,6 +191,8 @@ module Pps_and_flags = struct let item = peek raw >>= function + | Template { loc; _ } -> + no_templates loc "in the preprocessors field" | Atom _ | Quoted_string _ -> plain_string of_string | List _ -> list string >>| fun l -> Right l @@ -260,7 +262,7 @@ module Dep_conf = struct ] in peek raw >>= function - | Atom _ | Quoted_string _ -> + | Template _ | Atom _ | Quoted_string _ -> String_with_vars.t >>| fun x -> File x | List _ -> t @@ -363,9 +365,7 @@ module Lint = struct let no_lint = default end -let field_oslu name = - field name Ordered_set_lang.Unexpanded.t - ~default:Ordered_set_lang.Unexpanded.standard +let field_oslu name = Ordered_set_lang.Unexpanded.field name module Js_of_ocaml = struct @@ -419,6 +419,7 @@ module Lib_dep = struct ; forbidden ; file } + | Template _ -> no_templates loc "in the select form" | List _ -> of_sexp_errorf loc "(<[!]libraries>... -> ) expected" | (Atom (_, A s) | Quoted_string (_, s)) -> @@ -529,8 +530,7 @@ module Buildable = struct ; allow_overlapping_dependencies : bool } - let modules_field name = - field name Ordered_set_lang.t ~default:Ordered_set_lang.standard + let modules_field name = Ordered_set_lang.field name let t = loc >>= fun loc -> @@ -972,7 +972,8 @@ module Executables = struct let to_install = match Link_mode.Set.best_install_mode t.modes with | None when has_public_name -> - let mode_to_string mode = " - " ^ Sexp.to_string (Link_mode.sexp_of_t mode) in + let mode_to_string mode = + " - " ^ Sexp.to_string ~syntax:Dune (Link_mode.sexp_of_t mode) in let mode_strings = List.map ~f:mode_to_string Link_mode.installable_modes in Loc.fail buildable.loc @@ -1362,7 +1363,7 @@ module Documentation = struct let t = record (Pkg.field >>= fun package -> - field "mld_files" Ordered_set_lang.t ~default:Ordered_set_lang.standard + Ordered_set_lang.field "mld_files" >>= fun mld_files -> return { package diff --git a/src/loc.ml b/src/loc.ml index 28d7a1dc..81b0f470 100644 --- a/src/loc.ml +++ b/src/loc.ml @@ -1,9 +1,6 @@ open Import -type t = Usexp.Loc.t = - { start : Lexing.position - ; stop : Lexing.position - } +include Usexp.Loc (* TODO get rid of all this stuff once this parsing code moves to Usexp and there will be no circular dependency *) @@ -64,8 +61,6 @@ let of_pos (fname, lnum, cnum, enum) = ; stop = { pos with pos_cnum = enum } } -let none = in_file "" - let print ppf { start; stop } = let start_c = start.pos_cnum - start.pos_bol in let stop_c = stop.pos_cnum - start.pos_bol in diff --git a/src/main.ml b/src/main.ml index 56d38f49..33c1f649 100644 --- a/src/main.ml +++ b/src/main.ml @@ -88,7 +88,7 @@ let setup ?(log=Log.no_log) >>= fun contexts -> let contexts = List.concat contexts in List.iter contexts ~f:(fun (ctx : Context.t) -> - Log.infof log "@[<1>Jbuilder context:@,%a@]@." Sexp.pp + Log.infof log "@[<1>Jbuilder context:@,%a@]@." (Sexp.pp Dune) (Context.sexp_of_t ctx)); let rule_done = ref 0 in let rule_total = ref 0 in diff --git a/src/ordered_set_lang.ml b/src/ordered_set_lang.ml index 377adce6..b2e24fa7 100644 --- a/src/ordered_set_lang.ml +++ b/src/ordered_set_lang.ml @@ -15,6 +15,7 @@ end type 'ast generic = { ast : 'ast ; loc : Loc.t option + ; context: Univ_map.t } type ast_expanded = (Loc.t * string, Ast.expanded) Ast.t @@ -24,7 +25,8 @@ let loc t = t.loc let parse_general sexp ~f = let rec of_sexp : Sexp.Ast.t -> _ = function | Atom (loc, A "\\") -> Loc.fail loc "unexpected \\" - | (Atom (_, A "") | Quoted_string (_, _)) as t -> Ast.Element (f t) + | (Atom (_, A "") | Quoted_string (_, _) | Template _ ) as t -> + Ast.Element (f t) | Atom (loc, A s) as t -> if s.[0] = ':' then Special (loc, String.sub s ~pos:1 ~len:(String.length s - 1)) @@ -42,14 +44,17 @@ let parse_general sexp ~f = let t = let open Sexp.Of_sexp in + context >>= fun context -> raw >>| fun sexp -> let ast = parse_general sexp ~f:(function + | Template t -> no_templates t.loc "here" | Atom (loc, A s) | Quoted_string (loc, s) -> (loc, s) | List _ -> assert false) in { ast ; loc = Some (Sexp.Ast.loc sexp) + ; context } let is_standard t = @@ -168,20 +173,24 @@ end let standard = { ast = Ast.Special (Loc.none, "standard") ; loc = None + ; context = Univ_map.empty } +let field ?(default=standard) name = Sexp.Of_sexp.field name t ~default + module Unexpanded = struct type ast = (Sexp.Ast.t, Ast.unexpanded) Ast.t type t = ast generic let t = let open Sexp.Of_sexp in + context >>= fun context -> raw >>| fun sexp -> let rec map (t : (Sexp.Ast.t, Ast.expanded) Ast.t) = let open Ast in match t with | Element x -> Element x | Union [Special (_, "include"); Element fn] -> - Include (Sexp.Of_sexp.parse String_with_vars.t Univ_map.empty fn) + Include (Sexp.Of_sexp.parse String_with_vars.t context fn) | Union [Special (loc, "include"); _] | Special (loc, "include") -> Loc.fail loc "(:include expects a single element (do you need to quote the filename?)" @@ -193,6 +202,7 @@ module Unexpanded = struct in { ast = map (parse_general sexp ~f:(fun x -> x)) ; loc = Some (Sexp.Ast.loc sexp) + ; context } let sexp_of_t t = @@ -225,7 +235,12 @@ module Unexpanded = struct | Diff (l, r) -> loop (loop acc l) r in - loop String.Set.empty t.ast + let syntax = + match Univ_map.find t.context (Syntax.key Stanza.syntax) with + | Some (0, _)-> File_tree.Dune_file.Kind.Jbuild + | None | Some (_, _) -> Dune + in + (syntax, loop String.Set.empty t.ast) let has_special_forms t = let rec loop (t : ast) = @@ -242,12 +257,14 @@ module Unexpanded = struct loop t.ast let expand t ~files_contents ~f = + let context = t.context in let rec expand (t : ast) : ast_expanded = let open Ast in match t with | Element s -> - Element (Sexp.Ast.loc s, - f (Sexp.Of_sexp.parse String_with_vars.t Univ_map.empty s)) + Element ( Sexp.Ast.loc s + , f (Sexp.Of_sexp.parse String_with_vars.t context s) + ) | Special (l, s) -> Special (l, s) | Include fn -> let sexp = @@ -264,7 +281,7 @@ module Unexpanded = struct in parse_general sexp ~f:(fun sexp -> (Sexp.Ast.loc sexp, - f (Sexp.Of_sexp.parse String_with_vars.t Univ_map.empty sexp))) + f (Sexp.Of_sexp.parse String_with_vars.t context sexp))) | Union l -> Union (List.map l ~f:expand) | Diff (l, r) -> Diff (expand l, expand r) diff --git a/src/ordered_set_lang.mli b/src/ordered_set_lang.mli index 1286bccd..189f7013 100644 --- a/src/ordered_set_lang.mli +++ b/src/ordered_set_lang.mli @@ -49,6 +49,8 @@ module Make(Key : Key)(Value : Value with type key = Key.t) val standard : t val is_standard : t -> bool +val field : ?default:t -> string -> t Sexp.Of_sexp.fields_parser + module Unexpanded : sig type expanded = t type t @@ -61,7 +63,10 @@ module Unexpanded : sig val has_special_forms : t -> bool (** List of files needed to expand this set *) - val files : t -> f:(String_with_vars.t -> string) -> String.Set.t + val files + : t + -> f:(String_with_vars.t -> string) + -> Sexp.syntax * String.Set.t (** Expand [t] using with the given file contents. [file_contents] is a map from filenames to their parsed contents. Every [(:include fn)] in [t] is replaced by diff --git a/src/report_error.ml b/src/report_error.ml index e4b9cbc9..8e6dc01b 100644 --- a/src/report_error.ml +++ b/src/report_error.ml @@ -74,8 +74,8 @@ let report_with_backtrace exn = ; pp = fun ppf -> Format.fprintf ppf "@{Internal error, please report upstream \ including the contents of _build/log.@}\n\ - Description: %a\n" - Usexp.pp sexp + Description:%a\n" + (Usexp.pp Dune) sexp } | Unix.Unix_error (err, func, fname) -> { p with pp = fun ppf -> diff --git a/src/stdune/path.ml b/src/stdune/path.ml index 74892c46..1a0664aa 100644 --- a/src/stdune/path.ml +++ b/src/stdune/path.ml @@ -590,6 +590,7 @@ let of_string ?error_loc s = let t = Sexp.Of_sexp.( peek raw >>= function + | Template _ | Atom _ | Quoted_string _ -> (* necessary for old build dirs *) plain_string (fun ~loc:_ s -> of_string s) diff --git a/src/stdune/sexp.ml b/src/stdune/sexp.ml index e945cd85..f32be5b5 100644 --- a/src/stdune/sexp.ml +++ b/src/stdune/sexp.ml @@ -63,6 +63,7 @@ module Of_sexp = struct type ast = Ast.t = | Atom of Loc.t * Atom.t | Quoted_string of Loc.t * string + | Template of Template.t | List of Loc.t * ast list type hint = @@ -76,6 +77,9 @@ module Of_sexp = struct raise (Of_sexp (loc, msg, hint)) let of_sexp_errorf ?hint loc fmt = Printf.ksprintf (fun msg -> of_sexp_error loc ?hint msg) fmt + let no_templates ?hint loc fmt = + Printf.ksprintf (fun msg -> + of_sexp_error loc ?hint ("No variables allowed " ^ msg)) fmt type unparsed_field = { values : Ast.t list @@ -133,6 +137,8 @@ module Of_sexp = struct let get key ctx state = (Univ_map.find (get_user_context ctx) key, state) + let context ctx state = (get_user_context ctx, state) + let set : type a b k. a Univ_map.Key.t -> a -> (b, k) parser -> (b, k) parser = fun key v t ctx state -> match ctx with @@ -236,7 +242,8 @@ module Of_sexp = struct let plain_string f = next (function | Atom (loc, A s) | Quoted_string (loc, s) -> f ~loc s - | List (loc, _) -> of_sexp_error loc "Atom or quoted string expected") + | Template { loc ; _ } | List (loc, _) -> + of_sexp_error loc "Atom or quoted string expected") let enter t = next_with_user_context (fun uc sexp -> @@ -285,7 +292,7 @@ module Of_sexp = struct let basic desc f = next (function - | List (loc, _) | Quoted_string (loc, _) -> + | Template { loc; _ } | List (loc, _) | Quoted_string (loc, _) -> of_sexp_errorf loc "%s expected" desc | Atom (loc, s) -> match f (Atom.to_string s) with @@ -361,13 +368,14 @@ module Of_sexp = struct match sexp with | Atom (loc, A s) -> find_cstr cstrs loc s (Values (loc, Some s, uc)) [] + | Template { loc; _ } | Quoted_string (loc, _) -> of_sexp_error loc "Atom expected" | List (loc, []) -> of_sexp_error loc "Non-empty list expected" | List (loc, name :: args) -> match name with - | Quoted_string (loc, _) | List (loc, _) -> + | Quoted_string (loc, _) | List (loc, _) | Template { loc; _ } -> of_sexp_error loc "Atom expected" | Atom (s_loc, A s) -> find_cstr cstrs s_loc s (Values (loc, Some s, uc)) args) @@ -375,6 +383,7 @@ module Of_sexp = struct let enum cstrs = next (function | Quoted_string (loc, _) + | Template { loc; _ } | List (loc, _) -> of_sexp_error loc "Atom expected" | Atom (loc, A s) -> match List.assoc cstrs s with @@ -496,7 +505,7 @@ module Of_sexp = struct ; entry = sexp ; prev = Name_map.find acc name } - | List (loc, _) | Quoted_string (loc, _) -> + | List (loc, _) | Quoted_string (loc, _) | Template { loc; _ } -> of_sexp_error loc "Atom expected" end | _ -> diff --git a/src/stdune/sexp.mli b/src/stdune/sexp.mli index 643e2aa9..43c8d4cf 100644 --- a/src/stdune/sexp.mli +++ b/src/stdune/sexp.mli @@ -56,6 +56,7 @@ module Of_sexp : sig type ast = Ast.t = | Atom of Loc.t * Atom.t | Quoted_string of Loc.t * string + | Template of Template.t | List of Loc.t * ast list type hint = @@ -111,6 +112,8 @@ module Of_sexp : sig val set : 'a Univ_map.Key.t -> 'a -> ('b, 'k) parser -> ('b, 'k) parser val set_many : Univ_map.t -> ('a, 'k) parser -> ('a, 'k) parser + val context : (Univ_map.t, _) parser + (** Return the location of the list currently being parsed. *) val loc : (Loc.t, _) parser @@ -176,6 +179,12 @@ module Of_sexp : sig -> ('a, unit, string, 'b) format4 -> 'a + val no_templates + : ?hint:hint + -> Loc.t + -> ('a, unit, string, 'b) format4 + -> 'a + val located : 'a t -> (Loc.t * 'a) t val enum : (string * 'a) list -> 'a t diff --git a/src/string_with_vars.ml b/src/string_with_vars.ml index d757ff69..82be3542 100644 --- a/src/string_with_vars.ml +++ b/src/string_with_vars.ml @@ -1,111 +1,130 @@ open! Import -type var_syntax = Parens | Braces +open Usexp.Template -type item = - | Text of string - | Var of var_syntax * string +type t = Usexp.Template.t -type t = - { items : item list - ; loc : Loc.t - ; quoted : bool } +let literal ~quoted ~loc s = + { parts = [Text s] + ; quoted + ; loc + } -module Token = struct - type t = - | String of string - | Open of var_syntax - | Close of var_syntax +(* This module implements the "old" template parsing that is only used in jbuild + files *) +module Jbuild : sig + val parse : string -> loc:Loc.t -> quoted:bool -> t +end = struct + type var_syntax = Parens | Braces + module Token = struct + type t = + | String of string + | Open of var_syntax + | Close of var_syntax - let tokenise s = - let len = String.length s in - let sub i j = String.sub s ~pos:i ~len:(j - i) in - let cons_str i j acc = if i = j then acc else String (sub i j) :: acc in - let rec loop i j = - if j = len - then cons_str i j [] - else - match s.[j] with - | '}' -> cons_str i j (Close Braces :: loop (j + 1) (j + 1)) - | ')' -> cons_str i j (Close Parens :: loop (j + 1) (j + 1)) - | '$' when j + 1 < len -> begin - match s.[j + 1] with - | '{' -> cons_str i j (Open Braces :: loop (j + 2) (j + 2)) - | '(' -> cons_str i j (Open Parens :: loop (j + 2) (j + 2)) - | _ -> loop i (j + 1) - end - | _ -> loop i (j + 1) - in - loop 0 0 + let tokenise s = + let len = String.length s in + let sub i j = String.sub s ~pos:i ~len:(j - i) in + let cons_str i j acc = if i = j then acc else String (sub i j) :: acc in + let rec loop i j = + if j = len + then cons_str i j [] + else + match s.[j] with + | '}' -> cons_str i j (Close Braces :: loop (j + 1) (j + 1)) + | ')' -> cons_str i j (Close Parens :: loop (j + 1) (j + 1)) + | '$' when j + 1 < len -> begin + match s.[j + 1] with + | '{' -> cons_str i j (Open Braces :: loop (j + 2) (j + 2)) + | '(' -> cons_str i j (Open Parens :: loop (j + 2) (j + 2)) + | _ -> loop i (j + 1) + end + | _ -> loop i (j + 1) + in + loop 0 0 - let to_string = function - | String s -> s - | Open Braces -> "${" - | Open Parens -> "$(" - | Close Braces -> "}" - | Close Parens -> ")" + let to_string = function + | String s -> s + | Open Braces -> "${" + | Open Parens -> "$(" + | Close Braces -> "}" + | Close Parens -> ")" + end + (* Remark: Consecutive [Text] items are concatenated. *) + let rec of_tokens + : Loc.t -> Token.t list -> part list = fun loc -> function + | [] -> [] + | Open a :: String s :: Close b :: rest when a = b -> + let (name, payload) = + match String.lsplit2 s ~on:':' with + | None -> (s, None) + | Some (n, p) -> (n, Some p) + in + Var { loc + ; name + ; payload + ; syntax = + begin match a with + | Parens -> Dollar_paren + | Braces -> Dollar_brace + end + } :: of_tokens loc rest + | token :: rest -> + let s = Token.to_string token in + match of_tokens loc rest with + | Text s' :: l -> Text (s ^ s') :: l + | l -> Text s :: l + + let parse s ~loc ~quoted = + { parts = of_tokens loc (Token.tokenise s) + ; loc + ; quoted + } end -(* Remark: Consecutive [Text] items are concatenated. *) -let rec of_tokens : Token.t list -> item list = function - | [] -> [] - | Open a :: String s :: Close b :: rest when a = b -> - Var (a, s) :: of_tokens rest - | token :: rest -> - let s = Token.to_string token in - match of_tokens rest with - | Text s' :: l -> Text (s ^ s') :: l - | l -> Text s :: l - -let items_of_string s = of_tokens (Token.tokenise s) - let t = let open Sexp.Of_sexp in - raw >>| fun sexp -> - match sexp with - | Atom(loc, A s) -> { items = items_of_string s; loc; quoted = false } - | Quoted_string (loc, s) -> - { items = items_of_string s; loc; quoted = true } - | List (loc, _) -> of_sexp_error loc "Atom or quoted string expected" + let jbuild = + raw >>| function + | Template _ as t -> + Exn.code_error "Unexpected dune template from a jbuild file" + [ "t", Usexp.Ast.remove_locs t + ] + | Atom(loc, A s) -> Jbuild.parse s ~loc ~quoted:false + | Quoted_string (loc, s) -> Jbuild.parse s ~loc ~quoted:true + | List (loc, _) -> Sexp.Of_sexp.of_sexp_error loc "Atom expected" + in + let dune = + raw >>| function + | Template t -> t + | Atom(loc, A s) -> literal ~quoted:false ~loc s + | Quoted_string (loc, s) -> literal ~quoted:true ~loc s + | List (loc, _) -> Sexp.Of_sexp.of_sexp_error loc "Unexpected list" + in + Syntax.get_exn Stanza.syntax >>= function + | (0, _) -> jbuild + | (_, _) -> dune let loc t = t.loc let virt ?(quoted=false) pos s = - { items = items_of_string s; loc = Loc.of_pos pos; quoted } + Jbuild.parse ~quoted ~loc:(Loc.of_pos pos) s + let virt_var ?(quoted=false) pos s = - { items = [Var (Braces, s)]; loc = Loc.of_pos pos; quoted } + assert (String.for_all s ~f:(function ':' -> false | _ -> true)); + let loc = Loc.of_pos pos in + { parts = + [Var { payload = None + ; name = s + ; syntax = Percent + ; loc + }] + ; loc + ; quoted + } + let virt_text pos s = - { items = [Text s]; loc = Loc.of_pos pos; quoted = true } - -let sexp_of_var_syntax = function - | Parens -> Sexp.unsafe_atom_of_string "parens" - | Braces -> Sexp.unsafe_atom_of_string "braces" - -let sexp_of_item = - let open Sexp in function - | Text s -> List [Sexp.unsafe_atom_of_string "text" ; - Sexp.atom_or_quoted_string s] - | Var (vs, s) -> List [sexp_of_var_syntax vs ; - Sexp.atom_or_quoted_string s] - -let sexp_of_ast t = Sexp.To_sexp.list sexp_of_item t.items - -let fold t ~init ~f = - List.fold_left t.items ~init ~f:(fun acc item -> - match item with - | Text _ -> acc - | Var (_, v) -> f acc t.loc v) - -let iter t ~f = List.iter t.items ~f:(function - | Text _ -> () - | Var (_, v) -> f t.loc v) - -let vars t = fold t ~init:String.Set.empty ~f:(fun acc _ x -> String.Set.add acc x) - -let string_of_var syntax v = - match syntax with - | Parens -> sprintf "$(%s)" v - | Braces -> sprintf "${%s}" v + { parts = [Text s]; loc = Loc.of_pos pos; quoted = true } let concat_rev = function | [] -> "" @@ -139,74 +158,99 @@ module Partial = struct | Unexpanded of t end -let invalid_multivalue syntax ~var t x = - Loc.fail t.loc "Variable %s expands to %d values, \ +let invalid_multivalue (v : var) x = + Loc.fail v.loc "Variable %s expands to %d values, \ however a single value is expected here. \ Please quote this atom." - (string_of_var syntax var) (List.length x) + (string_of_var v) (List.length x) -let partial_expand t ~mode ~dir ~f = - let commit_text acc_text acc = - let s = concat_rev acc_text in - if s = "" then acc else Text s :: acc - in - let rec loop acc_text acc items = - match items with - | [] -> - begin match acc with - | [] -> Partial.Expanded (Mode.string mode (concat_rev acc_text)) - | _ -> Unexpanded { t with items = List.rev (commit_text acc_text acc) } +module Var = struct + type t = var + + let loc (t : t) = t.loc + + type kind = + | Single of string + | Pair of string * string + + let destruct { loc = _ ; name; payload; syntax = _ } = + match payload with + | None -> Single name + | Some p -> Pair (name, p) + + let full_name t = + match destruct t with + | Single s -> s + | Pair (k, v) -> k ^ ":" ^ v +end + +let partial_expand + : 'a.t + -> mode:'a Mode.t + -> dir:Path.t + -> f:(Var.t -> Value.t list option) + -> 'a Partial.t + = fun t ~mode ~dir ~f -> + let commit_text acc_text acc = + let s = concat_rev acc_text in + if s = "" then acc else Text s :: acc + in + let rec loop acc_text acc items = + match items with + | [] -> + begin match acc with + | [] -> + Partial.Expanded (Mode.string mode (concat_rev acc_text)) + | _ -> + Unexpanded { t with parts = List.rev (commit_text acc_text acc) } + end + | Text s :: items -> loop (s :: acc_text) acc items + | Var var as it :: items -> + begin match f var with + | Some ([] | _::_::_ as e) when not t.quoted -> + invalid_multivalue var e + | Some t -> + loop (Value.L.concat ~dir t :: acc_text) acc items + | None -> loop [] (it :: commit_text acc_text acc) items + end + in + match t.parts with + | [] -> Partial.Expanded (Mode.string mode "") + | [Text s] -> Expanded (Mode.string mode s) + | [Var var] when not t.quoted -> + begin match f var with + | None -> Partial.Unexpanded t + | Some e -> Expanded ( + match Mode.value mode e with + | None -> invalid_multivalue var e + | Some s -> s) end - | Text s :: items -> loop (s :: acc_text) acc items - | Var (syntax, var) as it :: items -> - begin match f syntax t.loc var with - | Some ([] | _::_::_ as e) when not t.quoted -> - invalid_multivalue syntax ~var t e - | Some t -> - loop (Value.L.concat ~dir t :: acc_text) acc items - | None -> loop [] (it :: commit_text acc_text acc) items - end - in - match t.items with - | [] -> Partial.Expanded (Mode.string mode "") - | [Text s] -> Expanded (Mode.string mode s) - | [Var (syntax, v)] when not t.quoted -> - (* Unquoted single var *) - begin match f syntax t.loc v with - | Some e -> Partial.Expanded ( - match Mode.value mode e with - | None -> invalid_multivalue syntax ~var:v t e - | Some s -> s) - | None -> Unexpanded t - end - | _ -> loop [] [] t.items + | _ -> loop [] [] t.parts let expand t ~mode ~dir ~f = match - partial_expand t ~mode ~dir ~f:(fun syntax loc var -> - match f loc var with - | None -> Some [Value.String (string_of_var syntax var)] + partial_expand t ~mode ~dir ~f:(fun var -> + match f var with + | None -> + begin match var.syntax with + | Percent -> + begin match Var.destruct var with + | Single v -> Loc.fail var.loc "unknown variable %S" v + | Pair _ -> Loc.fail var.loc "unknown form %s" (string_of_var var) + end + | Dollar_brace + | Dollar_paren -> Some [Value.String (string_of_var var)] + end | s -> s) with | Partial.Expanded s -> s | Unexpanded _ -> assert false (* we are expanding every variable *) -let partial_expand t ~mode ~dir ~f = - partial_expand t ~mode ~dir ~f:(fun _ loc v -> f loc v) +let partial_expand t ~mode ~dir ~f = partial_expand t ~mode ~dir ~f -let to_string t = - match t.items with - (* [to_string is only called from action.ml, always on [t]s of this form *) - | [Var (syntax, v)] -> string_of_var syntax v - | items -> - List.map items ~f:(function - | Text s -> s - | Var (syntax, v) -> string_of_var syntax v) - |> String.concat ~sep:"" +let sexp_of_t t = Usexp.Template t -let sexp_of_t t = Sexp.To_sexp.string (to_string t) - -let is_var t ~name = - match t.items with - | [Var (_, v)] -> v = name +let is_var { parts ; quoted = _; loc = _ } ~name = + match parts with + | [Var n] -> name = Var.full_name n | _ -> false diff --git a/src/string_with_vars.mli b/src/string_with_vars.mli index f29de007..d10bed68 100644 --- a/src/string_with_vars.mli +++ b/src/string_with_vars.mli @@ -18,12 +18,6 @@ val loc : t -> Loc.t val sexp_of_t : t -> Sexp.t -(** Same as [sexp_of_t] but the S-expression encodes the internal - structure of [t]. *) -val sexp_of_ast : t -> Sexp.t - -val to_string : t -> string - (** [t] generated by the OCaml code. The first argument should be [__POS__]. The second is either a string to parse, a variable name or plain text. [quoted] says whether the string is quoted ([false] @@ -32,17 +26,6 @@ val virt : ?quoted: bool -> (string * int * int * int) -> string -> t val virt_var : ?quoted: bool -> (string * int * int * int) -> string -> t val virt_text : (string * int * int * int) -> string -> t -val vars : t -> String.Set.t -(** [vars t] returns the set of all variables in [t]. *) - -val fold : t -> init:'a -> f:('a -> Loc.t -> string -> 'a) -> 'a -(** [fold t ~init ~f] fold [f] on all variables of [t], the text - portions being ignored. *) - -val iter : t -> f:(Loc.t -> string -> unit) -> unit -(** [iter t ~f] iterates [f] over all variables of [t], the text - portions being ignored. *) - val is_var : t -> name:string -> bool module Mode : sig @@ -57,16 +40,29 @@ module Partial : sig | Unexpanded of t end +module Var : sig + type t + + val loc : t -> Loc.t + val full_name : t -> string + + type kind = + | Single of string + | Pair of string * string + + val destruct : t -> kind +end + val expand : t -> mode:'a Mode.t -> dir:Path.t - -> f:(Loc.t -> string -> Value.t list option) + -> f:(Var.t -> Value.t list option) -> 'a val partial_expand : t -> mode:'a Mode.t -> dir:Path.t - -> f:(Loc.t -> string -> Value.t list option) + -> f:(Var.t -> Value.t list option) -> 'a Partial.t diff --git a/src/super_context.ml b/src/super_context.ml index 7ac6843f..5f883bbe 100644 --- a/src/super_context.ml +++ b/src/super_context.ml @@ -88,7 +88,8 @@ let expand_var_no_root t var = String.Map.find t.vars var let (expand_vars, expand_vars_path) = let expand t ~scope ~dir ?(extra_vars=String.Map.empty) s = - String_with_vars.expand ~mode:Single ~dir s ~f:(fun _loc -> function + String_with_vars.expand ~mode:Single ~dir s ~f:(fun v -> + match String_with_vars.Var.full_name v with | "ROOT" -> Some [Value.Path t.context.build_dir] | "SCOPE_ROOT" -> Some [Value.Path (Scope.root scope)] | var -> @@ -110,7 +111,8 @@ let expand_and_eval_set t ~scope ~dir ?extra_vars set ~standard = let open Build.O in let f = expand_vars t ~scope ~dir ?extra_vars in let parse ~loc:_ s = s in - match Ordered_set_lang.Unexpanded.files set ~f |> String.Set.to_list with + let (syntax, files) = Ordered_set_lang.Unexpanded.files set ~f in + match String.Set.to_list files with | [] -> let set = Ordered_set_lang.Unexpanded.expand set ~files_contents:String.Map.empty ~f @@ -119,7 +121,8 @@ let expand_and_eval_set t ~scope ~dir ?extra_vars set ~standard = Ordered_set_lang.String.eval set ~standard ~parse | files -> let paths = List.map files ~f:(Path.relative dir) in - Build.fanout standard (Build.all (List.map paths ~f:Build.read_sexp)) + Build.fanout standard (Build.all (List.map paths ~f:(fun f -> + Build.read_sexp f syntax))) >>^ fun (standard, sexps) -> let files_contents = List.combine files sexps |> String.Map.of_list_exn in let set = Ordered_set_lang.Unexpanded.expand set ~files_contents ~f in @@ -564,13 +567,6 @@ module Scope_key = struct sprintf "%s@%s" key (Dune_project.Name.encode scope) end -let parse_bang var : bool * string = - let len = String.length var in - if len > 0 && var.[0] = '!' then - (true, String.sub var ~pos:1 ~len:(len - 1)) - else - (false, var) - module Action = struct open Build.O module U = Action.Unexpanded @@ -630,10 +626,13 @@ module Action = struct ; ddeps = String.Map.empty } in - let expand loc key var = function - | Some ("exe" , s) -> Some (path_exp (map_exe (Path.relative dir s))) - | Some ("path" , s) -> Some (path_exp (Path.relative dir s) ) - | Some ("bin" , s) -> begin + let expand var = + let loc = String_with_vars.Var.loc var in + let key = String_with_vars.Var.full_name var in + match String_with_vars.Var.destruct var with + | Pair ("exe" , s) -> Some (path_exp (map_exe (Path.relative dir s))) + | Pair ("path" , s) -> Some (path_exp (Path.relative dir s) ) + | Pair ("bin" , s) -> begin let sctx = host sctx in match Artifacts.binary (artifacts sctx) s with | Ok path -> Some (path_exp path) @@ -642,7 +641,7 @@ module Action = struct end (* "findlib" for compatibility with Jane Street packages which are not yet updated to convert "findlib" to "lib" *) - | Some (("lib"|"findlib"), s) -> begin + | Pair (("lib"|"findlib"), s) -> begin let lib_dep, file = parse_lib_file ~loc s in add_lib_dep acc lib_dep dep_kind; match @@ -651,7 +650,7 @@ module Action = struct | Ok path -> Some (path_exp path) | Error fail -> add_fail acc fail end - | Some ("libexec" , s) -> begin + | Pair ("libexec" , s) -> begin let sctx = host sctx in let lib_dep, file = parse_lib_file ~loc s in add_lib_dep acc lib_dep dep_kind; @@ -672,11 +671,11 @@ module Action = struct add_ddep acc ~key dep end end - | Some ("lib-available", lib) -> + | Pair ("lib-available", lib) -> add_lib_dep acc lib Optional; Some (str_exp (string_of_bool ( Lib.DB.available (Scope.libs scope) lib))) - | Some ("version", s) -> begin + | Pair ("version", s) -> begin match Package.Name.Map.find (Scope.project scope).packages (Package.Name.of_string s) with | Some p -> @@ -691,7 +690,7 @@ module Action = struct Loc.fail loc "Package %S doesn't exist in the current project." s } end - | Some ("read", s) -> begin + | Pair ("read", s) -> begin let path = Path.relative dir s in let data = Build.contents path @@ -699,7 +698,7 @@ module Action = struct in add_ddep acc ~key data end - | Some ("read-lines", s) -> begin + | Pair ("read-lines", s) -> begin let path = Path.relative dir s in let data = Build.lines_of path @@ -707,7 +706,7 @@ module Action = struct in add_ddep acc ~key data end - | Some ("read-strings", s) -> begin + | Pair ("read-strings", s) -> begin let path = Path.relative dir s in let data = Build.strings path @@ -716,17 +715,15 @@ module Action = struct add_ddep acc ~key data end | _ -> - match expand_var_no_root sctx var with + match expand_var_no_root sctx key with | Some _ as x -> x - | None -> String.Map.find extra_vars var + | None -> String.Map.find extra_vars key in let t = - U.partial_expand t ~dir ~map_exe ~f:(fun loc key -> - let has_bang, var = parse_bang key in - if has_bang then - Loc.warn loc "The use of the variable prefix '!' is deprecated, \ - simply use '${%s}'@." var; - match var with + U.partial_expand t ~dir ~map_exe ~f:(fun var -> + let var_name = String_with_vars.Var.full_name var in + let loc = String_with_vars.Var.loc var in + match var_name with | "ROOT" -> Some (path_exp sctx.context.build_dir) | "SCOPE_ROOT" -> Some (path_exp (Scope.root scope)) | "@" -> begin @@ -736,11 +733,11 @@ module Action = struct | Static l -> Some (Value.L.paths l) end | _ -> - match String.lsplit2 var ~on:':' with - | Some ("path-no-dep", s) -> + match String_with_vars.Var.destruct var with + | Pair ("path-no-dep", s) -> Some (path_exp (Path.relative dir s)) - | x -> - let exp = expand loc key var x in + | _ -> + let exp = expand var in Option.iter exp ~f:(fun vs -> acc.sdeps <- Path.Set.union (Path.Set.of_list (Value.L.paths_only vs)) acc.sdeps; @@ -750,12 +747,13 @@ module Action = struct (t, acc) let expand_step2 ~dir ~dynamic_expansions ~deps_written_by_user ~map_exe t = - U.Partial.expand t ~dir ~map_exe ~f:(fun loc key -> + U.Partial.expand t ~dir ~map_exe ~f:(fun var -> + let key = String_with_vars.Var.full_name var in + let loc = String_with_vars.Var.loc var in match String.Map.find dynamic_expansions key with | Some _ as opt -> opt | None -> - let _, var = parse_bang key in - match var with + match key with | "<" -> Some (match deps_written_by_user with diff --git a/src/usexp/atom.ml b/src/usexp/atom.ml index 307857ce..ac823356 100644 --- a/src/usexp/atom.ml +++ b/src/usexp/atom.ml @@ -8,7 +8,14 @@ let is_valid_dune = let rec loop s i len = i = len || match String.unsafe_get s i with - | '%' | '"' | '(' | ')' | ';' | '\000'..'\032' | '\127'..'\255' -> false + | '%' -> after_percent s (i + 1) len + | '"' | '(' | ')' | ';' | '\000'..'\032' | '\127'..'\255' -> false + | _ -> loop s (i + 1) len + and after_percent s i len = + i = len || + match String.unsafe_get s i with + | '%' -> after_percent s (i + 1) len + | '"' | '(' | ')' | ';' | '\000'..'\032' | '\127'..'\255' | '{' -> false | _ -> loop s (i + 1) len in fun s -> diff --git a/src/usexp/dune_lexer.mll b/src/usexp/dune_lexer.mll index 4803c4de..61b471fa 100644 --- a/src/usexp/dune_lexer.mll +++ b/src/usexp/dune_lexer.mll @@ -4,6 +4,91 @@ open Lexer_shared type block_string_line_kind = | With_escape_sequences | Raw + +module Template = struct + include Template + + let dummy_loc = + { Loc. + start = Lexing.dummy_pos + ; stop = Lexing.dummy_pos + } + + let add_text parts s = + match parts with + | Template.Text s' :: parts -> Template.Text (s' ^ s) :: parts + | _ -> Template.Text s :: parts + + let token parts ~quoted ~start (lexbuf : Lexing.lexbuf) = + lexbuf.lex_start_p <- start; + match parts with + | [] | [Text ""] -> + error lexbuf "Internal error in the S-expression parser, \ + please report upstream." + | [Text s] -> + Token.Atom (Atom.of_string s) + | _ -> + Token.Template + { quoted + ; loc = dummy_loc + ; parts = List.rev parts + } + + module Buffer : sig + val new_token : unit -> unit + val get : unit -> Token.t + val add_var : part -> unit + val add_text : string -> unit + val add_text_c : char -> unit + end = struct + type state = + | String + | Template of Template.part list + + let text_buf = Buffer.create 256 + + let new_token () = Buffer.clear text_buf + + let take_buf () = + let contents = Buffer.contents text_buf in + Buffer.clear text_buf; + contents + + let state = ref String + + let add_buf_to_parts parts = + match take_buf () with + | "" -> parts + | t -> add_text parts t + + let get () = + match !state with + | String -> Token.Quoted_string (take_buf ()) + | Template parts -> + state := String; + begin match add_buf_to_parts parts with + | [] -> assert false + | [Text s] -> Quoted_string s + | parts -> + Token.Template + { quoted = true + ; loc = dummy_loc + ; parts = List.rev parts + } + end + + let add_var v = + match !state with + | String -> + state := Template (v :: add_buf_to_parts []); + | Template parts -> + let parts = add_buf_to_parts parts in + state := Template (v::parts) + + let add_text = Buffer.add_string text_buf + let add_text_c = Buffer.add_char text_buf + end +end } let comment = ';' [^ '\n' '\r']* @@ -12,7 +97,8 @@ let blank = [' ' '\t' '\012'] let digit = ['0'-'9'] let hexdigit = ['0'-'9' 'a'-'f' 'A'-'F'] -let atom_char = [^ '%' ';' '(' ')' '"' '\000'-'\032' '\127'-'\255'] +let atom_char = [^ ';' '(' ')' '"' '\000'-'\032' '\127'-'\255'] +let varname_char = atom_char # [ ':' '%' '{' '}' ] rule token = parse | newline @@ -24,17 +110,26 @@ rule token = parse | ')' { Rparen } | '"' - { Buffer.clear escaped_buf; - let start = Lexing.lexeme_start_p lexbuf in - let s = start_quoted_string lexbuf in + { let start = Lexing.lexeme_start_p lexbuf in + Template.Buffer.new_token (); + let token = start_quoted_string lexbuf in lexbuf.lex_start_p <- start; - Quoted_string s + token } - | atom_char+ as s - { Token.Atom (Atom.of_string s) } - | _ as c { error lexbuf (Printf.sprintf "Invalid atom character '%c'" c) } | eof { Eof } + | "" + { atom [] (Lexing.lexeme_start_p lexbuf) lexbuf } + +and atom acc start = parse + | (atom_char # '%')+ as s + { atom (Template.add_text acc s) start lexbuf } + | "%{" + { atom ((template_variable lexbuf) :: acc) start lexbuf } + | "%" + { atom (Template.add_text acc "%") start lexbuf } + | "" + { Template.token acc ~quoted:false ~start lexbuf } and start_quoted_string = parse | "\\|" @@ -47,7 +142,7 @@ and start_quoted_string = parse and block_string_start kind = parse | newline as s { Lexing.new_line lexbuf; - Buffer.add_string escaped_buf s; + Template.Buffer.add_text s; block_string_after_newline lexbuf } | ' ' @@ -56,8 +151,7 @@ and block_string_start kind = parse | Raw -> raw_block_string lexbuf } | eof - { Buffer.contents escaped_buf - } + { Template.Buffer.get () } | _ { error lexbuf "There must be at least one space after \"\\|" } @@ -65,7 +159,7 @@ and block_string_start kind = parse and block_string = parse | newline as s { Lexing.new_line lexbuf; - Buffer.add_string escaped_buf s; + Template.Buffer.add_text s; block_string_after_newline lexbuf } | '\\' @@ -73,12 +167,17 @@ and block_string = parse | Newline -> block_string_after_newline lexbuf | Other -> block_string lexbuf } + | "%{" { + let var = template_variable lexbuf in + Template.Buffer.add_var var; + block_string lexbuf + } | _ as c - { Buffer.add_char escaped_buf c; + { Template.Buffer.add_text_c c; block_string lexbuf } | eof - { Buffer.contents escaped_buf + { Template.Buffer.get () } and block_string_after_newline = parse @@ -87,38 +186,42 @@ and block_string_after_newline = parse | blank* "\"\\>" { block_string_start Raw lexbuf } | "" - { Buffer.contents escaped_buf + { Template.Buffer.get () } and raw_block_string = parse | newline as s { Lexing.new_line lexbuf; - Buffer.add_string escaped_buf s; + Template.Buffer.add_text s; block_string_after_newline lexbuf } | _ as c - { Buffer.add_char escaped_buf c; + { Template.Buffer.add_text_c c; raw_block_string lexbuf } | eof - { Buffer.contents escaped_buf + { Template.Buffer.get () } and quoted_string = parse | '"' - { Buffer.contents escaped_buf } + { Template.Buffer.get () } | '\\' { match escape_sequence lexbuf with | Newline -> quoted_string_after_escaped_newline lexbuf | Other -> quoted_string lexbuf } + | "%{" + { Template.Buffer.add_var (template_variable lexbuf); + quoted_string lexbuf + } | newline as s { Lexing.new_line lexbuf; - Buffer.add_string escaped_buf s; + Template.Buffer.add_text s; quoted_string lexbuf } | _ as c - { Buffer.add_char escaped_buf c; + { Template.Buffer.add_text_c c; quoted_string lexbuf } | eof @@ -129,6 +232,10 @@ and escape_sequence = parse | newline { Lexing.new_line lexbuf; Newline } + | "%{" as s + { Template.Buffer.add_text s; + Other + } | ['\\' '\'' '"' 'n' 't' 'b' 'r'] as c { let c = match c with @@ -138,7 +245,7 @@ and escape_sequence = parse | 't' -> '\t' | _ -> c in - Buffer.add_char escaped_buf c; + Template.Buffer.add_text_c c; Other } | (digit as c1) (digit as c2) (digit as c3) @@ -146,7 +253,7 @@ and escape_sequence = parse if v > 255 then error lexbuf "escape sequence in quoted string out of range" ~delta:(-1); - Buffer.add_char escaped_buf (Char.chr v); + Template.Buffer.add_text_c (Char.chr v); Other } | digit digit digit @@ -157,7 +264,7 @@ and escape_sequence = parse } | 'x' (hexdigit as c1) (hexdigit as c2) { let v = eval_hex_escape c1 c2 in - Buffer.add_char escaped_buf (Char.chr v); + Template.Buffer.add_text_c (Char.chr v); Other } | 'x' hexdigit* @@ -173,3 +280,24 @@ and escape_sequence = parse and quoted_string_after_escaped_newline = parse | [' ' '\t']* { quoted_string lexbuf } + +and template_variable = parse + | (varname_char+ as name) (':' (varname_char* as payload))? '}' + { let payload = + match payload with + | Some "" -> error lexbuf "payload after : in variable cannot be empty" + | p -> p + in + Template.Var + { loc = + { start = Lexing.lexeme_start_p lexbuf + ; stop = Lexing.lexeme_end_p lexbuf + } + ; name + ; payload + ; syntax = Percent + } + } + | '}' | eof + { error lexbuf "%{...} forms cannot be empty" } + | _ { error lexbuf "This character not allowed inside %{...} forms" } diff --git a/src/usexp/escape.ml b/src/usexp/escape.ml new file mode 100644 index 00000000..f2753dee --- /dev/null +++ b/src/usexp/escape.ml @@ -0,0 +1,67 @@ +open Import + +let quote_length s ~syntax = + let n = ref 0 in + let len = String.length s in + for i = 0 to len - 1 do + n := !n + (match String.unsafe_get s i with + | '\"' | '\\' | '\n' | '\t' | '\r' | '\b' -> 2 + | '%' -> + if syntax = Atom.Dune && i + 1 < len && s.[i+1] = '{' then 2 else 1 + | ' ' .. '~' -> 1 + | _ -> 4) + done; + !n + +let escape_to s ~dst:s' ~ofs ~syntax = + let n = ref ofs in + let len = String.length s in + for i = 0 to len - 1 do + begin match String.unsafe_get s i with + | ('\"' | '\\') as c -> + Bytes.unsafe_set s' !n '\\'; incr n; Bytes.unsafe_set s' !n c + | '\n' -> + Bytes.unsafe_set s' !n '\\'; incr n; Bytes.unsafe_set s' !n 'n' + | '\t' -> + Bytes.unsafe_set s' !n '\\'; incr n; Bytes.unsafe_set s' !n 't' + | '\r' -> + Bytes.unsafe_set s' !n '\\'; incr n; Bytes.unsafe_set s' !n 'r' + | '\b' -> + Bytes.unsafe_set s' !n '\\'; incr n; Bytes.unsafe_set s' !n 'b' + | '%' when syntax = Atom.Dune && i + 1 < len && s.[i + 1] = '{' -> + Bytes.unsafe_set s' !n '\\'; incr n; Bytes.unsafe_set s' !n '%' + | (' ' .. '~') as c -> Bytes.unsafe_set s' !n c + | c -> + let a = Char.code c in + Bytes.unsafe_set s' !n '\\'; + incr n; + Bytes.unsafe_set s' !n (Char.unsafe_chr (48 + a / 100)); + incr n; + Bytes.unsafe_set s' !n (Char.unsafe_chr (48 + (a / 10) mod 10)); + incr n; + Bytes.unsafe_set s' !n (Char.unsafe_chr (48 + a mod 10)); + end; + incr n + done + +(* Escape [s] if needed. *) +let escaped s ~syntax = + let n = quote_length s ~syntax in + if n = 0 || n > String.length s then + let s' = Bytes.create n in + escape_to s ~dst:s' ~ofs:0 ~syntax; + Bytes.unsafe_to_string s' + else s + +(* Surround [s] with quotes, escaping it if necessary. *) +let quoted s ~syntax = + let len = String.length s in + let n = quote_length s ~syntax in + let s' = Bytes.create (n + 2) in + Bytes.unsafe_set s' 0 '"'; + if len = 0 || n > len then + escape_to s ~dst:s' ~ofs:1 ~syntax + else + Bytes.blit_string ~src:s ~src_pos:0 ~dst:s' ~dst_pos:1 ~len; + Bytes.unsafe_set s' (n + 1) '"'; + Bytes.unsafe_to_string s' diff --git a/src/usexp/escape.mli b/src/usexp/escape.mli new file mode 100644 index 00000000..4091acf4 --- /dev/null +++ b/src/usexp/escape.mli @@ -0,0 +1,4 @@ + +val escaped : string -> syntax:Atom.syntax -> string + +val quoted : string -> syntax:Atom.syntax -> string diff --git a/src/usexp/import.ml b/src/usexp/import.ml new file mode 100644 index 00000000..32e337e0 --- /dev/null +++ b/src/usexp/import.ml @@ -0,0 +1,26 @@ +(* TODO get rid of this when inverting the deps between stdune and usexp *) + +module List = ListLabels +module String = struct + include StdLabels.String + + let split_on_char s ~on = + let rec loop i j = + if j = length s then + [sub s ~pos:i ~len:(j - i)] + else if s.[j] = on then + sub s ~pos:i ~len:(j - i) :: loop (j + 1) (j + 1) + else + loop i (j + 1) + in + loop 0 0 +end + +module Bytes = struct + include StdLabels.Bytes + + (* [blit_string] was forgotten from the labeled version in OCaml + 4.02—4.04. *) + let blit_string ~src ~src_pos ~dst ~dst_pos ~len = + Bytes.blit_string src src_pos dst dst_pos len +end diff --git a/src/usexp/lexer.mli b/src/usexp/lexer.mli index 22407e45..24064cbb 100644 --- a/src/usexp/lexer.mli +++ b/src/usexp/lexer.mli @@ -6,6 +6,7 @@ module Token : sig | Rparen | Sexp_comment | Eof + | Template of Template.t end type t = Lexing.lexbuf -> Token.t diff --git a/src/usexp/lexer_shared.ml b/src/usexp/lexer_shared.ml index ee1cf5ba..f87e90b3 100644 --- a/src/usexp/lexer_shared.ml +++ b/src/usexp/lexer_shared.ml @@ -6,6 +6,7 @@ module Token = struct | Rparen | Sexp_comment | Eof + | Template of Template.t end type t = Lexing.lexbuf -> Token.t diff --git a/src/usexp/lexer_shared.mli b/src/usexp/lexer_shared.mli index b442888d..c065be1c 100644 --- a/src/usexp/lexer_shared.mli +++ b/src/usexp/lexer_shared.mli @@ -6,6 +6,7 @@ module Token : sig | Rparen | Sexp_comment | Eof + | Template of Template.t end type t = Lexing.lexbuf -> Token.t diff --git a/src/usexp/loc.ml b/src/usexp/loc.ml new file mode 100644 index 00000000..d7ac4844 --- /dev/null +++ b/src/usexp/loc.ml @@ -0,0 +1,18 @@ +type t = + { start : Lexing.position + ; stop : Lexing.position + } + +let in_file fn = + let pos : Lexing.position = + { pos_fname = fn + ; pos_lnum = 1 + ; pos_cnum = 0 + ; pos_bol = 0 + } + in + { start = pos + ; stop = pos + } + +let none = in_file "" diff --git a/src/usexp/loc.mli b/src/usexp/loc.mli new file mode 100644 index 00000000..514f3a68 --- /dev/null +++ b/src/usexp/loc.mli @@ -0,0 +1,8 @@ +type t = + { start : Lexing.position + ; stop : Lexing.position + } + +val in_file : string -> t + +val none : t diff --git a/src/usexp/sexp.ml b/src/usexp/sexp.ml new file mode 100644 index 00000000..f8cbb38c --- /dev/null +++ b/src/usexp/sexp.ml @@ -0,0 +1,7 @@ +include Types.Sexp + +let atom_or_quoted_string s = + if Atom.is_valid_dune s then + Atom (Atom.of_string s) + else + Quoted_string s diff --git a/src/usexp/sexp.mli b/src/usexp/sexp.mli new file mode 100644 index 00000000..94c45ca5 --- /dev/null +++ b/src/usexp/sexp.mli @@ -0,0 +1,7 @@ +type t = Types.Sexp.t = + | Atom of Atom.t + | Quoted_string of string + | List of t list + | Template of Types.Template.t + +val atom_or_quoted_string : string -> t diff --git a/src/usexp/template.ml b/src/usexp/template.ml new file mode 100644 index 00000000..01b43d56 --- /dev/null +++ b/src/usexp/template.ml @@ -0,0 +1,101 @@ +open Import + +include Types.Template + +let var_enclosers = function + | Percent -> "%{", "}" + | Dollar_brace -> "${", "}" + | Dollar_paren -> "$(", ")" + +module Pp : sig + val to_string : t -> syntax:Atom.syntax -> string +end = struct + let buf = Buffer.create 16 + + let add_var { loc = _; syntax; name; payload } = + let before, after = var_enclosers syntax in + Buffer.add_string buf before; + Buffer.add_string buf name; + begin match payload with + | None -> () + | Some payload -> + Buffer.add_char buf ':'; + Buffer.add_string buf payload + end; + Buffer.add_string buf after + + (* TODO use the loc for the error *) + let check_valid_unquoted s ~syntax ~loc:_ = + if not (Atom.is_valid (Atom.of_string s) syntax) then + Printf.ksprintf invalid_arg "Invalid text %S in unquoted template" s + + let to_string { parts; quoted; loc } ~syntax = + Buffer.clear buf; + if quoted then Buffer.add_char buf '"'; + let commit_text s = + if s = "" then + () + else if not quoted then begin + check_valid_unquoted ~loc ~syntax s; + Buffer.add_string buf s + end else + Buffer.add_string buf (Escape.escaped ~syntax s) + in + let rec add_parts acc_text = function + | [] -> + commit_text acc_text + | Text s :: rest -> + add_parts (if acc_text = "" then s else acc_text ^ s) rest + | Var v :: rest -> + commit_text acc_text; + add_var v; + add_parts "" rest + in + add_parts "" parts; + if quoted then Buffer.add_char buf '"'; + Buffer.contents buf +end + +let to_string = Pp.to_string + +let string_of_var { loc = _; syntax; name; payload } = + let before, after = var_enclosers syntax in + match payload with + | None -> before ^ name ^ after + | Some p -> before ^ name ^ ":" ^ p ^ after + +let pp syntax ppf t = + Format.pp_print_string ppf (Pp.to_string ~syntax t) + +let pp_split_strings ppf (t : t) = + let syntax = Atom.Dune in + if t.quoted || List.exists t.parts ~f:(function + | Text s -> String.contains s '\n' + | Var _ -> false) then begin + List.iter t.parts ~f:(function + | Var s -> + Format.pp_print_string ppf (string_of_var s) + | Text s -> + begin match String.split_on_char s ~on:'\n' with + | [] -> assert false + | [s] -> Format.pp_print_string ppf (Escape.escaped ~syntax s) + | split -> + Format.pp_print_list + ~pp_sep:(fun ppf () -> Format.fprintf ppf "@,\\n") + Format.pp_print_string ppf + split + end + ); + Format.fprintf ppf "@}\"@]" + end + else + pp syntax ppf t + +let remove_locs t = + { t with + loc = Loc.none + ; parts = + List.map t.parts ~f:(function + | Var v -> Var { v with loc = Loc.none } + | Text _ as s -> s) + } diff --git a/src/usexp/template.mli b/src/usexp/template.mli new file mode 100644 index 00000000..92f44a89 --- /dev/null +++ b/src/usexp/template.mli @@ -0,0 +1,30 @@ +type var_syntax = Types.Template.var_syntax = + | Dollar_brace + | Dollar_paren + | Percent + +type var = Types.Template.var = + { loc: Loc.t + ; name: string + ; payload: string option + ; syntax: var_syntax + } + +type part = Types.Template.part = + | Text of string + | Var of var + +type t = Types.Template.t = + { quoted: bool + ; parts: part list + ; loc: Loc.t + } + +val to_string : t -> syntax:Atom.syntax -> string +val string_of_var : var -> string + +val pp : Atom.syntax -> Format.formatter -> t -> unit + +val pp_split_strings : Format.formatter -> t -> unit + +val remove_locs : t -> t diff --git a/src/usexp/types.ml b/src/usexp/types.ml new file mode 100644 index 00000000..cbfc06d1 --- /dev/null +++ b/src/usexp/types.ml @@ -0,0 +1,28 @@ +module Template = struct + type var_syntax = Dollar_brace | Dollar_paren | Percent + + type var = + { loc: Loc.t + ; name: string + ; payload: string option + ; syntax: var_syntax + } + + type part = + | Text of string + | Var of var + + type t = + { quoted: bool + ; parts: part list + ; loc: Loc.t + } +end + +module Sexp = struct + type t = + | Atom of Atom.t + | Quoted_string of string + | List of t list + | Template of Template.t +end diff --git a/src/usexp/usexp.ml b/src/usexp/usexp.ml index e7d4a1e1..3681098a 100644 --- a/src/usexp/usexp.ml +++ b/src/usexp/usexp.ml @@ -1,140 +1,59 @@ -module UnlabeledBytes = Bytes -open StdLabels - -module Bytes = struct - include StdLabels.Bytes - - (* [blit_string] was forgotten from the labeled version in OCaml - 4.02—4.04. *) - let blit_string ~src ~src_pos ~dst ~dst_pos ~len = - UnlabeledBytes.blit_string src src_pos dst dst_pos len -end +open Import +module Loc = Loc module Atom = Atom +module Template = Template -type t = - | Atom of Atom.t - | Quoted_string of string - | List of t list +type syntax = Atom.syntax = Jbuild | Dune -type sexp = t +include Sexp let atom s = Atom (Atom.of_string s) let unsafe_atom_of_string s = atom s -let atom_or_quoted_string s = - if Atom.is_valid_dune s then - Atom (Atom.of_string s) - else - Quoted_string s +let rec to_string t ~syntax = + match t with + | Atom a -> Atom.print a syntax + | Quoted_string s -> Escape.quoted s ~syntax + | List l -> + Printf.sprintf "(%s)" (List.map l ~f:(to_string ~syntax) + |> String.concat ~sep:" ") + | Template t -> Template.to_string t ~syntax -let quote_length s = - let n = ref 0 in - for i = 0 to String.length s - 1 do - n := !n + (match String.unsafe_get s i with - | '\"' | '\\' | '\n' | '\t' | '\r' | '\b' -> 2 - | ' ' .. '~' -> 1 - | _ -> 4) - done; - !n - -let escape_to s ~dst:s' ~ofs = - let n = ref ofs in - for i = 0 to String.length s - 1 do - begin match String.unsafe_get s i with - | ('\"' | '\\') as c -> - Bytes.unsafe_set s' !n '\\'; incr n; Bytes.unsafe_set s' !n c - | '\n' -> - Bytes.unsafe_set s' !n '\\'; incr n; Bytes.unsafe_set s' !n 'n' - | '\t' -> - Bytes.unsafe_set s' !n '\\'; incr n; Bytes.unsafe_set s' !n 't' - | '\r' -> - Bytes.unsafe_set s' !n '\\'; incr n; Bytes.unsafe_set s' !n 'r' - | '\b' -> - Bytes.unsafe_set s' !n '\\'; incr n; Bytes.unsafe_set s' !n 'b' - | (' ' .. '~') as c -> Bytes.unsafe_set s' !n c - | c -> - let a = Char.code c in - Bytes.unsafe_set s' !n '\\'; - incr n; - Bytes.unsafe_set s' !n (Char.unsafe_chr (48 + a / 100)); - incr n; - Bytes.unsafe_set s' !n (Char.unsafe_chr (48 + (a / 10) mod 10)); - incr n; - Bytes.unsafe_set s' !n (Char.unsafe_chr (48 + a mod 10)); - end; - incr n - done - -(* Escape [s] if needed. *) -let escaped s = - let n = quote_length s in - if n = 0 || n > String.length s then - let s' = Bytes.create n in - escape_to s ~dst:s' ~ofs:0; - Bytes.unsafe_to_string s' - else s - -(* Surround [s] with quotes, escaping it if necessary. *) -let quoted s = - let len = String.length s in - let n = quote_length s in - let s' = Bytes.create (n + 2) in - Bytes.unsafe_set s' 0 '"'; - if len = 0 || n > len then - escape_to s ~dst:s' ~ofs:1 - else - Bytes.blit_string ~src:s ~src_pos:0 ~dst:s' ~dst_pos:1 ~len; - Bytes.unsafe_set s' (n + 1) '"'; - Bytes.unsafe_to_string s' - -let rec to_string = function - | Atom a -> Atom.print a Atom.Dune - | Quoted_string s -> quoted s - | List l -> Printf.sprintf "(%s)" (List.map l ~f:to_string |> String.concat ~sep:" ") - -let rec pp ppf = function +let rec pp syntax ppf = function | Atom s -> - Format.pp_print_string ppf (Atom.print s Atom.Dune) + Format.pp_print_string ppf (Atom.print s syntax) | Quoted_string s -> - Format.pp_print_string ppf (quoted s) + Format.pp_print_string ppf (Escape.quoted ~syntax s) | List [] -> Format.pp_print_string ppf "()" | List (first :: rest) -> Format.pp_open_box ppf 1; Format.pp_print_string ppf "("; Format.pp_open_hvbox ppf 0; - pp ppf first; + pp syntax ppf first; List.iter rest ~f:(fun sexp -> Format.pp_print_space ppf (); - pp ppf sexp); + pp syntax ppf sexp); Format.pp_close_box ppf (); Format.pp_print_string ppf ")"; Format.pp_close_box ppf () - -let split_string s ~on = - let rec loop i j = - if j = String.length s then - [String.sub s ~pos:i ~len:(j - i)] - else if s.[j] = on then - String.sub s ~pos:i ~len:(j - i) :: loop (j + 1) (j + 1) - else - loop i (j + 1) - in - loop 0 0 + | Template t -> Template.pp syntax ppf t let pp_print_quoted_string ppf s = + let syntax = Dune in if String.contains s '\n' then begin - match split_string s ~on:'\n' with - | [] -> Format.pp_print_string ppf (quoted s) + match String.split_on_char s ~on:'\n' with + | [] -> Format.pp_print_string ppf (Escape.quoted ~syntax s) | first :: rest -> - Format.fprintf ppf "@[\"@{%s" (escaped first); + Format.fprintf ppf "@[\"@{%s" + (Escape.escaped ~syntax first); List.iter rest ~f:(fun s -> - Format.fprintf ppf "@,\\n%s" (escaped s)); + Format.fprintf ppf "@,\\n%s" (Escape.escaped ~syntax s)); Format.fprintf ppf "@}\"@]" end else - Format.pp_print_string ppf (quoted s) + Format.pp_print_string ppf (Escape.quoted ~syntax s) let rec pp_split_strings ppf = function | Atom s -> Format.pp_print_string ppf (Atom.print s Atom.Dune) @@ -152,6 +71,7 @@ let rec pp_split_strings ppf = function Format.pp_close_box ppf (); Format.pp_print_string ppf ")"; Format.pp_close_box ppf () + | Template t -> Template.pp_split_strings ppf t type formatter_state = | In_atom @@ -196,40 +116,26 @@ let prepare_formatter ppf = | _ -> n)) } -module Loc = struct - type t = - { start : Lexing.position - ; stop : Lexing.position - } - - let in_file fn = - let pos : Lexing.position = - { pos_fname = fn - ; pos_lnum = 1 - ; pos_cnum = 0 - ; pos_bol = 0 - } - in - { start = pos - ; stop = pos - } -end - module Ast = struct type t = | Atom of Loc.t * Atom.t | Quoted_string of Loc.t * string + | Template of Template.t | List of Loc.t * t list let atom_or_quoted_string loc s = - match atom_or_quoted_string s with + match Sexp.atom_or_quoted_string s with | Atom a -> Atom (loc, a) | Quoted_string s -> Quoted_string (loc, s) + | Template _ | List _ -> assert false - let loc (Atom (loc, _) | Quoted_string (loc, _) | List (loc, _)) = loc + let loc (Atom (loc, _) | Quoted_string (loc, _) | List (loc, _) + | Template { loc ; _ }) = loc - let rec remove_locs : t -> sexp = function + let rec remove_locs t : Sexp.t = + match t with + | Template t -> Template (Template.remove_locs t) | Atom (_, s) -> Atom s | Quoted_string (_, s) -> Quoted_string s | List (_, l) -> List (List.map l ~f:remove_locs) @@ -240,6 +146,7 @@ let rec add_loc t ~loc : Ast.t = | Atom s -> Atom (loc, s) | Quoted_string s -> Quoted_string (loc, s) | List l -> List (loc, List.map l ~f:(add_loc ~loc)) + | Template t -> Template { t with loc } module Parse_error = struct include Lexer.Error @@ -298,6 +205,9 @@ module Parser = struct | Quoted_string s -> let loc = make_loc lexbuf in loop depth lexer lexbuf (Quoted_string (loc, s) :: acc) + | Template t -> + let loc = make_loc lexbuf in + loop depth lexer lexbuf (Template { t with loc } :: acc) | Lparen -> let start = Lexing.lexeme_start_p lexbuf in let sexps = loop (depth + 1) lexer lexbuf [] in diff --git a/src/usexp/usexp.mli b/src/usexp/usexp.mli index 79792ced..f6c55388 100644 --- a/src/usexp/usexp.mli +++ b/src/usexp/usexp.mli @@ -2,11 +2,11 @@ This library is internal to jbuilder and guarantees no API stability.*) +type syntax = Jbuild | Dune + module Atom : sig type t = private A of string [@@unboxed] - type syntax = Jbuild | Dune - val is_valid : t -> syntax -> bool val of_string : string -> t @@ -26,6 +26,31 @@ module Loc : sig } val in_file : string -> t + + val none : t +end + +module Template : sig + type var_syntax = Dollar_brace | Dollar_paren | Percent + + type var = + { loc: Loc.t + ; name: string + ; payload: string option + ; syntax: var_syntax + } + + type part = + | Text of string + | Var of var + + type t = + { quoted: bool + ; parts: part list + ; loc: Loc.t + } + + val string_of_var : var -> string end (** The S-expression type *) @@ -33,6 +58,7 @@ type t = | Atom of Atom.t | Quoted_string of string | List of t list + | Template of Template.t val atom : string -> t (** [atom s] convert the string [s] to an Atom. @@ -43,13 +69,13 @@ val atom_or_quoted_string : string -> t val unsafe_atom_of_string : string -> t (** Serialize a S-expression *) -val to_string : t -> string +val to_string : t -> syntax:syntax -> string (** Serialize a S-expression using indentation to improve readability *) -val pp : Format.formatter -> t -> unit +val pp : syntax -> Format.formatter -> t -> unit -(** Same as [pp], but split long strings. The formatter must have been - prepared with [prepare_formatter]. *) +(** Same as [pp ~syntax:Dune], but split long strings. The formatter + must have been prepared with [prepare_formatter]. *) val pp_split_strings : Format.formatter -> t -> unit (** Prepare a formatter for [pp_split_strings]. Additionaly the @@ -63,6 +89,7 @@ module Ast : sig type t = | Atom of Loc.t * Atom.t | Quoted_string of Loc.t * string + | Template of Template.t | List of Loc.t * t list val atom_or_quoted_string : Loc.t -> string -> t @@ -85,17 +112,7 @@ end exception Parse_error of Parse_error.t module Lexer : sig - module Token : sig - type t = - | Atom of Atom.t - | Quoted_string of string - | Lparen - | Rparen - | Sexp_comment (** "#;", only used in the jbuild syntax *) - | Eof - end - - type t = Lexing.lexbuf -> Token.t + type t val token : t val jbuild_token : t diff --git a/src/vfile_kind.ml b/src/vfile_kind.ml index a8ba2a26..b6b6dbea 100644 --- a/src/vfile_kind.ml +++ b/src/vfile_kind.ml @@ -52,7 +52,7 @@ struct let id = Id.create () - let to_string path x = To_sexp.t path x |> Sexp.to_string + let to_string path x = To_sexp.t path x |> Sexp.to_string ~syntax:Dune let load path = Of_sexp.t path (Io.Sexp.load path ~mode:Single) diff --git a/test/blackbox-tests/gen_tests.ml b/test/blackbox-tests/gen_tests.ml index d290b2c2..280d06c3 100644 --- a/test/blackbox-tests/gen_tests.ml +++ b/test/blackbox-tests/gen_tests.ml @@ -12,6 +12,10 @@ module Sexp = struct let constr name args = Usexp.List (Usexp.atom name :: args) + + let parse s = + Usexp.parse_string ~fname:"gen_tests.ml" ~mode:Single s + |> Usexp.Ast.remove_locs end let alias ?action name ~deps = @@ -26,7 +30,7 @@ let alias ?action name ~deps = module Test = struct type t = { name : string - ; env : (string * string) option + ; env : (string * Usexp.t) option ; skip_ocaml : string option ; skip_platforms : Platform.t list ; enabled : bool @@ -59,10 +63,13 @@ module Test = struct ; atom (sprintf "test-cases/%s" t.name) ; List [ atom "progn" - ; Sexp.strings (["run"; "${exe:cram.exe}"] - @ skip_version - @ skip_platforms - @ ["-test"; "run.t"]) + ; Usexp.List + ([ atom "run" + ; Sexp.parse "%{exe:cram.exe}" ] + @ (List.map ~f:Usexp.atom_or_quoted_string + (skip_version + @ skip_platforms + @ ["-test"; "run.t"]))) ; Sexp.strings ["diff?"; "run.t"; "run.t.corrected"] ] @@ -74,7 +81,7 @@ module Test = struct | Some (k, v) -> List [ atom "setenv" ; atom_or_quoted_string k - ; atom_or_quoted_string v + ; v ; action ] in alias t.name ~deps:( @@ -83,14 +90,15 @@ module Test = struct ; sprintf "test-cases/%s" t.name] ] ) ~action - |> Usexp.pp fmt + |> Usexp.pp Dune fmt end let exclusions = let open Test in let odoc = make ~external_deps:true ~skip_ocaml:"4.02.3" in - [ make "js_of_ocaml" ~external_deps:true ~js:true ~env:("NODE", "${bin:node}") - ; make "github25" ~env:("OCAMLPATH", "./findlib-packages") + [ make "js_of_ocaml" ~external_deps:true ~js:true + ~env:("NODE", Sexp.parse "%{bin:node}") + ; make "github25" ~env:("OCAMLPATH", Usexp.atom "./findlib-packages") ; odoc "odoc" ; odoc "odoc-unique-mlds" ; odoc "github717-odoc-index" @@ -122,7 +130,7 @@ let pp_group fmt (name, tests) = alias name ~deps:( (List.map tests ~f:(fun (t : Test.t) -> Sexp.strings ["alias"; t.name]))) - |> Usexp.pp fmt + |> Usexp.pp Dune fmt let () = let tests = Lazy.force all_tests in diff --git a/test/unit-tests/action.mlt b/test/unit-tests/action.mlt index 909b3866..10b82a7e 100644 --- a/test/unit-tests/action.mlt +++ b/test/unit-tests/action.mlt @@ -14,8 +14,8 @@ let infer (a : Action.t) = List.map (Path.Set.to_list x.targets) ~f:Path.to_string) [%%expect{| - : unit = () -val p : ?error_loc:Usexp.Loc.t -> string -> Dune.Import.Path.t = -val infer : Dune.Action.t -> string list * string list = +val p : ?error_loc:Usexp.Loc.t -> string -> Path.t = +val infer : Action.t -> string list * string list = |}] infer (Copy (p "a", p "b"));; diff --git a/test/unit-tests/expect_test.mll b/test/unit-tests/expect_test.mll index 806ca671..7d3de5ce 100644 --- a/test/unit-tests/expect_test.mll +++ b/test/unit-tests/expect_test.mll @@ -38,13 +38,48 @@ and expectation txt = parse } { +module Outcometree_cleaner = struct + open Outcometree + + let lid s = + match String.rindex s '.' with + | exception Not_found -> s + | i -> + let pos = i + 1 in + let len = String.length s in + String.sub s ~pos ~len:(len - pos) + + let ident = function + | Oide_dot (_, s) -> Oide_ident (lid s) + | Oide_ident s -> Oide_ident (lid s) + | id -> id + + let rec value = function + | Oval_array l -> Oval_array (values l) + | Oval_constr (id, l) -> Oval_constr (ident id, values l) + | Oval_list l -> Oval_list (values l) + | Oval_record l -> + Oval_record (List.map l ~f:(fun (id, v) -> ident id, value v)) + | Oval_tuple l -> Oval_tuple (values l) + | Oval_variant (s, Some v) -> Oval_variant (s, Some (value v)) + | v -> v + + and values l = List.map l ~f:value + + let () = + let print_out_value = !Toploop.print_out_value in + Toploop.print_out_value := (fun ppf v -> print_out_value ppf (value v)) +end + let main () = + Clflags.real_paths := false; Test_common.run_expect_test Sys.argv.(1) ~f:(fun file_contents lexbuf -> let chunks = code file_contents lexbuf.lex_curr_p lexbuf in Toploop.initialize_toplevel_env (); List.iter - [ "src/stdune/.stdune.objs" + [ "src/usexp/.usexp.objs" + ; "src/stdune/.stdune.objs" ; "src/.dune.objs" ] ~f:Topdirs.dir_directory; diff --git a/test/unit-tests/import_dot_map.mlt b/test/unit-tests/import_dot_map.mlt index 1f2f70a6..e477acd6 100644 --- a/test/unit-tests/import_dot_map.mlt +++ b/test/unit-tests/import_dot_map.mlt @@ -15,6 +15,5 @@ String.Map.of_list_multi ] |> String.Map.to_list;; [%%expect{| -- : (Dune.Import.String.Map.key * int list) list = -[("a", [1; 2; 3]); ("b", [1; 2])] +- : (string * int list) list = [("a", [1; 2; 3]); ("b", [1; 2])] |}] diff --git a/test/unit-tests/jbuild.mlt b/test/unit-tests/jbuild.mlt index cbec4627..c1b09227 100644 --- a/test/unit-tests/jbuild.mlt +++ b/test/unit-tests/jbuild.mlt @@ -2,67 +2,63 @@ open Dune;; open Stdune;; +let sexp_pp = Sexp.pp Dune;; #install_printer Jbuild.Mode_conf.pp;; #install_printer Binary_kind.pp;; -#install_printer Sexp.pp;; +#install_printer sexp_pp;; (* Jbuild.Executables.Link_mode.t *) let test s = Sexp.Of_sexp.parse Jbuild.Executables.Link_mode.t Univ_map.empty (Sexp.parse_string ~fname:"" ~mode:Sexp.Parser.Mode.Single s) [%%expect{| -val test : string -> Dune.Jbuild.Executables.Link_mode.t = +val sexp_pp : Format.formatter -> Usexp.t -> unit = +val test : string -> Jbuild.Executables.Link_mode.t = |}] (* Link modes can be read as a ( ) list *) test "(best exe)" [%%expect{| -- : Dune.Jbuild.Executables.Link_mode.t = -{Dune.Jbuild.Executables.Link_mode.mode = best; kind = exe} +- : Jbuild.Executables.Link_mode.t = {mode = best; kind = exe} |}] (* Some shortcuts also exist *) test "exe" [%%expect{| -- : Dune.Jbuild.Executables.Link_mode.t = -{Dune.Jbuild.Executables.Link_mode.mode = best; kind = exe} +- : Jbuild.Executables.Link_mode.t = {mode = best; kind = exe} |}] test "object" [%%expect{| -- : Dune.Jbuild.Executables.Link_mode.t = -{Dune.Jbuild.Executables.Link_mode.mode = best; kind = object} +- : Jbuild.Executables.Link_mode.t = {mode = best; kind = object} |}] test "shared_object" [%%expect{| -- : Dune.Jbuild.Executables.Link_mode.t = -{Dune.Jbuild.Executables.Link_mode.mode = best; kind = shared_object} +- : Jbuild.Executables.Link_mode.t = {mode = best; kind = shared_object} |}] test "byte" [%%expect{| -- : Dune.Jbuild.Executables.Link_mode.t = -{Dune.Jbuild.Executables.Link_mode.mode = byte; kind = exe} +- : Jbuild.Executables.Link_mode.t = {mode = byte; kind = exe} |}] test "native" [%%expect{| -- : Dune.Jbuild.Executables.Link_mode.t = -{Dune.Jbuild.Executables.Link_mode.mode = native; kind = exe} +- : Jbuild.Executables.Link_mode.t = {mode = native; kind = exe} |}] (* Jbuild.Executables.Link_mode.sexp_of_t *) let test l = Jbuild.Executables.Link_mode.sexp_of_t l [%%expect{| -val test : Dune.Jbuild.Executables.Link_mode.t -> Stdune__Sexp.t = +val test : Jbuild.Executables.Link_mode.t -> Usexp.t = |}] (* In the general case, modes are serialized as a list *) test {Jbuild.Executables.Link_mode.kind = Shared_object; mode = Byte } [%%expect{| -- : Stdune__Sexp.t = (byte shared_object) +- : Usexp.t = (byte shared_object) |}] (* But the specialized ones are serialized in the minimal version *) test Jbuild.Executables.Link_mode.exe [%%expect{| -- : Stdune__Sexp.t = exe +- : Usexp.t = exe |}] diff --git a/test/unit-tests/path.mlt b/test/unit-tests/path.mlt index d7c207cd..a956d7b2 100644 --- a/test/unit-tests/path.mlt +++ b/test/unit-tests/path.mlt @@ -13,15 +13,15 @@ let e = Path.of_filename_relative_to_initial_cwd;; Path.(let p = relative root "foo" in descendant p ~of_:p) [%%expect{| - : unit = () -val r : string -> Stdune.Path.t = -val e : string -> Stdune.Path.t = -- : Stdune.Path.t option = Some (In_source_tree ".") +val r : string -> Path.t = +val e : string -> Path.t = +- : Path.t option = Some (In_source_tree ".") |}] (* different strings but same length *) Path.(descendant (relative root "foo") ~of_:(relative root "bar")) [%%expect{| -- : Stdune.Path.t option = None +- : Path.t option = None |}] Path.(is_descendant (r "foo") ~of_:(r "foo")) @@ -91,37 +91,37 @@ Path.(is_descendant (e "/foo/bar") ~of_:(e "/")) Path.(descendant (r "foo") ~of_:(r "foo/")) [%%expect{| -- : Stdune.Path.t option = Some (In_source_tree ".") +- : Path.t option = Some (In_source_tree ".") |}] Path.(descendant (r "foo/") ~of_:(r "foo")) [%%expect{| -- : Stdune.Path.t option = Some (In_source_tree ".") +- : Path.t option = Some (In_source_tree ".") |}] Path.(descendant (r "foo/bar") ~of_:(r "foo")) [%%expect{| -- : Stdune.Path.t option = Some (In_source_tree "bar") +- : Path.t option = Some (In_source_tree "bar") |}] Path.(descendant Path.root ~of_:(r "foo")) [%%expect{| -- : Stdune.Path.t option = None +- : Path.t option = None |}] Path.(descendant Path.root ~of_:Path.root) [%%expect{| -- : Stdune.Path.t option = Some (In_source_tree ".") +- : Path.t option = Some (In_source_tree ".") |}] Path.(descendant (r "foo") ~of_:Path.root) [%%expect{| -- : Stdune.Path.t option = Some (In_source_tree "foo") +- : Path.t option = Some (In_source_tree "foo") |}] Path.(descendant (relative build_dir "foo") ~of_:root) [%%expect{| -- : Stdune.Path.t option = Some (In_source_tree "_build/foo") +- : Path.t option = Some (In_source_tree "_build/foo") |}] Path.(descendant (relative build_dir "foo") ~of_:(absolute "/foo/bar")) @@ -132,17 +132,17 @@ Error: Unbound value absolute Path.(descendant (relative build_dir "foo/bar") ~of_:build_dir) [%%expect{| -- : Stdune.Path.t option = Some (In_source_tree "foo/bar") +- : Path.t option = Some (In_source_tree "foo/bar") |}] Path.(descendant (relative build_dir "foo/bar") ~of_:(relative build_dir "foo")) [%%expect{| -- : Stdune.Path.t option = Some (In_source_tree "bar") +- : Path.t option = Some (In_source_tree "bar") |}] Path.(descendant (relative build_dir "foo/bar") ~of_:(relative build_dir "foo")) [%%expect{| -- : Stdune.Path.t option = Some (In_source_tree "bar") +- : Path.t option = Some (In_source_tree "bar") |}] Path.(descendant (absolute "/foo/bar") ~of_:(absolute "/foo")) @@ -188,27 +188,27 @@ Path.reach (Path.of_string "bar/foo") ~from:(Path.of_string "bar/baz/y") Path.relative (Path.of_string "relative") "/absolute/path" [%%expect{| -- : Stdune.Path.t = (External "/absolute/path") +- : Path.t = (External "/absolute/path") |}] Path.relative (Path.of_string "/abs1") "/abs2" [%%expect{| -- : Stdune.Path.t = (External "/abs2") +- : Path.t = (External "/abs2") |}] Path.relative (Path.of_string "/abs1") "" [%%expect{| -- : Stdune.Path.t = (External "/abs1") +- : Path.t = (External "/abs1") |}] Path.relative Path.root "/absolute/path" [%%expect{| -- : Stdune.Path.t = (External "/absolute/path") +- : Path.t = (External "/absolute/path") |}] e "/absolute/path" [%%expect{| -- : Stdune.Path.t = (External "/absolute/path") +- : Path.t = (External "/absolute/path") |}] Path.is_managed (e "relative/path") @@ -218,72 +218,83 @@ Path.is_managed (e "relative/path") Path.insert_after_build_dir_exn Path.root "foobar" [%%expect{| -Exception: Stdune__Exn.Code_error . +Exception: +Code_error + (List + [Atom (A "Path.insert_after_build_dir_exn"); + List [Atom (A "path"); List [Atom (A "In_source_tree"); Atom (A ".")]]; + List [Atom (A "insert"); Atom (A "foobar")]]). |}] Path.insert_after_build_dir_exn Path.build_dir "foobar" [%%expect{| -- : Stdune.Path.t = (In_build_dir "foobar") +- : Path.t = (In_build_dir "foobar") |}] Path.insert_after_build_dir_exn (Path.relative Path.build_dir "qux") "foobar" [%%expect{| -- : Stdune.Path.t = (In_build_dir "foobar/qux") +- : Path.t = (In_build_dir "foobar/qux") |}] Path.append Path.build_dir (Path.relative Path.root "foo") [%%expect{| -- : Stdune.Path.t = (In_build_dir "foo") +- : Path.t = (In_build_dir "foo") |}] Path.append Path.build_dir (Path.relative Path.build_dir "foo") [%%expect{| -- : Stdune.Path.t = (In_build_dir "_build/foo") +- : Path.t = (In_build_dir "_build/foo") |}] Path.append Path.root (Path.relative Path.build_dir "foo") [%%expect{| -- : Stdune.Path.t = (In_source_tree "_build/foo") +- : Path.t = (In_source_tree "_build/foo") |}] Path.append Path.root (Path.relative Path.root "foo") [%%expect{| -- : Stdune.Path.t = (In_source_tree "foo") +- : Path.t = (In_source_tree "foo") |}] Path.append (Path.of_string "/root") (Path.relative Path.root "foo") [%%expect{| -- : Stdune.Path.t = (External "/root/foo") +- : Path.t = (External "/root/foo") |}] Path.append (Path.of_string "/root") (Path.relative Path.build_dir "foo") [%%expect{| -- : Stdune.Path.t = (External "/root/_build/foo") +- : Path.t = (External "/root/_build/foo") |}] Path.rm_rf (Path.of_string "/does/not/exist/foo/bar/baz") [%%expect{| -Exception: Stdune__Exn.Code_error . +Exception: +Code_error + (List + [Quoted_string "Path.rm_rf called on external dir"; + List + [Atom (A "t"); + List [Atom (A "External"); Atom (A "/does/not/exist/foo/bar/baz")]]]). |}] Path.drop_build_context (Path.relative Path.build_dir "foo/bar") [%%expect{| -- : Stdune.Path.t option = Some (In_source_tree "bar") +- : Path.t option = Some (In_source_tree "bar") |}] Path.drop_build_context (Path.of_string "foo/bar") [%%expect{| -- : Stdune.Path.t option = None +- : Path.t option = None |}] Path.drop_build_context (e "/foo/bar") [%%expect{| -- : Stdune.Path.t option = None +- : Path.t option = None |}] Path.drop_build_context Path.build_dir [%%expect{| -- : Stdune.Path.t option = None +- : Path.t option = None |}] Path.is_in_build_dir Path.build_dir @@ -320,11 +331,11 @@ Path.(reach_for_running (relative root "foo") ~from:(Path.relative root "foo")) Path.relative Path.root "_build" [%%expect{| -- : Stdune.Path.t = (In_build_dir ".") +- : Path.t = (In_build_dir ".") |}] (* This is not right, but kind of annoying to fix :/ *) Path.relative (r "foo") "../_build" [%%expect{| -- : Stdune.Path.t = (In_build_dir ".") +- : Path.t = (In_build_dir ".") |}] diff --git a/test/unit-tests/sexp.mlt b/test/unit-tests/sexp.mlt index cc42cb6d..1a744e9b 100644 --- a/test/unit-tests/sexp.mlt +++ b/test/unit-tests/sexp.mlt @@ -2,24 +2,10 @@ open Stdune;; open Sexp.Of_sexp;; -let pp_sexp_ast = - let rec subst_atoms ~f (s : Sexp.t) = - match s with - | Atom a -> f a - | Quoted_string _ -> s - | List xs -> List (List.map ~f:(subst_atoms ~f) xs) - in - fun ppf sexp -> - sexp - |> Sexp.Ast.remove_locs - |> subst_atoms ~f:(fun (A s) -> - List [(Sexp.atom "atom"); Sexp.atom_or_quoted_string s]) - |> Sexp.pp ppf -;; - -#install_printer pp_sexp_ast;; +let print_loc ppf (_ : Sexp.Loc.t) = Format.pp_print_string ppf "";; +#install_printer print_loc;; [%%expect{| -val pp_sexp_ast : Format.formatter -> Stdune.Sexp.Ast.t -> unit = +val print_loc : Format.formatter -> Usexp.Loc.t -> unit = |}] Printexc.record_backtrace false;; @@ -27,43 +13,46 @@ Printexc.record_backtrace false;; - : unit = () |}] -let sexp = Sexp.parse_string ~fname:"" ~mode:Single {| +let sexp = lazy (Sexp.parse_string ~fname:"" ~mode:Single {| ((foo 1) (foo 2)) -|} +|});; +Sexp.Ast.remove_locs (Lazy.force sexp) [%%expect{| -val sexp : Usexp.Ast.t = (((atom foo) (atom 1)) ((atom foo) (atom 2))) +val sexp : ast lazy_t = +- : Usexp.t = +List + [List [Atom (A "foo"); Atom (A "1")]; List [Atom (A "foo"); Atom (A "2")]] |}] let of_sexp = record (field "foo" int) -let x = parse of_sexp Univ_map.empty sexp +let x = parse of_sexp Univ_map.empty (Lazy.force sexp) [%%expect{| -val of_sexp : int Stdune.Sexp.Of_sexp.t = -Exception: -Stdune__Sexp.Of_sexp.Of_sexp (, - "Field \"foo\" is present too many times", None). +val of_sexp : int t = +Exception: Of_sexp (, "Field \"foo\" is present too many times", None). |}] let of_sexp = record (multi_field "foo" int) -let x = parse of_sexp Univ_map.empty sexp +let x = parse of_sexp Univ_map.empty (Lazy.force sexp) [%%expect{| -val of_sexp : int list Stdune.Sexp.Of_sexp.t = +val of_sexp : int list t = val x : int list = [1; 2] |}] -type parse_result_diff = - { jbuild : (Sexp.Ast.t list, string) result - ; dune : (Sexp.Ast.t list, string) result +type 'res parse_result_diff = + { jbuild : ('res, string) result + ; dune : ('res, string) result } -type parse_result = - | Same of (Sexp.Ast.t list, string) result - | Different of parse_result_diff +type 'res parse_result = + | Same of ('res, string) result + | Different of 'res parse_result_diff let parse s = let f ~lexer = try - Ok (Sexp.parse_string ~fname:"" ~mode:Many ~lexer s) + Ok (Sexp.parse_string ~fname:"" ~mode:Many ~lexer s + |> List.map ~f:Sexp.Ast.remove_locs) with | Sexp.Parse_error e -> Error (Sexp.Parse_error.message e) | Invalid_argument e -> Error e @@ -75,122 +64,294 @@ let parse s = else Same jbuild [%%expect{| -type parse_result_diff = { - jbuild : (Stdune.Sexp.Ast.t list, string) Stdune.result; - dune : (Stdune.Sexp.Ast.t list, string) Stdune.result; +type 'res parse_result_diff = { + jbuild : ('res, string) Stdune.result; + dune : ('res, string) Stdune.result; } -type parse_result = - Same of (Stdune.Sexp.Ast.t list, string) Stdune.result - | Different of parse_result_diff -val parse : string -> parse_result = +type 'res parse_result = + Same of ('res, string) Stdune.result + | Different of 'res parse_result_diff +val parse : string -> Usexp.t list parse_result = |}] parse {| # ## x##y x||y a#b|c#d copy# |} [%%expect{| -- : parse_result = +- : Usexp.t list parse_result = Same (Ok - [(atom #); (atom ##); (atom x##y); (atom x||y); (atom a#b|c#d); - (atom copy#)]) + [Atom (A "#"); Atom (A "##"); Atom (A "x##y"); Atom (A "x||y"); + Atom (A "a#b|c#d"); Atom (A "copy#")]) |}] parse {|x #| comment |# y|} [%%expect{| -- : parse_result = +- : Usexp.t list parse_result = Different - {jbuild = Ok [(atom x); (atom y)]; - dune = Ok [(atom x); (atom #|); (atom comment); (atom |#); (atom y)]} + {jbuild = Ok [Atom (A "x"); Atom (A "y")]; + dune = + Ok + [Atom (A "x"); Atom (A "#|"); Atom (A "comment"); Atom (A "|#"); + Atom (A "y")]} |}] parse {|x#|y|} [%%expect{| -- : parse_result = +- : Usexp.t list parse_result = Different - {jbuild = Error "jbuild atoms cannot contain #|"; dune = Ok [(atom x#|y)]} + {jbuild = Error "jbuild atoms cannot contain #|"; + dune = Ok [Atom (A "x#|y")]} |}] parse {|x|#y|} [%%expect{| -- : parse_result = +- : Usexp.t list parse_result = Different - {jbuild = Error "jbuild atoms cannot contain |#"; dune = Ok [(atom x|#y)]} + {jbuild = Error "jbuild atoms cannot contain |#"; + dune = Ok [Atom (A "x|#y")]} |}] parse {|"\a"|} [%%expect{| -- : parse_result = -Different {jbuild = Ok ["\\a"]; dune = Error "unknown escape sequence"} +- : Usexp.t list parse_result = +Different + {jbuild = Ok [Quoted_string "\\a"]; dune = Error "unknown escape sequence"} |}] parse {|"\%{x}"|} [%%expect{| -- : parse_result = -Different {jbuild = Ok ["\\%{x}"]; dune = Error "unknown escape sequence"} +- : Usexp.t list parse_result = +Different + {jbuild = Ok [Quoted_string "\\%{x}"]; dune = Ok [Quoted_string "%{x}"]} |}] parse {|"$foo"|} [%%expect{| -- : parse_result = Same (Ok ["$foo"]) +- : Usexp.t list parse_result = Same (Ok [Quoted_string "$foo"]) |}] parse {|"%foo"|} [%%expect{| -- : parse_result = Same (Ok ["%foo"]) +- : Usexp.t list parse_result = Same (Ok [Quoted_string "%foo"]) |}] parse {|"bar%foo"|} [%%expect{| -- : parse_result = Same (Ok ["bar%foo"]) +- : Usexp.t list parse_result = Same (Ok [Quoted_string "bar%foo"]) |}] parse {|"bar$foo"|} [%%expect{| -- : parse_result = Same (Ok ["bar$foo"]) +- : Usexp.t list parse_result = Same (Ok [Quoted_string "bar$foo"]) |}] parse {|"%bar$foo%"|} [%%expect{| -- : parse_result = Same (Ok ["%bar$foo%"]) +- : Usexp.t list parse_result = Same (Ok [Quoted_string "%bar$foo%"]) |}] parse {|"$bar%foo%"|} [%%expect{| -- : parse_result = Same (Ok ["$bar%foo%"]) +- : Usexp.t list parse_result = Same (Ok [Quoted_string "$bar%foo%"]) |}] parse {|\${foo}|} [%%expect{| -- : parse_result = Same (Ok [(atom \${foo})]) +- : Usexp.t list parse_result = Same (Ok [Atom (A "\\${foo}")]) |}] parse {|\%{foo}|} [%%expect{| -- : parse_result = +- : Usexp.t list parse_result = Different - {jbuild = Ok [(atom "\\%{foo}")]; dune = Error "Invalid atom character '%'"} + {jbuild = Ok [Atom (A "\\%{foo}")]; + dune = + Ok + [Template + {quoted = false; + parts = + [Text "\\"; + Var {loc = ; name = "foo"; payload = None; syntax = Percent}]; + loc = }]} |}] parse {|\$bar%foo%|} [%%expect{| -- : parse_result = -Different - {jbuild = Ok [(atom "\\$bar%foo%")]; - dune = Error "Invalid atom character '%'"} +- : Usexp.t list parse_result = Same (Ok [Atom (A "\\$bar%foo%")]) |}] parse {|\$bar\%foo%|} [%%expect{| -- : parse_result = -Different - {jbuild = Ok [(atom "\\$bar\\%foo%")]; - dune = Error "Invalid atom character '%'"} +- : Usexp.t list parse_result = Same (Ok [Atom (A "\\$bar\\%foo%")]) |}] parse {|\$bar\%foo%{bar}|} [%%expect{| -- : parse_result = +- : Usexp.t list parse_result = Different - {jbuild = Ok [(atom "\\$bar\\%foo%{bar}")]; - dune = Error "Invalid atom character '%'"} + {jbuild = Ok [Atom (A "\\$bar\\%foo%{bar}")]; + dune = + Ok + [Template + {quoted = false; + parts = + [Text "\\$bar\\%foo"; + Var {loc = ; name = "bar"; payload = None; syntax = Percent}]; + loc = }]} +|}] + +parse {|"bar%{foo}"|} +[%%expect{| +- : Usexp.t list parse_result = +Different + {jbuild = Ok [Quoted_string "bar%{foo}"]; + dune = + Ok + [Template + {quoted = true; + parts = + [Text "bar"; + Var {loc = ; name = "foo"; payload = None; syntax = Percent}]; + loc = }]} +|}] + +parse {|"bar\%{foo}"|} +[%%expect{| +- : Usexp.t list parse_result = +Different + {jbuild = Ok [Quoted_string "bar\\%{foo}"]; + dune = Ok [Quoted_string "bar%{foo}"]} +|}] + +parse {|bar%%{foo}|} +[%%expect{| +- : Usexp.t list parse_result = +Different + {jbuild = Ok [Atom (A "bar%%{foo}")]; + dune = + Ok + [Template + {quoted = false; + parts = + [Text "bar%"; + Var {loc = ; name = "foo"; payload = None; syntax = Percent}]; + loc = }]} +|}] + +parse {|"bar%%{foo}"|} +[%%expect{| +- : Usexp.t list parse_result = +Different + {jbuild = Ok [Quoted_string "bar%%{foo}"]; + dune = + Ok + [Template + {quoted = true; + parts = + [Text "bar%"; + Var {loc = ; name = "foo"; payload = None; syntax = Percent}]; + loc = }]} +|}] + +parse {|"bar\%foo"|} +[%%expect{| +- : Usexp.t list parse_result = +Different + {jbuild = Ok [Quoted_string "bar\\%foo"]; + dune = Error "unknown escape sequence"} +|}] + +(* +-----------------------------------------------------------------+ + | Printing tests | + +-----------------------------------------------------------------+ *) + +let loc = Sexp.Loc.in_file "" +let a = Sexp.atom +let s x = Sexp.Quoted_string x +let t x = Sexp.Template { quoted = false; parts = x; loc } +let tq x = Sexp.Template { quoted = true ; parts = x; loc } +let l x = Sexp.List x +let var ?(syntax=Sexp.Template.Percent) ?payload name = + { Sexp.Template. + loc + ; name + ; payload + ; syntax + } + +type sexp = S of Sexp.syntax * Sexp.t + +let print_sexp ppf (S (syntax, sexp)) = Sexp.pp syntax ppf sexp;; +#install_printer print_sexp + +type round_trip_result = + | Round_trip_success + | Did_not_round_trip of Sexp.t + | Did_not_parse_back of string + +let test syntax sexp = + (S (syntax, sexp), + let s = Format.asprintf "%a" (Sexp.pp syntax) sexp in + match + Sexp.parse_string s ~mode:Single ~fname:"" + ~lexer:(match syntax with + | Jbuild -> Sexp.Lexer.jbuild_token + | Dune -> Sexp.Lexer.token) + with + | sexp' -> + let sexp' = Sexp.Ast.remove_locs sexp' in + if sexp = sexp' then + Round_trip_success + else + Did_not_round_trip sexp' + | exception (Sexp.Parse_error e) -> + Did_not_parse_back (Sexp.Parse_error.message e)) +;; +#install_printer print_sexp + +[%%expect{| +val loc : Usexp.Loc.t = +val a : string -> Usexp.t = +val s : string -> Usexp.t = +val t : Usexp.Template.part list -> Usexp.t = +val tq : Usexp.Template.part list -> Usexp.t = +val l : Usexp.t list -> Usexp.t = +val var : + ?syntax:Usexp.Template.var_syntax -> + ?payload:string -> string -> Usexp.Template.var = +type sexp = S of Usexp.syntax * Usexp.t +val print_sexp : Format.formatter -> sexp -> unit = +type round_trip_result = + Round_trip_success + | Did_not_round_trip of Usexp.t + | Did_not_parse_back of string +val test : Usexp.syntax -> Usexp.t -> sexp * round_trip_result = +|}] + +test Dune (a "toto") +[%%expect{| +- : sexp * round_trip_result = (toto, Round_trip_success) +|}] + +test Dune (t [Text "x%{"]) +[%%expect{| +Exception: Invalid_argument "Invalid text \"x%{\" in unquoted template". +|}] + +test Dune (t [Text "x%"; Text "{"]) +[%%expect{| +Exception: Invalid_argument "Invalid text \"x%{\" in unquoted template". +|}] + +(* This round trip failure is expected *) +test Dune (tq [Text "x%{"]) +[%%expect{| +- : sexp * round_trip_result = +("x\%{", Did_not_round_trip (Quoted_string "x%{")) +|}] + +test Dune (tq [Text "x%"; Text "{"]) +[%%expect{| +- : sexp * round_trip_result = +("x\%{", Did_not_round_trip (Quoted_string "x%{")) |}] diff --git a/test/unit-tests/sexp_tests.ml b/test/unit-tests/sexp_tests.ml index adec99fe..d93ed5e9 100644 --- a/test/unit-tests/sexp_tests.ml +++ b/test/unit-tests/sexp_tests.ml @@ -5,13 +5,13 @@ let () = Printexc.record_backtrace true (* Test that all strings of length <= 3 such that [Usexp.Atom.is_valid s] are recignized as atoms by the parser *) -let string_of_syntax (x : Usexp.Atom.syntax) = +let string_of_syntax (x : Usexp.syntax) = match x with | Dune -> "dune" | Jbuild -> "jbuild" let () = - [ Usexp.Atom.Dune, Usexp.Lexer.token, (fun s -> Usexp.Atom.is_valid s Dune) + [ Usexp.Dune, Usexp.Lexer.token, (fun s -> Usexp.Atom.is_valid s Dune) ; Jbuild, Usexp.Lexer.jbuild_token, (fun s -> Usexp.Atom.is_valid s Jbuild) ] |> List.iter ~f:(fun (syntax, lexer, validator) -> diff --git a/test/unit-tests/tests.mlt b/test/unit-tests/tests.mlt index 2323e6a7..76c2cb1d 100644 --- a/test/unit-tests/tests.mlt +++ b/test/unit-tests/tests.mlt @@ -18,7 +18,7 @@ let print_pkg ppf pkg = #install_printer String_map.pp;; [%%expect{| -val print_pkg : Format.formatter -> Dune.Findlib.Package.t -> unit = +val print_pkg : Format.formatter -> Findlib.Package.t -> unit = |}] let findlib = @@ -29,7 +29,7 @@ let findlib = ;; [%%expect{| -val findlib : Dune.Findlib.t = +val findlib : Findlib.t = |}] let pkg = @@ -38,7 +38,7 @@ let pkg = | Error _ -> assert false;; [%%expect{| -val pkg : Dune.Findlib.Package.t = +val pkg : Findlib.Package.t = |}] (* "foo" should depend on "baz" *) @@ -60,7 +60,7 @@ let meta = |> Meta.load ~name:"foo" [%%expect{| -val meta : Dune.Meta.Simplified.t = +val meta : Simplified.t = { name = "foo" ; vars = (requires = @@ -89,7 +89,7 @@ let conf = ~toolchain:"tlc" ~context:"" [%%expect{| -val conf : Dune.Findlib.Config.t = +val conf : Findlib.Config.t = { vars = [ (FOO_BAR, { set_rules = [ { preds_required = [ "tlc"; "env" ] @@ -104,15 +104,15 @@ val conf : Dune.Findlib.Config.t = } |}] -let env_pp fmt env = Sexp.pp fmt (Env.sexp_of_t env);; +let env_pp fmt env = Sexp.pp Dune fmt (Env.sexp_of_t env);; #install_printer env_pp;; [%%expect{| -val env_pp : Format.formatter -> Dune.Env.t -> unit = +val env_pp : Format.formatter -> Env.t -> unit = |}] let env = Findlib.Config.env conf [%%expect{| -val env : Dune.Env.t = ((FOO_BAR "my variable")) +val env : Env.t = ((FOO_BAR "my variable")) |}] From ec14661a01a10f4df5ffce6309de6bb5b420d125 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Thu, 28 Jun 2018 09:45:02 +0630 Subject: [PATCH 2/2] Update tests for new variables syntax Signed-off-by: Rudi Grinberg --- doc/dune | 8 +- example/dune | 4 +- example/sample-projects/hello_world/test/dune | 4 +- .../sample-projects/with-configure-step/dune | 4 +- .../with-configure-step/src/dune | 2 +- src/configurator/flags/dune | 2 +- test/blackbox-tests/dune | 2 +- test/blackbox-tests/dune.inc | 136 +++++++++--------- .../test-cases/aliases/src/dune | 2 +- .../test-cases/aliases/src/foo/bar/dune | 2 +- .../test-cases/aliases/src/foo/baz/dune | 2 +- .../blackbox-tests/test-cases/copy_files/dune | 4 +- .../blackbox-tests/test-cases/force-test/dune | 2 +- .../test-cases/gen-opam-install-file/dune | 2 +- test/blackbox-tests/test-cases/github534/dune | 2 +- test/blackbox-tests/test-cases/github568/dune | 4 +- .../github660/explicit-interfaces/dune | 2 +- .../test-cases/github660/no-interfaces/dune | 2 +- test/blackbox-tests/test-cases/github784/dune | 2 +- .../test-cases/inline_tests/dune-file/dune | 6 +- .../test-cases/inline_tests/run.t | 4 +- .../test-cases/inline_tests/simple/dune | 2 +- .../test-cases/lib-available/dune | 4 +- test/blackbox-tests/test-cases/loop/dune | 4 +- .../test-cases/merlin-tests/dune | 2 +- test/blackbox-tests/test-cases/meta-gen/dune | 2 +- test/blackbox-tests/test-cases/misc/blah/dune | 2 +- test/blackbox-tests/test-cases/misc/dune | 16 +-- test/blackbox-tests/test-cases/null-dep/dune | 2 +- test/blackbox-tests/test-cases/odoc/dune | 6 +- .../blackbox-tests/test-cases/output-obj/dune | 30 ++-- .../test-cases/quoting/bad/dune | 2 +- .../test-cases/quoting/filename-space/dune | 4 +- .../test-cases/quoting/good/dune | 2 +- .../quoting/quote-from-context/dune | 2 +- .../test-cases/quoting/quotes-multi/dune | 2 +- test/blackbox-tests/test-cases/quoting/run.t | 14 +- test/blackbox-tests/test-cases/reason/dune | 12 +- .../test-cases/redirections/dune | 6 +- test/blackbox-tests/test-cases/select/dune | 2 +- test/dune | 40 +++--- test/unit-tests/configurator/dune | 2 +- test/unit-tests/dune | 74 +++++----- test/unit-tests/ocaml-config/dune | 2 +- 44 files changed, 217 insertions(+), 215 deletions(-) diff --git a/doc/dune b/doc/dune index 3687e7da..d65a7841 100644 --- a/doc/dune +++ b/doc/dune @@ -1,5 +1,5 @@ (rule - (with-stdout-to dune.1 (run ${bin:dune} --help=groff))) + (with-stdout-to dune.1 (run %{bin:dune} --help=groff))) (install (section man) @@ -8,7 +8,7 @@ (rule (with-stdout-to dune-config.5 - (run ${bin:jbuilder} help config --man-format=groff))) + (run %{bin:jbuilder} help config --man-format=groff))) (install (section man) @@ -21,8 +21,8 @@ (targets dune.inc.gen) (deps (package dune)) (action - (with-stdout-to ${@} - (run bash ${path:update-jbuild.sh})))) + (with-stdout-to %{@} + (run bash %{path:update-jbuild.sh})))) (alias (name runtest) diff --git a/example/dune b/example/dune index 28d95e46..5080e198 100644 --- a/example/dune +++ b/example/dune @@ -5,11 +5,11 @@ (deps (package dune) (source_tree sample-projects/hello_world)) (action (chdir sample-projects/hello_world - (run ${exe:../test/blackbox-tests/cram.exe} -test run.t)))) + (run %{exe:../test/blackbox-tests/cram.exe} -test run.t)))) (alias (name runtest) (deps (package dune) (source_tree sample-projects/with-configure-step)) (action (chdir sample-projects/with-configure-step - (run ${exe:../test/blackbox-tests/cram.exe} -test run.t)))) + (run %{exe:../test/blackbox-tests/cram.exe} -test run.t)))) diff --git a/example/sample-projects/hello_world/test/dune b/example/sample-projects/hello_world/test/dune index 10662055..192b315a 100644 --- a/example/sample-projects/hello_world/test/dune +++ b/example/sample-projects/hello_world/test/dune @@ -1,7 +1,7 @@ (rule ((targets (hello_world.output)) - (action (with-stdout-to ${@} (run ${bin:hello_world}))))) + (action (with-stdout-to %{@} (run %{bin:hello_world}))))) (alias ((name runtest) - (action (run diff -uw ${path:hello_world.expected} ${path:hello_world.output})))) + (action (run diff -uw %{path:hello_world.expected} %{path:hello_world.output})))) diff --git a/example/sample-projects/with-configure-step/dune b/example/sample-projects/with-configure-step/dune index a3b036e6..ead9dc07 100644 --- a/example/sample-projects/with-configure-step/dune +++ b/example/sample-projects/with-configure-step/dune @@ -2,9 +2,9 @@ ((fallback) (targets (config)) (deps (config.defaults)) - (action (copy ${<} ${@})))) + (action (copy %{<} %{@})))) (rule ((targets (config.full)) (deps (config_common.ml config)) - (action (run ${OCAML} ${path:real_configure.ml})))) + (action (run %{OCAML} %{path:real_configure.ml})))) diff --git a/example/sample-projects/with-configure-step/src/dune b/example/sample-projects/with-configure-step/src/dune index c9b7e4f8..73447673 100644 --- a/example/sample-projects/with-configure-step/src/dune +++ b/example/sample-projects/with-configure-step/src/dune @@ -8,5 +8,5 @@ (rule ((targets (config.ml)) (deps (../config.full)) - (action (copy ${<} ${@})))) + (action (copy %{<} %{@})))) diff --git a/src/configurator/flags/dune b/src/configurator/flags/dune index 1933b680..bdc4192a 100644 --- a/src/configurator/flags/dune +++ b/src/configurator/flags/dune @@ -1,4 +1,4 @@ (executable (name mk)) -(rule (with-stdout-to flags.sexp (run ./mk.exe -ocamlv ${ocaml_version}))) +(rule (with-stdout-to flags.sexp (run ./mk.exe -ocamlv %{ocaml_version}))) diff --git a/test/blackbox-tests/dune b/test/blackbox-tests/dune index f4486196..08b5483b 100644 --- a/test/blackbox-tests/dune +++ b/test/blackbox-tests/dune @@ -22,7 +22,7 @@ (rule (targets dune.inc.gen) (deps (source_tree test-cases)) - (action (with-stdout-to ${@} (run ./gen_tests.exe)))) + (action (with-stdout-to %{@} (run ./gen_tests.exe)))) (alias (name runtest) diff --git a/test/blackbox-tests/dune.inc b/test/blackbox-tests/dune.inc index 828685e9..d1f402ab 100644 --- a/test/blackbox-tests/dune.inc +++ b/test/blackbox-tests/dune.inc @@ -4,7 +4,7 @@ (action (chdir test-cases/aliases - (progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))) + (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))) (alias (name bad-alias-error) @@ -12,7 +12,7 @@ (action (chdir test-cases/bad-alias-error - (progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))) + (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))) (alias (name block-strings) @@ -20,7 +20,7 @@ (action (chdir test-cases/block-strings - (progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))) + (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))) (alias (name byte-code-only) @@ -28,7 +28,7 @@ (action (chdir test-cases/byte-code-only - (progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))) + (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))) (alias (name c-stubs) @@ -36,7 +36,7 @@ (action (chdir test-cases/c-stubs - (progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))) + (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))) (alias (name configurator) @@ -45,7 +45,7 @@ (chdir test-cases/configurator (progn - (run ${exe:cram.exe} -skip-platforms win -test run.t) + (run %{exe:cram.exe} -skip-platforms win -test run.t) (diff? run.t run.t.corrected))))) (alias @@ -54,7 +54,7 @@ (action (chdir test-cases/copy_files - (progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))) + (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))) (alias (name cross-compilation) @@ -62,7 +62,7 @@ (action (chdir test-cases/cross-compilation - (progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))) + (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))) (alias (name custom-build-dir) @@ -70,7 +70,7 @@ (action (chdir test-cases/custom-build-dir - (progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))) + (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))) (alias (name depend-on-the-universe) @@ -78,7 +78,7 @@ (action (chdir test-cases/depend-on-the-universe - (progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))) + (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))) (alias (name dune-ppx-driver-system) @@ -86,7 +86,7 @@ (action (chdir test-cases/dune-ppx-driver-system - (progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))) + (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))) (alias (name dune-project-edition) @@ -94,7 +94,7 @@ (action (chdir test-cases/dune-project-edition - (progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))) + (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))) (alias (name env) @@ -102,7 +102,7 @@ (action (chdir test-cases/env - (progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))) + (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))) (alias (name exclude-missing-module) @@ -110,7 +110,7 @@ (action (chdir test-cases/exclude-missing-module - (progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))) + (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))) (alias (name exec-cmd) @@ -118,7 +118,7 @@ (action (chdir test-cases/exec-cmd - (progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))) + (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))) (alias (name findlib) @@ -126,7 +126,7 @@ (action (chdir test-cases/findlib - (progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))) + (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))) (alias (name force-test) @@ -134,7 +134,7 @@ (action (chdir test-cases/force-test - (progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))) + (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))) (alias (name gen-opam-install-file) @@ -142,7 +142,7 @@ (action (chdir test-cases/gen-opam-install-file - (progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))) + (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))) (alias (name github20) @@ -150,7 +150,7 @@ (action (chdir test-cases/github20 - (progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))) + (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))) (alias (name github24) @@ -158,7 +158,7 @@ (action (chdir test-cases/github24 - (progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))) + (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))) (alias (name github25) @@ -169,7 +169,7 @@ ./findlib-packages (chdir test-cases/github25 - (progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))) + (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))) (alias (name github534) @@ -177,7 +177,7 @@ (action (chdir test-cases/github534 - (progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))) + (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))) (alias (name github568) @@ -185,7 +185,7 @@ (action (chdir test-cases/github568 - (progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))) + (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))) (alias (name github597) @@ -193,7 +193,7 @@ (action (chdir test-cases/github597 - (progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))) + (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))) (alias (name github644) @@ -201,7 +201,7 @@ (action (chdir test-cases/github644 - (progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))) + (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))) (alias (name github660) @@ -209,7 +209,7 @@ (action (chdir test-cases/github660 - (progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))) + (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))) (alias (name github717-odoc-index) @@ -218,7 +218,7 @@ (chdir test-cases/github717-odoc-index (progn - (run ${exe:cram.exe} -skip-versions 4.02.3 -test run.t) + (run %{exe:cram.exe} -skip-versions 4.02.3 -test run.t) (diff? run.t run.t.corrected))))) (alias @@ -227,7 +227,7 @@ (action (chdir test-cases/github734 - (progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))) + (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))) (alias (name github759) @@ -235,7 +235,7 @@ (action (chdir test-cases/github759 - (progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))) + (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))) (alias (name github761) @@ -243,7 +243,7 @@ (action (chdir test-cases/github761 - (progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))) + (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))) (alias (name github764) @@ -252,7 +252,7 @@ (chdir test-cases/github764 (progn - (run ${exe:cram.exe} -skip-platforms win -test run.t) + (run %{exe:cram.exe} -skip-platforms win -test run.t) (diff? run.t run.t.corrected))))) (alias @@ -261,7 +261,7 @@ (action (chdir test-cases/github784 - (progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))) + (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))) (alias (name ignored_subdirs) @@ -269,7 +269,7 @@ (action (chdir test-cases/ignored_subdirs - (progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))) + (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))) (alias (name include-loop) @@ -277,7 +277,7 @@ (action (chdir test-cases/include-loop - (progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))) + (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))) (alias (name inline_tests) @@ -285,7 +285,7 @@ (action (chdir test-cases/inline_tests - (progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))) + (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))) (alias (name installable-dup-private-libs) @@ -293,7 +293,7 @@ (action (chdir test-cases/installable-dup-private-libs - (progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))) + (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))) (alias (name intf-only) @@ -301,7 +301,7 @@ (action (chdir test-cases/intf-only - (progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))) + (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))) (alias (name js_of_ocaml) @@ -309,10 +309,10 @@ (action (setenv NODE - ${bin:node} + %{bin:node} (chdir test-cases/js_of_ocaml - (progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))) + (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))) (alias (name lib-available) @@ -320,7 +320,7 @@ (action (chdir test-cases/lib-available - (progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))) + (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))) (alias (name link-deps) @@ -328,7 +328,7 @@ (action (chdir test-cases/link-deps - (progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))) + (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))) (alias (name loop) @@ -336,7 +336,7 @@ (action (chdir test-cases/loop - (progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))) + (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))) (alias (name menhir) @@ -344,7 +344,7 @@ (action (chdir test-cases/menhir - (progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))) + (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))) (alias (name merlin-tests) @@ -352,7 +352,7 @@ (action (chdir test-cases/merlin-tests - (progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))) + (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))) (alias (name meta-gen) @@ -360,7 +360,7 @@ (action (chdir test-cases/meta-gen - (progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))) + (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))) (alias (name misc) @@ -368,7 +368,7 @@ (action (chdir test-cases/misc - (progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))) + (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))) (alias (name multiple-private-libs) @@ -377,7 +377,7 @@ (chdir test-cases/multiple-private-libs (progn - (run ${exe:cram.exe} -skip-versions 4.02.3 -test run.t) + (run %{exe:cram.exe} -skip-versions 4.02.3 -test run.t) (diff? run.t run.t.corrected))))) (alias @@ -386,7 +386,7 @@ (action (chdir test-cases/no-installable-mode - (progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))) + (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))) (alias (name null-dep) @@ -394,7 +394,7 @@ (action (chdir test-cases/null-dep - (progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))) + (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))) (alias (name ocaml-syntax) @@ -402,7 +402,7 @@ (action (chdir test-cases/ocaml-syntax - (progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))) + (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))) (alias (name ocamldep-multi-stanzas) @@ -410,7 +410,7 @@ (action (chdir test-cases/ocamldep-multi-stanzas - (progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))) + (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))) (alias (name odoc) @@ -419,7 +419,7 @@ (chdir test-cases/odoc (progn - (run ${exe:cram.exe} -skip-versions 4.02.3 -test run.t) + (run %{exe:cram.exe} -skip-versions 4.02.3 -test run.t) (diff? run.t run.t.corrected))))) (alias @@ -429,7 +429,7 @@ (chdir test-cases/odoc-unique-mlds (progn - (run ${exe:cram.exe} -skip-versions 4.02.3 -test run.t) + (run %{exe:cram.exe} -skip-versions 4.02.3 -test run.t) (diff? run.t run.t.corrected))))) (alias @@ -440,7 +440,7 @@ test-cases/output-obj (progn (run - ${exe:cram.exe} + %{exe:cram.exe} -skip-versions <4.06.0 -skip-platforms @@ -455,7 +455,7 @@ (action (chdir test-cases/package-dep - (progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))) + (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))) (alias (name ppx-rewriter) @@ -464,7 +464,7 @@ (chdir test-cases/ppx-rewriter (progn - (run ${exe:cram.exe} -skip-versions 4.02.3 -test run.t) + (run %{exe:cram.exe} -skip-versions 4.02.3 -test run.t) (diff? run.t run.t.corrected))))) (alias @@ -473,7 +473,7 @@ (action (chdir test-cases/private-public-overlap - (progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))) + (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))) (alias (name promote) @@ -481,7 +481,7 @@ (action (chdir test-cases/promote - (progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))) + (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))) (alias (name quoting) @@ -489,7 +489,7 @@ (action (chdir test-cases/quoting - (progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))) + (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))) (alias (name reason) @@ -497,7 +497,7 @@ (action (chdir test-cases/reason - (progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))) + (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))) (alias (name redirections) @@ -505,7 +505,7 @@ (action (chdir test-cases/redirections - (progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))) + (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))) (alias (name scope-bug) @@ -513,7 +513,7 @@ (action (chdir test-cases/scope-bug - (progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))) + (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))) (alias (name scope-ppx-bug) @@ -521,7 +521,7 @@ (action (chdir test-cases/scope-ppx-bug - (progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))) + (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))) (alias (name select) @@ -529,7 +529,7 @@ (action (chdir test-cases/select - (progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))) + (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))) (alias (name syntax-versioning) @@ -537,7 +537,7 @@ (action (chdir test-cases/syntax-versioning - (progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))) + (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))) (alias (name use-meta) @@ -545,7 +545,7 @@ (action (chdir test-cases/use-meta - (progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))) + (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))) (alias (name utop) @@ -553,7 +553,7 @@ (action (chdir test-cases/utop - (progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))) + (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))) (alias (name windows-diff) @@ -561,7 +561,7 @@ (action (chdir test-cases/windows-diff - (progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))) + (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))) (alias (name runtest) diff --git a/test/blackbox-tests/test-cases/aliases/src/dune b/test/blackbox-tests/test-cases/aliases/src/dune index f65a86f0..e2079593 100644 --- a/test/blackbox-tests/test-cases/aliases/src/dune +++ b/test/blackbox-tests/test-cases/aliases/src/dune @@ -1,3 +1,3 @@ (alias (name x) - (action (chdir ${ROOT} (echo "running in ${path-no-dep:.}\n")))) + (action (chdir %{ROOT} (echo "running in %{path-no-dep:.}\n")))) diff --git a/test/blackbox-tests/test-cases/aliases/src/foo/bar/dune b/test/blackbox-tests/test-cases/aliases/src/foo/bar/dune index f65a86f0..e2079593 100644 --- a/test/blackbox-tests/test-cases/aliases/src/foo/bar/dune +++ b/test/blackbox-tests/test-cases/aliases/src/foo/bar/dune @@ -1,3 +1,3 @@ (alias (name x) - (action (chdir ${ROOT} (echo "running in ${path-no-dep:.}\n")))) + (action (chdir %{ROOT} (echo "running in %{path-no-dep:.}\n")))) diff --git a/test/blackbox-tests/test-cases/aliases/src/foo/baz/dune b/test/blackbox-tests/test-cases/aliases/src/foo/baz/dune index f65a86f0..e2079593 100644 --- a/test/blackbox-tests/test-cases/aliases/src/foo/baz/dune +++ b/test/blackbox-tests/test-cases/aliases/src/foo/baz/dune @@ -1,3 +1,3 @@ (alias (name x) - (action (chdir ${ROOT} (echo "running in ${path-no-dep:.}\n")))) + (action (chdir %{ROOT} (echo "running in %{path-no-dep:.}\n")))) diff --git a/test/blackbox-tests/test-cases/copy_files/dune b/test/blackbox-tests/test-cases/copy_files/dune index 06b5fa03..57d71628 100644 --- a/test/blackbox-tests/test-cases/copy_files/dune +++ b/test/blackbox-tests/test-cases/copy_files/dune @@ -3,7 +3,7 @@ (rule (targets dummy.ml) - (action (with-stdout-to ${@} (echo "")))) + (action (with-stdout-to %{@} (echo "")))) (library (name foo) @@ -19,4 +19,4 @@ (alias (name bar-source) (deps bar.h) - (action (echo "${read:bar.h}"))) + (action (echo "%{read:bar.h}"))) diff --git a/test/blackbox-tests/test-cases/force-test/dune b/test/blackbox-tests/test-cases/force-test/dune index d3fa8f0c..b82cbf03 100644 --- a/test/blackbox-tests/test-cases/force-test/dune +++ b/test/blackbox-tests/test-cases/force-test/dune @@ -4,4 +4,4 @@ (alias (name runtest) (deps f.exe) - (action (run ${<}))) + (action (run %{<}))) diff --git a/test/blackbox-tests/test-cases/gen-opam-install-file/dune b/test/blackbox-tests/test-cases/gen-opam-install-file/dune index 1d2a7490..b55f1341 100644 --- a/test/blackbox-tests/test-cases/gen-opam-install-file/dune +++ b/test/blackbox-tests/test-cases/gen-opam-install-file/dune @@ -25,7 +25,7 @@ (alias (name runtest) (deps foo.install) - (action (echo "${read:foo.install}"))) + (action (echo "%{read:foo.install}"))) (documentation (mld_files (doc))) diff --git a/test/blackbox-tests/test-cases/github534/dune b/test/blackbox-tests/test-cases/github534/dune index edbe1eeb..e8c96ba4 100644 --- a/test/blackbox-tests/test-cases/github534/dune +++ b/test/blackbox-tests/test-cases/github534/dune @@ -6,5 +6,5 @@ (deps (glob_files optional.ml) (glob_files *optional.ml)) (action - (with-stdout-to ${@} + (with-stdout-to %{@} (run echo "let () = print_endline \"Hello World\"")))) diff --git a/test/blackbox-tests/test-cases/github568/dune b/test/blackbox-tests/test-cases/github568/dune index 36c7dda8..f833a349 100644 --- a/test/blackbox-tests/test-cases/github568/dune +++ b/test/blackbox-tests/test-cases/github568/dune @@ -8,7 +8,7 @@ (name runtest) (package lib1) (deps test1.exe) - (action (run ${<}))) + (action (run %{<}))) (executable (name test1) @@ -25,7 +25,7 @@ (name runtest) (package lib2) (deps test2.exe) - (action (run ${<}))) + (action (run %{<}))) (executable (name test2) diff --git a/test/blackbox-tests/test-cases/github660/explicit-interfaces/dune b/test/blackbox-tests/test-cases/github660/explicit-interfaces/dune index 46c34b74..a6b2e734 100644 --- a/test/blackbox-tests/test-cases/github660/explicit-interfaces/dune +++ b/test/blackbox-tests/test-cases/github660/explicit-interfaces/dune @@ -1,6 +1,6 @@ (alias (name runtest) (deps main.exe) - (action (run ${<}))) + (action (run %{<}))) (executable (name main)) diff --git a/test/blackbox-tests/test-cases/github660/no-interfaces/dune b/test/blackbox-tests/test-cases/github660/no-interfaces/dune index 46c34b74..a6b2e734 100644 --- a/test/blackbox-tests/test-cases/github660/no-interfaces/dune +++ b/test/blackbox-tests/test-cases/github660/no-interfaces/dune @@ -1,6 +1,6 @@ (alias (name runtest) (deps main.exe) - (action (run ${<}))) + (action (run %{<}))) (executable (name main)) diff --git a/test/blackbox-tests/test-cases/github784/dune b/test/blackbox-tests/test-cases/github784/dune index f5bc3213..240696ec 100644 --- a/test/blackbox-tests/test-cases/github784/dune +++ b/test/blackbox-tests/test-cases/github784/dune @@ -1 +1 @@ -(rule (run ${bin:echo} foo)) \ No newline at end of file +(rule (run %{bin:echo} foo)) \ No newline at end of file diff --git a/test/blackbox-tests/test-cases/inline_tests/dune-file/dune b/test/blackbox-tests/test-cases/inline_tests/dune-file/dune index e5010198..ec0c24c6 100644 --- a/test/blackbox-tests/test-cases/inline_tests/dune-file/dune +++ b/test/blackbox-tests/test-cases/inline_tests/dune-file/dune @@ -11,8 +11,8 @@ (echo "let () = print_int 42") (echo "\n") (echo "let () = print_int 43;;"))) - (flags (inline-test-runner ${library-name} - -source-tree-root ${ROOT} -diff-cmd -)))) + (flags (inline-test-runner %{library-name} + -source-tree-root %{ROOT} -diff-cmd -)))) (library (name foo_tests) @@ -21,4 +21,4 @@ (alias (name runtest) (deps foo.dune) - (action (echo "${read:foo.dune}"))) + (action (echo "%{read:foo.dune}"))) diff --git a/test/blackbox-tests/test-cases/inline_tests/run.t b/test/blackbox-tests/test-cases/inline_tests/run.t index 15b9c3d2..3646e4ae 100644 --- a/test/blackbox-tests/test-cases/inline_tests/run.t +++ b/test/blackbox-tests/test-cases/inline_tests/run.t @@ -28,9 +28,9 @@ ((runner_libraries (str)) (flags (inline-test-runner - ${library-name} + %{library-name} -source-tree-root - ${ROOT} + %{ROOT} -diff-cmd -)) (generate_runner diff --git a/test/blackbox-tests/test-cases/inline_tests/simple/dune b/test/blackbox-tests/test-cases/inline_tests/simple/dune index 813ba710..8e2f4f99 100644 --- a/test/blackbox-tests/test-cases/inline_tests/simple/dune +++ b/test/blackbox-tests/test-cases/inline_tests/simple/dune @@ -2,7 +2,7 @@ (name backend_simple) (modules ()) (inline_tests.backend - (generate_runner (run sed "s/(\\*TEST:\\(.*\\)\\*)/let () = \\1;;/" ${impl-files}) + (generate_runner (run sed "s/(\\*TEST:\\(.*\\)\\*)/let () = \\1;;/" %{impl-files}) ))) (library diff --git a/test/blackbox-tests/test-cases/lib-available/dune b/test/blackbox-tests/test-cases/lib-available/dune index eba6347f..695c0da3 100644 --- a/test/blackbox-tests/test-cases/lib-available/dune +++ b/test/blackbox-tests/test-cases/lib-available/dune @@ -1,7 +1,7 @@ (alias (name runtest) - (action (system "${lib-available:unix}"))) + (action (system "%{lib-available:unix}"))) (alias (name runtest) - (action (system "${lib-available:library-that-surely-doesnt-exist} && exit 1 || exit 0"))) + (action (system "%{lib-available:library-that-surely-doesnt-exist} && exit 1 || exit 0"))) diff --git a/test/blackbox-tests/test-cases/loop/dune b/test/blackbox-tests/test-cases/loop/dune index fe106138..5072e669 100644 --- a/test/blackbox-tests/test-cases/loop/dune +++ b/test/blackbox-tests/test-cases/loop/dune @@ -1,5 +1,5 @@ -(rule (copy ${read:x} a)) -(rule (copy ${read:y} b)) +(rule (copy %{read:x} a)) +(rule (copy %{read:y} b)) (rule (progn (run true) (with-stdout-to x (echo b)))) (rule (progn (run true) (with-stdout-to y (echo a)))) diff --git a/test/blackbox-tests/test-cases/merlin-tests/dune b/test/blackbox-tests/test-cases/merlin-tests/dune index dfba368f..d413b523 100644 --- a/test/blackbox-tests/test-cases/merlin-tests/dune +++ b/test/blackbox-tests/test-cases/merlin-tests/dune @@ -1,4 +1,4 @@ (alias (name print-merlins) (deps lib/.merlin exe/.merlin) - (action (run ./sanitize-dot-merlin/sanitize_dot_merlin.exe ${^}))) + (action (run ./sanitize-dot-merlin/sanitize_dot_merlin.exe %{^}))) diff --git a/test/blackbox-tests/test-cases/meta-gen/dune b/test/blackbox-tests/test-cases/meta-gen/dune index 2bba8274..91925536 100644 --- a/test/blackbox-tests/test-cases/meta-gen/dune +++ b/test/blackbox-tests/test-cases/meta-gen/dune @@ -43,4 +43,4 @@ (alias (name runtest) - (action (echo "${read:META.foobar}"))) + (action (echo "%{read:META.foobar}"))) diff --git a/test/blackbox-tests/test-cases/misc/blah/dune b/test/blackbox-tests/test-cases/misc/blah/dune index 5f0fe21f..b7c3feae 100644 --- a/test/blackbox-tests/test-cases/misc/blah/dune +++ b/test/blackbox-tests/test-cases/misc/blah/dune @@ -1,3 +1,3 @@ (alias (name runtest) - (deps ${SCOPE_ROOT}/023e1a58-4d08-11e7-a041-aa000008c8a6)) + (deps %{SCOPE_ROOT}/023e1a58-4d08-11e7-a041-aa000008c8a6)) diff --git a/test/blackbox-tests/test-cases/misc/dune b/test/blackbox-tests/test-cases/misc/dune index f2607d91..5fcce8de 100644 --- a/test/blackbox-tests/test-cases/misc/dune +++ b/test/blackbox-tests/test-cases/misc/dune @@ -1,17 +1,17 @@ -;; Test for ${^} with globs in rules +;; Test for %{^} with globs in rules (rule (targets result expected) (deps dune (glob_files *.txt)) (action (progn - (with-stdout-to result (echo ${^})) + (with-stdout-to result (echo %{^})) (with-stdout-to expected (echo "dune a.txt b.txt c.txt"))))) (rule (targets result2 expected2) (deps (source_tree sub-tree)) (action (progn - (with-stdout-to result2 (echo ${^})) + (with-stdout-to result2 (echo %{^})) (with-stdout-to expected2 (echo "sub-tree/a sub-tree/dir/b"))))) (alias @@ -31,21 +31,21 @@ (alias (name runtest) (deps dune dune-plop) - (action (run diff -u ${^}))) + (action (run diff -u %{^}))) ;; For some tests in subdirs (rule (with-stdout-to 023e1a58-4d08-11e7-a041-aa000008c8a6 (echo "plop"))) -;; Test for ${path-no-dep} +;; Test for %{path-no-dep} (rule (progn (with-stdout-to pnd-result (chdir sub-tree/dir (progn - (echo "${path-no-dep:file-that-doesn't-exist}\n") - (echo "${path-no-dep:.}\n")))) + (echo "%{path-no-dep:file-that-doesn't-exist}\n") + (echo "%{path-no-dep:.}\n")))) (with-stdout-to pnd-expected (progn (echo "../../file-that-doesn't-exist\n") @@ -54,7 +54,7 @@ (alias (name runtest) (deps pnd-result pnd-expected) - (action (run diff -u ${^}))) + (action (run diff -u %{^}))) ;; Test for globs diff --git a/test/blackbox-tests/test-cases/null-dep/dune b/test/blackbox-tests/test-cases/null-dep/dune index 5710ca42..be4bcd68 100644 --- a/test/blackbox-tests/test-cases/null-dep/dune +++ b/test/blackbox-tests/test-cases/null-dep/dune @@ -1,3 +1,3 @@ (alias (name runtest) - (action (with-stdout-to ${null} (echo "hello world")))) + (action (with-stdout-to %{null} (echo "hello world")))) diff --git a/test/blackbox-tests/test-cases/odoc/dune b/test/blackbox-tests/test-cases/odoc/dune index 5cb1a43a..382040bf 100644 --- a/test/blackbox-tests/test-cases/odoc/dune +++ b/test/blackbox-tests/test-cases/odoc/dune @@ -18,14 +18,14 @@ (alias (name runtest) (deps _doc/_html/index.html) - (action (echo "${read:_doc/_html/index.html}"))) + (action (echo "%{read:_doc/_html/index.html}"))) (alias (name foo-mld) (deps _doc/_mlds/foo/index.mld) - (action (echo "${read:_doc/_mlds/foo/index.mld}"))) + (action (echo "%{read:_doc/_mlds/foo/index.mld}"))) (alias (name bar-mld) (deps _doc/_mlds/bar/index.mld) - (action (echo "${read:_doc/_mlds/bar/index.mld}"))) + (action (echo "%{read:_doc/_mlds/bar/index.mld}"))) diff --git a/test/blackbox-tests/test-cases/output-obj/dune b/test/blackbox-tests/test-cases/output-obj/dune index 9ae247fb..f42c90f9 100644 --- a/test/blackbox-tests/test-cases/output-obj/dune +++ b/test/blackbox-tests/test-cases/output-obj/dune @@ -2,10 +2,10 @@ (name all) (deps test.bc test.exe - test.bc${ext_obj} - test.exe${ext_obj} - test.bc${ext_dll} - test${ext_dll} + test.bc%{ext_obj} + test.exe%{ext_obj} + test.bc%{ext_dll} + test%{ext_dll} static.bc static.exe)) @@ -20,20 +20,20 @@ (rule (targets static.exe) - (deps test.exe${ext_obj} static.c) - (action (run ${CC} -o ${@} -I ${ocaml_where} -I . ${^} - ${ocaml-config:native_c_libraries}))) + (deps test.exe%{ext_obj} static.c) + (action (run %{CC} -o %{@} -I %{ocaml_where} -I . %{^} + %{ocaml-config:native_c_libraries}))) (rule (targets static.bc) - (deps test.bc${ext_obj} static.c) - (action (run ${CC} -o ${@} -I ${ocaml_where} -I . ${^} - ${ocaml-config:bytecomp_c_libraries}))) + (deps test.bc%{ext_obj} static.c) + (action (run %{CC} -o %{@} -I %{ocaml_where} -I . %{^} + %{ocaml-config:bytecomp_c_libraries}))) (rule (targets dynamic.exe) (deps dynamic.c) - (action (run ${CC} -o ${@} ${<} ${ocaml-config:native_c_libraries}))) + (action (run %{CC} -o %{@} %{<} %{ocaml-config:native_c_libraries}))) (alias (name runtest) @@ -47,10 +47,10 @@ (alias (name runtest) - (deps test.bc${ext_dll}) - (action (run ./dynamic.exe ./${<}))) + (deps test.bc%{ext_dll}) + (action (run ./dynamic.exe ./%{<}))) (alias (name runtest) - (deps test${ext_dll}) - (action (run ./dynamic.exe ./${<}))) + (deps test%{ext_dll}) + (action (run ./dynamic.exe ./%{<}))) diff --git a/test/blackbox-tests/test-cases/quoting/bad/dune b/test/blackbox-tests/test-cases/quoting/bad/dune index 1d77fdde..498d90ab 100644 --- a/test/blackbox-tests/test-cases/quoting/bad/dune +++ b/test/blackbox-tests/test-cases/quoting/bad/dune @@ -1,3 +1,3 @@ (rule (targets x y) - (action (with-stdout-to ${@} (echo foo)))) \ No newline at end of file + (action (with-stdout-to %{@} (echo foo)))) \ No newline at end of file diff --git a/test/blackbox-tests/test-cases/quoting/filename-space/dune b/test/blackbox-tests/test-cases/quoting/filename-space/dune index af28301b..8cd3528b 100644 --- a/test/blackbox-tests/test-cases/quoting/filename-space/dune +++ b/test/blackbox-tests/test-cases/quoting/filename-space/dune @@ -1,8 +1,8 @@ (alias (name unquoted) - (action (echo ${read:foo bar.txt}))) + (action (echo %{read:foo bar.txt}))) (alias (name quoted) - (action (echo "${read:foo bar.txt}"))) \ No newline at end of file + (action (echo "%{read:foo bar.txt}"))) \ No newline at end of file diff --git a/test/blackbox-tests/test-cases/quoting/good/dune b/test/blackbox-tests/test-cases/quoting/good/dune index 81f3ce15..9f4961cf 100644 --- a/test/blackbox-tests/test-cases/quoting/good/dune +++ b/test/blackbox-tests/test-cases/quoting/good/dune @@ -1,3 +1,3 @@ (rule (targets s t) - (action (with-stdout-to "${@}" (echo foo)))) \ No newline at end of file + (action (with-stdout-to "%{@}" (echo foo)))) \ No newline at end of file diff --git a/test/blackbox-tests/test-cases/quoting/quote-from-context/dune b/test/blackbox-tests/test-cases/quoting/quote-from-context/dune index b9ccd43b..2dafb02f 100644 --- a/test/blackbox-tests/test-cases/quoting/quote-from-context/dune +++ b/test/blackbox-tests/test-cases/quoting/quote-from-context/dune @@ -3,4 +3,4 @@ (alias (name runtest) - (action (run ./count_args.exe ${read-lines:args}))) \ No newline at end of file + (action (run ./count_args.exe %{read-lines:args}))) \ No newline at end of file diff --git a/test/blackbox-tests/test-cases/quoting/quotes-multi/dune b/test/blackbox-tests/test-cases/quoting/quotes-multi/dune index 99e0cf28..c8e96519 100644 --- a/test/blackbox-tests/test-cases/quoting/quotes-multi/dune +++ b/test/blackbox-tests/test-cases/quoting/quotes-multi/dune @@ -1,4 +1,4 @@ (alias (name runtest) - (action (echo "lines: ${read-lines:foo}"))) \ No newline at end of file + (action (echo "lines: %{read-lines:foo}"))) \ No newline at end of file diff --git a/test/blackbox-tests/test-cases/quoting/run.t b/test/blackbox-tests/test-cases/quoting/run.t index acaab918..6a2f63e3 100644 --- a/test/blackbox-tests/test-cases/quoting/run.t +++ b/test/blackbox-tests/test-cases/quoting/run.t @@ -3,8 +3,8 @@ that ${@} is not quoted and doesn't contain exactly 1 element $ dune build --root bad x Entering directory 'bad' - File "dune", line 3, characters 25-29: - Error: Variable ${@} expands to 2 values, however a single value is expected here. Please quote this atom. + File "dune", line 3, characters 27-29: + Error: Variable %{@} expands to 2 values, however a single value is expected here. Please quote this atom. [1] The targets should only be interpreted as a single path when quoted @@ -26,9 +26,11 @@ The targets should only be interpreted as a single path when quoted lines: foo bar baz $ dune build @quoted --root filename-space - Entering directory 'filename-space' - filename contains spaces + File "dune", line 4, characters 17-18: + Error: This character not allowed inside %{...} forms + [1] $ dune build @unquoted --root filename-space - Entering directory 'filename-space' - ${read:foo bar.txt} + File "dune", line 4, characters 17-18: + Error: This character not allowed inside %{...} forms + [1] diff --git a/test/blackbox-tests/test-cases/reason/dune b/test/blackbox-tests/test-cases/reason/dune index fa080e7d..7abf6b9d 100644 --- a/test/blackbox-tests/test-cases/reason/dune +++ b/test/blackbox-tests/test-cases/reason/dune @@ -8,27 +8,27 @@ (lint (per_module ((pps (reasonppx (-lint true))) (hello cppome)) - ((action (run ./pp/reasononlypp.exe -lint ${<})) (foo bar pped)))) + ((action (run ./pp/reasononlypp.exe -lint %{<})) (foo bar pped)))) (preprocess (per_module ((pps (reasonppx)) (foo)) ((pps (reasonppx (-lint false))) (hello)) - ((action (run ./pp/reasononlypp.exe ${<})) (cppome)))))) + ((action (run ./pp/reasononlypp.exe %{<})) (cppome)))))) (executable ((name rbin) (modules (rbin)) - (lint (action (run ./pp/reasononlypp.exe -lint ${<}))) - (preprocess (action (run ./pp/reasononlypp.exe ${<}))) + (lint (action (run ./pp/reasononlypp.exe -lint %{<}))) + (preprocess (action (run ./pp/reasononlypp.exe %{<}))) (libraries (rlib)))) ;; we want to make sure that .rei files are present (alias ((name install-file) (deps (rlib.install)) - (action (echo "${read:rlib.install}")))) + (action (echo "%{read:rlib.install}")))) (alias ((name runtest) (deps (rbin.exe)) - (action (run ${<})))) + (action (run %{<})))) diff --git a/test/blackbox-tests/test-cases/redirections/dune b/test/blackbox-tests/test-cases/redirections/dune index 5ec8b509..d2facb4c 100644 --- a/test/blackbox-tests/test-cases/redirections/dune +++ b/test/blackbox-tests/test-cases/redirections/dune @@ -15,15 +15,15 @@ (rule (targets stdout.expected) - (action (with-stdout-to ${@} (echo "toto\n")))) + (action (with-stdout-to %{@} (echo "toto\n")))) (rule (targets stderr.expected) - (action (with-stdout-to ${@} (echo "titi\n")))) + (action (with-stdout-to %{@} (echo "titi\n")))) (rule (targets both.expected) - (action (with-stdout-to ${@} (echo "toto\ntiti\n")))) + (action (with-stdout-to %{@} (echo "toto\ntiti\n")))) (alias (name runtest) diff --git a/test/blackbox-tests/test-cases/select/dune b/test/blackbox-tests/test-cases/select/dune index 580f7de9..b577aa3b 100644 --- a/test/blackbox-tests/test-cases/select/dune +++ b/test/blackbox-tests/test-cases/select/dune @@ -11,4 +11,4 @@ (alias (name runtest) (deps main.exe) - (action (run ${<}))) + (action (run %{<}))) diff --git a/test/dune b/test/dune index 48afa9ba..db9d8658 100644 --- a/test/dune +++ b/test/dune @@ -51,27 +51,27 @@ Printf.fprintf (open_out Sys.argv.(2)) \"%g\n%!\" (Sys.time ()) (executable (name incr) (libraries unix)) -(rule (targets 01.foo) (action (run ./incr.exe x ${@}))) -(rule (targets 02.foo) (action (run ./incr.exe x ${@}))) -(rule (targets 03.foo) (action (run ./incr.exe x ${@}))) -(rule (targets 04.foo) (action (run ./incr.exe x ${@}))) -(rule (targets 05.foo) (action (run ./incr.exe x ${@}))) -(rule (targets 06.foo) (action (run ./incr.exe x ${@}))) -(rule (targets 07.foo) (action (run ./incr.exe x ${@}))) -(rule (targets 08.foo) (action (run ./incr.exe x ${@}))) -(rule (targets 09.foo) (action (run ./incr.exe x ${@}))) -(rule (targets 10.foo) (action (run ./incr.exe x ${@}))) +(rule (targets 01.foo) (action (run ./incr.exe x %{@}))) +(rule (targets 02.foo) (action (run ./incr.exe x %{@}))) +(rule (targets 03.foo) (action (run ./incr.exe x %{@}))) +(rule (targets 04.foo) (action (run ./incr.exe x %{@}))) +(rule (targets 05.foo) (action (run ./incr.exe x %{@}))) +(rule (targets 06.foo) (action (run ./incr.exe x %{@}))) +(rule (targets 07.foo) (action (run ./incr.exe x %{@}))) +(rule (targets 08.foo) (action (run ./incr.exe x %{@}))) +(rule (targets 09.foo) (action (run ./incr.exe x %{@}))) +(rule (targets 10.foo) (action (run ./incr.exe x %{@}))) -(rule (targets 01.bar) (action (run ./incr.exe y ${@})) (locks m)) -(rule (targets 02.bar) (action (run ./incr.exe y ${@})) (locks m)) -(rule (targets 03.bar) (action (run ./incr.exe y ${@})) (locks m)) -(rule (targets 04.bar) (action (run ./incr.exe y ${@})) (locks m)) -(rule (targets 05.bar) (action (run ./incr.exe y ${@})) (locks m)) -(rule (targets 06.bar) (action (run ./incr.exe y ${@})) (locks m)) -(rule (targets 07.bar) (action (run ./incr.exe y ${@})) (locks m)) -(rule (targets 08.bar) (action (run ./incr.exe y ${@})) (locks m)) -(rule (targets 09.bar) (action (run ./incr.exe y ${@})) (locks m)) -(rule (targets 10.bar) (action (run ./incr.exe y ${@})) (locks m)) +(rule (targets 01.bar) (action (run ./incr.exe y %{@})) (locks m)) +(rule (targets 02.bar) (action (run ./incr.exe y %{@})) (locks m)) +(rule (targets 03.bar) (action (run ./incr.exe y %{@})) (locks m)) +(rule (targets 04.bar) (action (run ./incr.exe y %{@})) (locks m)) +(rule (targets 05.bar) (action (run ./incr.exe y %{@})) (locks m)) +(rule (targets 06.bar) (action (run ./incr.exe y %{@})) (locks m)) +(rule (targets 07.bar) (action (run ./incr.exe y %{@})) (locks m)) +(rule (targets 08.bar) (action (run ./incr.exe y %{@})) (locks m)) +(rule (targets 09.bar) (action (run ./incr.exe y %{@})) (locks m)) +(rule (targets 10.bar) (action (run ./incr.exe y %{@})) (locks m)) (alias (name runtest-no-deps) diff --git a/test/unit-tests/configurator/dune b/test/unit-tests/configurator/dune index 72cd97b0..13f1fc96 100644 --- a/test/unit-tests/configurator/dune +++ b/test/unit-tests/configurator/dune @@ -5,4 +5,4 @@ (alias (name runtest) (deps ./test_configurator.exe) - (action (run ${<}))) + (action (run %{<}))) diff --git a/test/unit-tests/dune b/test/unit-tests/dune index 3111c4aa..42e50646 100644 --- a/test/unit-tests/dune +++ b/test/unit-tests/dune @@ -19,71 +19,71 @@ (alias (name runtest) (deps tests.mlt - (glob_files ${SCOPE_ROOT}/src/.dune.objs/*.cmi) - (glob_files ${SCOPE_ROOT}/src/stdune/.stdune.objs/*.cmi) - (source_tree toolchain.d) - (source_tree findlib-db)) - (action (chdir ${SCOPE_ROOT} + (glob_files %{SCOPE_ROOT}/src/.dune.objs/*.cmi) + (glob_files %{SCOPE_ROOT}/src/stdune/.stdune.objs/*.cmi) + (source_tree toolchain.d) + (source_tree findlib-db)) + (action (chdir %{SCOPE_ROOT} (progn - (run ${exe:expect_test.exe} ${<}) - (diff? ${<} ${<}.corrected))))) + (run %{exe:expect_test.exe} %{<}) + (diff? %{<} %{<}.corrected))))) (alias (name runtest) (deps filename.mlt - (glob_files ${SCOPE_ROOT}/src/.dune.objs/*.cmi) - (glob_files ${SCOPE_ROOT}/src/stdune/.stdune.objs/*.cmi)) - (action (chdir ${SCOPE_ROOT} + (glob_files %{SCOPE_ROOT}/src/.dune.objs/*.cmi) + (glob_files %{SCOPE_ROOT}/src/stdune/.stdune.objs/*.cmi)) + (action (chdir %{SCOPE_ROOT} (progn - (run ${exe:expect_test.exe} ${<}) - (diff? ${<} ${<}.corrected))))) + (run %{exe:expect_test.exe} %{<}) + (diff? %{<} %{<}.corrected))))) (alias (name runtest) (deps import_dot_map.mlt - (glob_files ${SCOPE_ROOT}/src/.dune.objs/*.cmi) - (glob_files ${SCOPE_ROOT}/src/stdune/.stdune.objs/*.cmi)) - (action (chdir ${SCOPE_ROOT} + (glob_files %{SCOPE_ROOT}/src/.dune.objs/*.cmi) + (glob_files %{SCOPE_ROOT}/src/stdune/.stdune.objs/*.cmi)) + (action (chdir %{SCOPE_ROOT} (progn - (run ${exe:expect_test.exe} ${<}) - (diff? ${<} ${<}.corrected))))) + (run %{exe:expect_test.exe} %{<}) + (diff? %{<} %{<}.corrected))))) (alias (name runtest) (deps action.mlt - (glob_files ${SCOPE_ROOT}/src/.dune.objs/*.cmi) - (glob_files ${SCOPE_ROOT}/src/stdune/.stdune.objs/*.cmi)) - (action (chdir ${SCOPE_ROOT} + (glob_files %{SCOPE_ROOT}/src/.dune.objs/*.cmi) + (glob_files %{SCOPE_ROOT}/src/stdune/.stdune.objs/*.cmi)) + (action (chdir %{SCOPE_ROOT} (progn - (run ${exe:expect_test.exe} ${<}) - (diff? ${<} ${<}.corrected))))) + (run %{exe:expect_test.exe} %{<}) + (diff? %{<} %{<}.corrected))))) (alias (name runtest) (deps path.mlt - (glob_files ${SCOPE_ROOT}/src/.dune.objs/*.cmi) - (glob_files ${SCOPE_ROOT}/src/stdune/.stdune.objs/*.cmi)) - (action (chdir ${SCOPE_ROOT} + (glob_files %{SCOPE_ROOT}/src/.dune.objs/*.cmi) + (glob_files %{SCOPE_ROOT}/src/stdune/.stdune.objs/*.cmi)) + (action (chdir %{SCOPE_ROOT} (progn - (run ${exe:expect_test.exe} ${<}) - (diff? ${<} ${<}.corrected))))) + (run %{exe:expect_test.exe} %{<}) + (diff? %{<} %{<}.corrected))))) (alias (name runtest) (deps sexp.mlt - (glob_files ${SCOPE_ROOT}/src/.dune.objs/*.cmi) - (glob_files ${SCOPE_ROOT}/src/stdune/.stdune.objs/*.cmi)) - (action (chdir ${SCOPE_ROOT} + (glob_files %{SCOPE_ROOT}/src/.dune.objs/*.cmi) + (glob_files %{SCOPE_ROOT}/src/stdune/.stdune.objs/*.cmi)) + (action (chdir %{SCOPE_ROOT} (progn - (run ${exe:expect_test.exe} ${<}) - (diff? ${<} ${<}.corrected))))) + (run %{exe:expect_test.exe} %{<}) + (diff? %{<} %{<}.corrected))))) (alias (name runtest) (deps jbuild.mlt - (glob_files ${SCOPE_ROOT}/src/.dune.objs/*.cmi) - (glob_files ${SCOPE_ROOT}/src/stdune/.stdune.objs/*.cmi)) - (action (chdir ${SCOPE_ROOT} + (glob_files %{SCOPE_ROOT}/src/.dune.objs/*.cmi) + (glob_files %{SCOPE_ROOT}/src/stdune/.stdune.objs/*.cmi)) + (action (chdir %{SCOPE_ROOT} (progn - (run ${exe:expect_test.exe} ${<}) - (diff? ${<} ${<}.corrected))))) + (run %{exe:expect_test.exe} %{<}) + (diff? %{<} %{<}.corrected))))) diff --git a/test/unit-tests/ocaml-config/dune b/test/unit-tests/ocaml-config/dune index 61877401..05f8ec00 100644 --- a/test/unit-tests/ocaml-config/dune +++ b/test/unit-tests/ocaml-config/dune @@ -5,4 +5,4 @@ (alias (name runtest) (deps ./gh637.exe) - (action (run ${<}))) + (action (run %{<})))