From 90cde684e6f8cd8fcf485945e5dfa66d52ceaee1 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Fri, 6 Jul 2018 00:29:34 +0700 Subject: [PATCH 01/36] Remove uppercase vars in dune files While maintaing them in jbuild files (with proper error messages) Signed-off-by: Rudi Grinberg --- src/super_context.ml | 82 ++++++++++++++++++++++++++++---------------- 1 file changed, 52 insertions(+), 30 deletions(-) diff --git a/src/super_context.ml b/src/super_context.ml index fef59a01..48d2cfcd 100644 --- a/src/super_context.ml +++ b/src/super_context.ml @@ -46,6 +46,7 @@ type t = ; stanzas_to_consider_for_install : Installable.t list ; cxx_flags : string list ; vars : Value.t list String.Map.t + ; uppercase_vars : Value.t list String.Map.t ; chdir : (Action.t, Action.t) Build.t ; host : t option ; libs_by_package : (Package.t * Lib.Set.t) Package.Name.Map.t @@ -84,7 +85,19 @@ let installed_libs t = t.installed_libs let find_scope_by_dir t dir = Scope.DB.find_by_dir t.scopes dir let find_scope_by_name t name = Scope.DB.find_by_name t.scopes name -let expand_var_no_root t var = String.Map.find t.vars var +let expand_var_no_root t loc syntax_version var = + match String.Map.find t.vars var with + | Some _ as v -> v + | None -> + begin match String.Map.find t.uppercase_vars var with + | None -> None + | Some _ as v -> + if syntax_version < (1, 0) then + v + else + Loc.fail loc "Uppercase variables are removed in dune files. Use: %%{%s}" + (String.lowercase var) + end let (expand_vars, expand_vars_path) = let expand t ~scope ~dir ?(extra_vars=String.Map.empty) s = @@ -101,7 +114,9 @@ let (expand_vars, expand_vars_path) = | "project_root" when syntax_version >= (1, 0) -> Some [Value.Path (Scope.root scope)] | var -> - (match expand_var_no_root t var with + (match + expand_var_no_root t (String_with_vars.Var.loc v) syntax_version var + with | Some _ as x -> x | None -> String.Map.find extra_vars var)) in @@ -280,7 +295,7 @@ let create List.filter context.ocamlc_cflags ~f:(fun s -> not (String.is_prefix s ~prefix:"-std=")) in - let vars = + let (vars, uppercase_vars) = let ocamlopt = match context.ocamlopt with | None -> Path.relative context.ocaml_bin "ocamlopt" @@ -295,30 +310,38 @@ let create in let cflags = context.ocamlc_cflags in let strings = Value.L.strings in + let lowercased = + [ "cpp" , strings (context.c_compiler :: cflags @ ["-E"]) + ; "cc" , strings (context.c_compiler :: cflags) + ; "cxx" , strings (context.c_compiler :: cxx_flags) + ; "ocaml" , path context.ocaml + ; "ocamlc" , path context.ocamlc + ; "ocamlopt" , path ocamlopt + ; "arch_sixtyfour" , string (string_of_bool context.arch_sixtyfour) + ; "make" , make + ] in let vars = - [ "-verbose" , [] - ; "CPP" , strings (context.c_compiler :: cflags @ ["-E"]) - ; "PA_CPP" , strings (context.c_compiler :: cflags - @ ["-undef"; "-traditional"; - "-x"; "c"; "-E"]) - ; "CC" , strings (context.c_compiler :: cflags) - ; "CXX" , strings (context.c_compiler :: cxx_flags) - ; "ocaml_bin" , path context.ocaml_bin - ; "OCAML" , path context.ocaml - ; "OCAMLC" , path context.ocamlc - ; "OCAMLOPT" , path ocamlopt - ; "ocaml_version" , string context.version_string - ; "ocaml_where" , string (Path.to_string context.stdlib_dir) - ; "ARCH_SIXTYFOUR" , string (string_of_bool context.arch_sixtyfour) - ; "MAKE" , make - ; "null" , string (Path.to_string Config.dev_null) - ; "ext_obj" , string context.ext_obj - ; "ext_asm" , string context.ext_asm - ; "ext_lib" , string context.ext_lib - ; "ext_dll" , string context.ext_dll - ; "ext_exe" , string context.ext_exe - ; "profile" , string context.profile - ] + lowercased + @ [ "-verbose" , [] + ; "pa_cpp" , strings (context.c_compiler :: cflags + @ ["-undef"; "-traditional"; + "-x"; "c"; "-E"]) + ; "ocaml_bin" , path context.ocaml_bin + ; "ocaml_version" , string context.version_string + ; "ocaml_where" , string (Path.to_string context.stdlib_dir) + ; "null" , string (Path.to_string Config.dev_null) + ; "ext_obj" , string context.ext_obj + ; "ext_asm" , string context.ext_asm + ; "ext_lib" , string context.ext_lib + ; "ext_dll" , string context.ext_dll + ; "ext_exe" , string context.ext_exe + ; "profile" , string context.profile + ] + in + let uppercase_vars = + lowercased + |> List.map ~f:(fun (k, v) -> (String.uppercase k, v)) + |> String.Map.of_list_exn in let vars = vars @ @@ -331,9 +354,7 @@ let create | Words x -> strings x | Prog_and_args x -> strings (x.prog :: x.args))) in - match String.Map.of_list vars with - | Ok x -> x - | Error _ -> assert false + (String.Map.of_list_exn vars, uppercase_vars) in let t = { context @@ -348,6 +369,7 @@ let create ; stanzas_to_consider_for_install ; artifacts ; cxx_flags + ; uppercase_vars ; vars ; chdir = Build.arr (fun (action : Action.t) -> match action with @@ -743,7 +765,7 @@ module Action = struct add_ddep acc ~key data end | _ -> - match expand_var_no_root sctx key with + match expand_var_no_root sctx loc syntax_version key with | Some _ as x -> x | None -> String.Map.find extra_vars key in From f2f0d240c4b5a9faa506a3e5040adec4d10f1b68 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Fri, 6 Jul 2018 00:30:05 +0700 Subject: [PATCH 02/36] Add tests for lower/uppercase vars Signed-off-by: Rudi Grinberg --- test/blackbox-tests/dune.inc | 10 ++++++++++ .../dune-jbuild-var-case/dune-lower/dune | 3 +++ .../dune-lower/dune-project | 1 + .../dune-jbuild-var-case/dune-upper/dune | 3 +++ .../dune-upper/dune-project | 1 + .../dune-jbuild-var-case/jbuilder-lower/jbuild | 3 +++ .../dune-jbuild-var-case/jbuilder-upper/jbuild | 3 +++ .../test-cases/dune-jbuild-var-case/run.t | 18 ++++++++++++++++++ 8 files changed, 42 insertions(+) create mode 100644 test/blackbox-tests/test-cases/dune-jbuild-var-case/dune-lower/dune create mode 100644 test/blackbox-tests/test-cases/dune-jbuild-var-case/dune-lower/dune-project create mode 100644 test/blackbox-tests/test-cases/dune-jbuild-var-case/dune-upper/dune create mode 100644 test/blackbox-tests/test-cases/dune-jbuild-var-case/dune-upper/dune-project create mode 100644 test/blackbox-tests/test-cases/dune-jbuild-var-case/jbuilder-lower/jbuild create mode 100644 test/blackbox-tests/test-cases/dune-jbuild-var-case/jbuilder-upper/jbuild create mode 100644 test/blackbox-tests/test-cases/dune-jbuild-var-case/run.t diff --git a/test/blackbox-tests/dune.inc b/test/blackbox-tests/dune.inc index 56093c94..89ee0193 100644 --- a/test/blackbox-tests/dune.inc +++ b/test/blackbox-tests/dune.inc @@ -88,6 +88,14 @@ test-cases/depend-on-the-universe (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))) +(alias + (name dune-jbuild-var-case) + (deps (package dune) (source_tree test-cases/dune-jbuild-var-case)) + (action + (chdir + test-cases/dune-jbuild-var-case + (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))) + (alias (name dune-ppx-driver-system) (deps (package dune) (source_tree test-cases/dune-ppx-driver-system)) @@ -641,6 +649,7 @@ (alias cross-compilation) (alias custom-build-dir) (alias depend-on-the-universe) + (alias dune-jbuild-var-case) (alias dune-ppx-driver-system) (alias dune-project-edition) (alias env) @@ -718,6 +727,7 @@ (alias cross-compilation) (alias custom-build-dir) (alias depend-on-the-universe) + (alias dune-jbuild-var-case) (alias dune-ppx-driver-system) (alias dune-project-edition) (alias env) diff --git a/test/blackbox-tests/test-cases/dune-jbuild-var-case/dune-lower/dune b/test/blackbox-tests/test-cases/dune-jbuild-var-case/dune-lower/dune new file mode 100644 index 00000000..343bdb81 --- /dev/null +++ b/test/blackbox-tests/test-cases/dune-jbuild-var-case/dune-lower/dune @@ -0,0 +1,3 @@ +(alias + (name runtest) + (action (with-stdout-to %{null} (echo %{make})))) \ No newline at end of file diff --git a/test/blackbox-tests/test-cases/dune-jbuild-var-case/dune-lower/dune-project b/test/blackbox-tests/test-cases/dune-jbuild-var-case/dune-lower/dune-project new file mode 100644 index 00000000..b2559fa0 --- /dev/null +++ b/test/blackbox-tests/test-cases/dune-jbuild-var-case/dune-lower/dune-project @@ -0,0 +1 @@ +(lang dune 1.0) \ No newline at end of file diff --git a/test/blackbox-tests/test-cases/dune-jbuild-var-case/dune-upper/dune b/test/blackbox-tests/test-cases/dune-jbuild-var-case/dune-upper/dune new file mode 100644 index 00000000..f6be7174 --- /dev/null +++ b/test/blackbox-tests/test-cases/dune-jbuild-var-case/dune-upper/dune @@ -0,0 +1,3 @@ +(alias + (name runtest) + (action (with-stdout-to %{null} (echo %{MAKE})))) \ No newline at end of file diff --git a/test/blackbox-tests/test-cases/dune-jbuild-var-case/dune-upper/dune-project b/test/blackbox-tests/test-cases/dune-jbuild-var-case/dune-upper/dune-project new file mode 100644 index 00000000..b2559fa0 --- /dev/null +++ b/test/blackbox-tests/test-cases/dune-jbuild-var-case/dune-upper/dune-project @@ -0,0 +1 @@ +(lang dune 1.0) \ No newline at end of file diff --git a/test/blackbox-tests/test-cases/dune-jbuild-var-case/jbuilder-lower/jbuild b/test/blackbox-tests/test-cases/dune-jbuild-var-case/jbuilder-lower/jbuild new file mode 100644 index 00000000..04a36be2 --- /dev/null +++ b/test/blackbox-tests/test-cases/dune-jbuild-var-case/jbuilder-lower/jbuild @@ -0,0 +1,3 @@ +(alias + ((name runtest) + (action (with-stdout-to ${null} (echo ${make}))))) diff --git a/test/blackbox-tests/test-cases/dune-jbuild-var-case/jbuilder-upper/jbuild b/test/blackbox-tests/test-cases/dune-jbuild-var-case/jbuilder-upper/jbuild new file mode 100644 index 00000000..7132e12f --- /dev/null +++ b/test/blackbox-tests/test-cases/dune-jbuild-var-case/jbuilder-upper/jbuild @@ -0,0 +1,3 @@ +(alias + ((name runtest) + (action (with-stdout-to ${null} (echo ${MAKE}))))) diff --git a/test/blackbox-tests/test-cases/dune-jbuild-var-case/run.t b/test/blackbox-tests/test-cases/dune-jbuild-var-case/run.t new file mode 100644 index 00000000..0c73c331 --- /dev/null +++ b/test/blackbox-tests/test-cases/dune-jbuild-var-case/run.t @@ -0,0 +1,18 @@ +All builtin variables are lower cased in Dune: + + $ dune runtest --root dune-lower + Entering directory 'dune-lower' + + $ dune runtest --root dune-upper + Entering directory 'dune-upper' + File "dune", line 3, characters 41-46: + Error: Uppercase variables are removed in dune files. Use: %{make} + [1] + +jbuilder retains the old names: + + $ jbuilder runtest --root jbuilder-upper + Entering directory 'jbuilder-upper' + + $ jbuilder runtest --root jbuilder-upper + Entering directory 'jbuilder-upper' From 9d7107d8316cd3f6725a110ace66e018c44a0229 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Fri, 6 Jul 2018 00:37:49 +0700 Subject: [PATCH 03/36] Add renamed vars to migration Signed-off-by: Rudi Grinberg --- doc/migration.rst | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/doc/migration.rst b/doc/migration.rst index c6d4bd89..a50fd0cb 100644 --- a/doc/migration.rst +++ b/doc/migration.rst @@ -173,6 +173,14 @@ Jbuild Dune ``${path:file}`` ``%{dep:file}`` ``${SCOPE_ROOT}`` ``%{project_root}`` ``${findlib:..}`` ``%{lib:..}`` +``${CPP}`` ``%{cpp}`` +``${CC}`` ``%{cc}`` +``${CXX}`` ``%{cxx}`` +``${OCAML}`` ``%{ocaml}`` +``${OCAMLC}`` ``%{ocamlc}`` +``${OCAMLOPT}`` ``%{ocamlopt}`` +``${ARCH_SIXTYFOUR}`` ``%{arch_sixtyfour}`` +``${MAKE}`` ``%{make}`` ======================== ============ Removed Variables From 998ff8ce8c59d42aca33d99b9296839a0cd87643 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Fri, 6 Jul 2018 19:27:31 +0700 Subject: [PATCH 04/36] Clarify rename test Signed-off-by: Rudi Grinberg --- test/blackbox-tests/test-cases/dune-jbuild-var-case/run.t | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/test/blackbox-tests/test-cases/dune-jbuild-var-case/run.t b/test/blackbox-tests/test-cases/dune-jbuild-var-case/run.t index 0c73c331..49e77824 100644 --- a/test/blackbox-tests/test-cases/dune-jbuild-var-case/run.t +++ b/test/blackbox-tests/test-cases/dune-jbuild-var-case/run.t @@ -9,10 +9,10 @@ All builtin variables are lower cased in Dune: Error: Uppercase variables are removed in dune files. Use: %{make} [1] -jbuilder retains the old names: +jbuild files retain the the old names: - $ jbuilder runtest --root jbuilder-upper + $ dune runtest --root jbuilder-upper Entering directory 'jbuilder-upper' - $ jbuilder runtest --root jbuilder-upper + $ dune runtest --root jbuilder-upper Entering directory 'jbuilder-upper' From 1a37977f628e3061c48447df6f2103a5c0df3235 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Fri, 6 Jul 2018 19:32:46 +0700 Subject: [PATCH 05/36] Fix error message Signed-off-by: Rudi Grinberg --- src/super_context.ml | 3 ++- test/blackbox-tests/test-cases/dune-jbuild-var-case/run.t | 3 ++- 2 files changed, 4 insertions(+), 2 deletions(-) diff --git a/src/super_context.ml b/src/super_context.ml index 48d2cfcd..126c3568 100644 --- a/src/super_context.ml +++ b/src/super_context.ml @@ -95,7 +95,8 @@ let expand_var_no_root t loc syntax_version var = if syntax_version < (1, 0) then v else - Loc.fail loc "Uppercase variables are removed in dune files. Use: %%{%s}" + Loc.fail loc "Uppercase variables are removed in dune files.@.\ + Hint: Did you mean %%{%s} instead?" (String.lowercase var) end diff --git a/test/blackbox-tests/test-cases/dune-jbuild-var-case/run.t b/test/blackbox-tests/test-cases/dune-jbuild-var-case/run.t index 49e77824..cda97388 100644 --- a/test/blackbox-tests/test-cases/dune-jbuild-var-case/run.t +++ b/test/blackbox-tests/test-cases/dune-jbuild-var-case/run.t @@ -6,7 +6,8 @@ All builtin variables are lower cased in Dune: $ dune runtest --root dune-upper Entering directory 'dune-upper' File "dune", line 3, characters 41-46: - Error: Uppercase variables are removed in dune files. Use: %{make} + Error: Uppercase variables are removed in dune files. + Hint: Did you mean %{make} instead? [1] jbuild files retain the the old names: From a0a92d9adb820d1d332e3b06608a69d7b208329a Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Fri, 6 Jul 2018 21:47:54 +0700 Subject: [PATCH 06/36] Introduce a Dir primitive to Value This is like Path but users will know not to infer dependencies from it Signed-off-by: Rudi Grinberg --- src/action.ml | 3 +++ src/super_context.ml | 2 +- src/value.ml | 6 +++++- src/value.mli | 3 ++- 4 files changed, 11 insertions(+), 3 deletions(-) diff --git a/src/action.ml b/src/action.ml index fbf63064..6a7f86dc 100644 --- a/src/action.ml +++ b/src/action.ml @@ -337,6 +337,9 @@ end let prog_and_args_of_values p ~dir = match p with | [] -> (Unresolved.Program.Search "", []) + | Value.Dir p :: _ -> + die "%s is a directory and cannot be used as an executable" + (Path.to_string_maybe_quoted p) | Value.Path p :: xs -> (This p, Value.L.to_strings ~dir xs) | String s :: xs -> (Unresolved.Program.of_string ~dir s, Value.L.to_strings ~dir xs) diff --git a/src/super_context.ml b/src/super_context.ml index 126c3568..262578bd 100644 --- a/src/super_context.ml +++ b/src/super_context.ml @@ -817,7 +817,7 @@ module Action = struct let exp = expand var syntax_version in Option.iter exp ~f:(fun vs -> acc.sdeps <- Path.Set.union (Path.Set.of_list - (Value.L.paths_only vs)) acc.sdeps; + (Value.L.deps_only vs)) acc.sdeps; ); exp) in diff --git a/src/value.ml b/src/value.ml index 9d8cf9fd..3dfe7a54 100644 --- a/src/value.ml +++ b/src/value.ml @@ -2,6 +2,7 @@ open Stdune type t = | String of string + | Dir of Path.t | Path of Path.t let string_of_path ~dir p = Path.reach ~from:dir p @@ -9,11 +10,13 @@ let string_of_path ~dir p = Path.reach ~from:dir p let to_string t ~dir = match t with | String s -> s + | Dir p | Path p -> string_of_path ~dir p let to_path ?error_loc t ~dir = match t with | String s -> Path.relative ?error_loc dir s + | Dir p | Path p -> p module L = struct @@ -23,8 +26,9 @@ module L = struct List.map ~f:(to_string ~dir) ts |> String.concat ~sep:" " - let paths_only = + let deps_only = List.filter_map ~f:(function + | Dir _ | String _ -> None | Path p -> Some p) diff --git a/src/value.mli b/src/value.mli index d2a7b845..9f374642 100644 --- a/src/value.mli +++ b/src/value.mli @@ -2,6 +2,7 @@ open Stdune type t = | String of string + | Dir of Path.t | Path of Path.t val to_string : t -> dir:Path.t -> string @@ -13,7 +14,7 @@ module L : sig val paths : Path.t list -> t list - val paths_only : t list -> Path.t list + val deps_only : t list -> Path.t list val concat : t list -> dir:Path.t -> string From 54ff98b36dd21683594c103ef50703d5d06bd0c2 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Fri, 6 Jul 2018 21:49:02 +0700 Subject: [PATCH 07/36] Rename ROOT to root Signed-off-by: Rudi Grinberg --- doc/dune-files.rst | 96 +++++++++---------- src/jbuild.ml | 4 +- src/menhir.ml | 2 +- src/preprocessing.ml | 2 +- src/super_context.ml | 3 +- .../test-cases/aliases/src/dune | 2 +- .../test-cases/aliases/src/foo/bar/dune | 2 +- .../test-cases/aliases/src/foo/baz/dune | 2 +- .../test-cases/inline_tests/dune-file/dune | 2 +- .../test-cases/inline_tests/run.t | 2 +- 10 files changed, 58 insertions(+), 59 deletions(-) diff --git a/doc/dune-files.rst b/doc/dune-files.rst index 265902ea..68dc9f79 100644 --- a/doc/dune-files.rst +++ b/doc/dune-files.rst @@ -22,7 +22,7 @@ Stanzas (rule (targets foo.ml) (deps generator/gen.exe) - (action (run ${<} -o ${@}))) + (action (run %{<} -o %{@}))) The following sections describe the available stanzas and their meaning. @@ -336,16 +336,16 @@ compilation mode binary kind extensions ---------------- ------------- ----------------- byte exe .bc and .bc.js native/best exe .exe -byte object .bc${ext_obj} -native/best object .exe${ext_obj} -byte shared_object .bc${ext_dll} -native/best shared_object ${ext_dll} +byte object .bc%{ext_obj} +native/best object .exe%{ext_obj} +byte shared_object .bc%{ext_dll} +native/best shared_object %{ext_dll} ================ ============= ================= -Where ``${ext_obj}`` and ``${ext_dll}`` are the extensions for object +Where ``%{ext_obj}`` and ``%{ext_dll}`` are the extensions for object and shared object files. Their value depends on the OS, for instance -on Unix ``${ext_obj}`` is usually ``.o`` and ``${ext_dll}`` is usually -``.so`` while on Windows ``${ext_obj}`` is ``.obj`` and ``${ext_dll}`` +on Unix ``%{ext_obj}`` is usually ``.o`` and ``%{ext_dll}`` is usually +``.so`` while on Windows ``%{ext_obj}`` is ``.obj`` and ``%{ext_dll}`` is ``.dll``. Note that when ``(byte exe)`` is specified but neither ``(best exe)`` @@ -459,7 +459,7 @@ For instance: (rule (targets b (deps a - (action (copy ${<} ${@}))))) + (action (copy %{<} %{@}))))) In this example it is obvious by inspecting the action what the dependencies and targets are. When this is the case you can use the @@ -483,7 +483,7 @@ stanza is rejected by dune: .. code:: scheme - (rule (copy a b.${read:file})) + (rule (copy a b.%{read:file})) ocamllex -------- @@ -495,7 +495,7 @@ ocamllex (rule (targets .ml) (deps .mll) - (action (chdir ${ROOT} (run ${bin:ocamllex} -q -o ${<})))) + (action (chdir %{root} (run %{bin:ocamllex} -q -o %{<})))) To use a different rule mode, use the long form: @@ -515,7 +515,7 @@ ocamlyacc (rule (targets .ml .mli) (deps .mly) - (action (chdir ${ROOT} (run ${bin:ocamlyacc} ${<})))) + (action (chdir %{root} (run %{bin:ocamlyacc} %{<})))) To use a different rule mode, use the long form: @@ -573,7 +573,7 @@ The typical use of the ``alias`` stanza is to define tests: (alias (name runtest) - (action (run ${exe:my-test-program.exe} blah))) + (action (run %{exe:my-test-program.exe} blah))) See the section about :ref:`running-tests` for details. @@ -825,18 +825,18 @@ Variables are expanded after the set language is interpreted. Variables expansion ------------------- -Some fields can contains variables of the form ``$(var)`` or ``${var}`` that are +Some fields can contains variables of the form ``$(var)`` or ``%{var}`` that are expanded by dune. Dune supports the following variables: -- ``ROOT`` is the relative path to the root of the build - context. Note that ``ROOT`` depends on the worksace - configuration. As such you shouldn't use ``ROOT`` to denote the - root of your project. Use ``SCOPE_ROOT`` instead for this purpose -- ``SCOPE_ROOT`` is the root of the current scope. It is typically +- ``root`` is the relative path to the root of the build + context. Note that ``root`` depends on the workspace + configuration. As such you shouldn't use ``root`` to denote the + root of your project. Use ``project_root`` instead for this purpose +- ``project_root`` is the root of the current scope. It is typically the toplevel directory of your project and as long as you have at - least one ``.opam`` file there, ``SCOPE_ROOT`` is + least one ``.opam`` file there, ``project_root`` is independent of the workspace configuration - ``CC`` is the C compiler command line (list made of the compiler name followed by its flags) that was used to compile OCaml in the @@ -844,13 +844,13 @@ Dune supports the following variables: - ``CXX`` is the C++ compiler command line being used in the current build context - ``ocaml_bin`` is the path where ``ocamlc`` lives -- ``OCAML`` is the ``ocaml`` binary -- ``OCAMLC`` is the ``ocamlc`` binary -- ``OCAMLOPT`` is the ``ocamlopt`` binary +- ``ocaml`` is the ``ocaml`` binary +- ``ocamlc`` is the ``ocamlc`` binary +- ``ocamlopt`` is the ``ocamlopt`` binary - ``ocaml_version`` is the version of the compiler used in the current build context - ``ocaml_where`` is the output of ``ocamlc -where`` -- ``ARCH_SIXTYFOUR`` is ``true`` if using a compiler targeting a +- ``arch_sixtyfour`` is ``true`` if using a compiler targeting a 64 bit architecture and ``false`` otherwise - ``null`` is ``/dev/null`` on Unix or ``nul`` on Windows - ``ext_obj``, ``ext_asm``, ``ext_lib``, ``ext_dll`` and ``ext_exe`` @@ -878,8 +878,8 @@ In addition, ``(action ...)`` fields support the following special variables: is installed by a package in the workspace (see `install`_ stanzas), the locally built binary will be used, otherwise it will be searched in the ``PATH`` of the current build context. Note that ``(run - ${bin:program} ...)`` and ``(run program ...)`` behave in the same - way. ``${bin:...}`` is only necessary when you are using ``(bash + %{bin:program} ...)`` and ``(run program ...)`` behave in the same + way. ``%{bin:...}`` is only necessary when you are using ``(bash ...)`` or ``(system ...)`` - ``lib::`` expands to a path to file ```` of library ````. If ```` is available @@ -906,10 +906,10 @@ In addition, ``(action ...)`` fields support the following special variables: - ``read-strings:`` expands to the list of lines in the given file, unescaped using OCaml lexical convention -The ``${:...}`` forms are what allows you to write custom rules that work +The ``%{:...}`` forms are what allows you to write custom rules that work transparently whether things are installed or not. -Note that aliases are ignored by both ``${<}`` and ``${^}``. +Note that aliases are ignored by both ``%{<}`` and ``%{^}``. The intent of this last form is to reliably read a list of strings generated by an OCaml program via: @@ -920,13 +920,13 @@ generated by an OCaml program via: #. Expansion of lists -Forms that expands to list of items, such as ``${CC}``, ``${^}``, -``${@}`` or ``${read-lines:...}``, are suitable to be used in, say, +Forms that expands to list of items, such as ``%{cc}``, ``%{^}``, +``%{@}`` or ``%{read-lines:...}``, are suitable to be used in, say, ``(run )``. For instance in: .. code:: scheme - (run foo ${^}) + (run foo %{^}) if there are two dependencies ``a`` and ``b``, the produced command will be equivalent to the shell command: @@ -940,7 +940,7 @@ you have to quote the variable as in: .. code:: scheme - (run foo "${^}") + (run foo "%{^}") which is equivalent to the following shell command: @@ -949,7 +949,7 @@ which is equivalent to the following shell command: $ foo "a b" (the items of the list are concatenated with space). -Note that, since ``${^}`` is a list of items, the first one may be +Note that, since ``%{^}`` is a list of items, the first one may be used as a program name, for instance: .. code:: scheme @@ -957,7 +957,7 @@ used as a program name, for instance: (rule (targets result.txt) (deps foo.exe (glob_files *.txt)) - (action (run ${^}))) + (action (run %{^}))) Here is another example: @@ -966,7 +966,7 @@ Here is another example: (rule (targets foo.exe) (deps foo.c) - (action (run ${CC} -o ${@} ${<} -lfoolib))) + (action (run %{cc} -o %{@} %{<} -lfoolib))) Library dependencies @@ -1052,10 +1052,10 @@ you had setup a rule for every file of the form: (rule (targets file.pp.ml) (deps file.ml) - (action (with-stdout-to ${@} (chdir ${ROOT} )))) + (action (with-stdout-to %{@} (chdir %{root} )))) The equivalent of a ``-pp `` option passed to the OCaml compiler is -``(system " ${<}")``. +``(system " %{<}")``. Preprocessing with ppx rewriters ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -1105,8 +1105,8 @@ For instance: .. code:: scheme (preprocess (per_module - (((action (run ./pp.sh X=1 ${<})) (foo bar))) - (((action (run ./pp.sh X=2 ${<})) (baz))))) + (((action (run ./pp.sh X=1 %{<})) (foo bar))) + (((action (run ./pp.sh X=2 %{<})) (baz))))) .. _deps-field: @@ -1231,7 +1231,7 @@ in ``src/foo/dune`` will be run from ``_build//src/foo``. The argument of ``(action ...)`` fields is a small DSL that is interpreted by dune directly and doesn't require an external shell. All atoms in the DSL support `Variables expansion`_. Moreover, you don't need to specify dependencies -explicitly for the special ``${:...}`` forms, these are recognized and +explicitly for the special ``%{:...}`` forms, these are recognized and automatically handled by dune. The DSL is currently quite limited, so if you want to do something complicated @@ -1289,15 +1289,15 @@ called ``copy-and-add-line-directive``. However, most of time one wants this behavior rather than a bare copy, so it was renamed to something shorter. -Note: expansion of the special ``${:...}`` is done relative to the current +Note: expansion of the special ``%{:...}`` is done relative to the current working directory of the part of the DSL being executed. So for instance if you have this action in a ``src/foo/dune``: .. code:: scheme - (action (chdir ../../.. (echo ${path:dune}))) + (action (chdir ../../.. (echo %{path:dune}))) -Then ``${path:dune}`` will expand to ``src/foo/dune``. When you run various +Then ``%{path:dune}`` will expand to ``src/foo/dune``. When you run various tools, they often use the filename given on the command line in error messages. As a result, if you execute the command from the original directory, it will only see the basename. @@ -1310,7 +1310,7 @@ To understand why this is important, let's consider this dune file living in (rule (targets blah.ml) (deps blah.mll) - (action (run ocamllex -o ${@} ${<}))) + (action (run ocamllex -o %{@} %{<}))) Here the command that will be executed is: @@ -1334,7 +1334,7 @@ of your project. What you should write instead is: (rule (targets blah.ml) (deps blah.mll) - (action (chdir ${ROOT} (run ocamllex -o ${@} ${<})))) + (action (chdir %{root} (run ocamllex -o %{@} %{<})))) Locks ----- @@ -1357,13 +1357,13 @@ same lock: (name runtest) (deps foo) (locks m) - (action (run test.exe ${<}))) + (action (run test.exe %{<}))) (alias (name runtest) (deps bar) (locks m) - (action (run test.exe ${<}))) + (action (run test.exe %{<}))) Dune will make sure that the executions of ``test.exe foo`` and ``test.exe bar`` are serialized. @@ -1383,7 +1383,7 @@ simply use an absolute filename: (name runtest) (deps foo) (locks /tcp-port/1042) - (action (run test.exe ${<}))) + (action (run test.exe %{<}))) .. _ocaml-syntax: diff --git a/src/jbuild.ml b/src/jbuild.ml index c5b8aabc..cfcd65bc 100644 --- a/src/jbuild.ml +++ b/src/jbuild.ml @@ -1238,7 +1238,7 @@ module Rule = struct ; action = (loc, Chdir - (S.virt_var __POS__ "ROOT", + (S.virt_var __POS__ "root", Run (S.virt_text __POS__ "ocamllex", [ S.virt_text __POS__ "-q" ; S.virt_text __POS__ "-o" @@ -1259,7 +1259,7 @@ module Rule = struct ; action = (loc, Chdir - (S.virt_var __POS__ "ROOT", + (S.virt_var __POS__ "root", Run (S.virt_text __POS__ "ocamlyacc", [S.virt_var __POS__ "first-dep"]))) ; mode diff --git a/src/menhir.ml b/src/menhir.ml index 0aa756cc..d9222b87 100644 --- a/src/menhir.ml +++ b/src/menhir.ml @@ -61,7 +61,7 @@ module Run (P : PARAMS) = struct let sources ms = List.map ~f:source ms - (* Expand special variables, such as ${ROOT}, in the stanza's flags. *) + (* Expand special variables, such as %{root}, in the stanza's flags. *) let flags = SC.expand_and_eval_set diff --git a/src/preprocessing.ml b/src/preprocessing.ml index 18feab3c..fad3f8cd 100644 --- a/src/preprocessing.ml +++ b/src/preprocessing.ml @@ -398,7 +398,7 @@ let get_ppx_driver sctx ~loc ~scope ~dir_kind pps = Ok (ppx_driver_exe sctx libs ~dir_kind, driver) let target_var = String_with_vars.virt_var __POS__ "targets" -let root_var = String_with_vars.virt_var __POS__ "ROOT" +let root_var = String_with_vars.virt_var __POS__ "root" let cookie_library_name lib_name = match lib_name with diff --git a/src/super_context.ml b/src/super_context.ml index 262578bd..d2735879 100644 --- a/src/super_context.ml +++ b/src/super_context.ml @@ -104,7 +104,6 @@ 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 v syntax_version -> match String_with_vars.Var.full_name v with - | "ROOT" -> Some [Value.Path t.context.build_dir] | "SCOPE_ROOT" -> if syntax_version >= (1, 0) then Loc.fail (String_with_vars.Var.loc v) @@ -320,6 +319,7 @@ let create ; "ocamlopt" , path ocamlopt ; "arch_sixtyfour" , string (string_of_bool context.arch_sixtyfour) ; "make" , make + ; "root" , [Value.Dir context.build_dir] ] in let vars = lowercased @@ -787,7 +787,6 @@ module Action = struct 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" -> if syntax_version >= (1, 0) then Loc.fail loc diff --git a/test/blackbox-tests/test-cases/aliases/src/dune b/test/blackbox-tests/test-cases/aliases/src/dune index 20302805..31951eeb 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 .\n")))) + (action (chdir %{root} (echo "running in .\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 7ccf02de..f0a2cb00 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 bar\n")))) + (action (chdir %{root} (echo "running in bar\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 ff87541b..49318e33 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 baz\n")))) + (action (chdir %{root} (echo "running in baz\n")))) 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 6146b3da..8cde20c6 100644 --- a/test/blackbox-tests/test-cases/inline_tests/dune-file/dune +++ b/test/blackbox-tests/test-cases/inline_tests/dune-file/dune @@ -12,7 +12,7 @@ (echo "\n") (echo "let () = print_int 43;;"))) (flags inline-test-runner %{library-name} - -source-tree-root %{ROOT} -diff-cmd -))) + -source-tree-root %{root} -diff-cmd -))) (library (name foo_tests) diff --git a/test/blackbox-tests/test-cases/inline_tests/run.t b/test/blackbox-tests/test-cases/inline_tests/run.t index d46693c7..dfad901b 100644 --- a/test/blackbox-tests/test-cases/inline_tests/run.t +++ b/test/blackbox-tests/test-cases/inline_tests/run.t @@ -30,7 +30,7 @@ (inline-test-runner %{library-name} -source-tree-root - %{ROOT} + %{root} -diff-cmd -)) (generate_runner From 8ef6af2675d6bdc45e515b8f5afe030648110237 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Sat, 7 Jul 2018 08:58:38 +0700 Subject: [PATCH 08/36] Add some helpers to String_with_loc Signed-off-by: Rudi Grinberg --- src/string_with_vars.ml | 9 +++++++++ src/string_with_vars.mli | 8 ++++++++ 2 files changed, 17 insertions(+) diff --git a/src/string_with_vars.ml b/src/string_with_vars.ml index 7e99f400..05d9d2ff 100644 --- a/src/string_with_vars.ml +++ b/src/string_with_vars.ml @@ -208,6 +208,15 @@ module Var = struct match destruct t with | Single s -> s | Pair (k, v) -> k ^ ":" ^ v + + let to_string = string_of_var + + let fail v ~f = Loc.fail (loc v) "%s" (f (to_string v)) + + let sexp_of_t t = Sexp.atom (to_string t) + + let rename t ~new_name = + { t with name = new_name } end let partial_expand diff --git a/src/string_with_vars.mli b/src/string_with_vars.mli index 649bbc8d..7dda300f 100644 --- a/src/string_with_vars.mli +++ b/src/string_with_vars.mli @@ -49,6 +49,8 @@ end module Var : sig type t + val sexp_of_t : t -> Sexp.t + val loc : t -> Loc.t val full_name : t -> string @@ -57,6 +59,12 @@ module Var : sig | Pair of string * string val destruct : t -> kind + + val fail : t -> f:(string -> string) -> _ + + val to_string : t -> string + + val rename : t -> new_name:string -> t end val expand From 9811031899fcfa625189f46082a1722489ee439c Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Sat, 7 Jul 2018 08:59:08 +0700 Subject: [PATCH 09/36] Implement a more elaborate variable expansion mechanism That embeds changes across versions Signed-off-by: Rudi Grinberg --- src/super_context.ml | 526 +++++++++++------- .../test-cases/dune-jbuild-var-case/run.t | 3 +- .../test-cases/findlib-error/run.t | 3 +- .../test-cases/path-variables/run.t | 7 +- 4 files changed, 344 insertions(+), 195 deletions(-) diff --git a/src/super_context.ml b/src/super_context.ml index d2735879..15942fcf 100644 --- a/src/super_context.ml +++ b/src/super_context.ml @@ -33,6 +33,225 @@ module Env_node = struct } end +module Var = struct + module Info = struct + type t = + | Since of Syntax.Version.t + | Renamed_in of Syntax.Version.t * string + | Deleted_in of Syntax.Version.t + end + + module Kind = struct + type t = + | Values of Value.t list + | Project_root + | First_dep + | Deps + | Targets + + let to_value_no_deps_or_targets ~scope = function + | Values v -> Some v + | Project_root -> Some [Value.Dir (Scope.root scope)] + | First_dep + | Deps + | Targets -> None + end + + module Form = struct + type t = + | Exe + | Dep + | Bin + | Lib + | Libexec + | Lib_available + | Version + | Read + | Read_strings + | Read_lines + | Path_no_dep + end + + type 'a t = + { kind: 'a option + ; info: Info.t option + } + + module Map = struct + type nonrec 'a t = 'a t String.Map.t + + let values v = + { kind = Some (Kind.Values v) + ; info = None + } + + let renamed_in ~new_name ~version = + { kind = None + ; info = Some (Info.Renamed_in (version, new_name)) + } + + let deleted_in ~version kind = + { kind = Some kind + ; info = Some (Info.Deleted_in version) + } + + let since ~version v = + { kind = Some v + ; info = Some (Info.Since version) + } + + let static_vars = + [ "first-dep", since ~version:(1, 0) Kind.First_dep + ; "targets", since ~version:(1, 0) Kind.Targets + ; "deps", since ~version:(1, 0) Kind.Deps + ; "project_root", since ~version:(1, 0) Kind.Project_root + + ; "<", renamed_in ~version:(1, 0) ~new_name:"first-dep" + ; "@", renamed_in ~version:(1, 0) ~new_name:"targets" + ; "^", renamed_in ~version:(1, 0) ~new_name:"deps" + ; "SCOPE_ROOT", renamed_in ~version:(1, 0) ~new_name:"project_root" + ] + + let forms = + let form kind = + { info = None + ; kind = Some kind + } + in + let open Form in + [ "exe", form Exe + ; "bin", form Bin + ; "lib", form Lib + ; "libexec", form Libexec + ; "lib-available", form Lib_available + ; "version", form Version + ; "read", form Read + ; "read-lines", form Read_lines + ; "read-strings", form Read_strings + + ; "dep", since ~version:(1, 0) Dep + + ; "path", renamed_in ~version:(1, 0) ~new_name:"dep" + ; "findlib", renamed_in ~version:(1, 0) ~new_name:"lib" + + ; "path-no-dep", deleted_in ~version:(1, 0) Path_no_dep + ] + |> String.Map.of_list_exn + + let create_vars ~(context : Context.t) ~cxx_flags = + let ocamlopt = + match context.ocamlopt with + | None -> Path.relative context.ocaml_bin "ocamlopt" + | Some p -> p + in + let string s = values [Value.String s] in + let path p = values [Value.Path p] in + let make = + match Bin.make with + | None -> string "make" + | Some p -> path p + in + let cflags = context.ocamlc_cflags in + let strings s = values (Value.L.strings s) in + let lowercased = + [ "cpp" , strings (context.c_compiler :: cflags @ ["-E"]) + ; "cc" , strings (context.c_compiler :: cflags) + ; "cxx" , strings (context.c_compiler :: cxx_flags) + ; "ocaml" , path context.ocaml + ; "ocamlc" , path context.ocamlc + ; "ocamlopt" , path ocamlopt + ; "arch_sixtyfour" , string (string_of_bool context.arch_sixtyfour) + ; "make" , make + ; "root" , values [Value.Dir context.build_dir] + ] in + let uppercased = + List.map lowercased ~f:(fun (k, _) -> + (String.uppercase k, renamed_in ~new_name:k ~version:(1, 0))) in + let vars = + [ "-verbose" , values [] + ; "pa_cpp" , strings (context.c_compiler :: cflags + @ ["-undef"; "-traditional"; + "-x"; "c"; "-E"]) + ; "ocaml_bin" , path context.ocaml_bin + ; "ocaml_version" , string context.version_string + ; "ocaml_where" , string (Path.to_string context.stdlib_dir) + ; "null" , string (Path.to_string Config.dev_null) + ; "ext_obj" , string context.ext_obj + ; "ext_asm" , string context.ext_asm + ; "ext_lib" , string context.ext_lib + ; "ext_dll" , string context.ext_dll + ; "ext_exe" , string context.ext_exe + ; "profile" , string context.profile + ] + in + let ocaml_config = + List.map (Ocaml_config.to_list context.ocaml_config) ~f:(fun (k, v) -> + ("ocaml-config:" ^ k, + match (v : Ocaml_config.Value.t) with + | Bool x -> string (string_of_bool x) + | Int x -> string (string_of_int x) + | String x -> string x + | Words x -> strings x + | Prog_and_args x -> strings (x.prog :: x.args))) + in + [ ocaml_config + ; static_vars + ; lowercased + ; uppercased + ; vars + ] + |> List.concat + |> String.Map.of_list_exn + + + let rec expand t ~syntax_version ~var = + let name = + match String_with_vars.Var.destruct var with + | Single v -> v + | Pair (v, _) -> v + in + Option.bind (String.Map.find t name) ~f:(fun {kind; info} -> + match info, kind with + | None, Some v -> Some v + | Some (Since min_version), Some v -> + if syntax_version >= min_version then + Some v + else + String_with_vars.Var.fail var ~f:(fun var -> + sprintf "Variable %s is available in since version %s. \ + Current version is %s" + var + (Syntax.Version.to_string min_version) + (Syntax.Version.to_string syntax_version)) + | Some (Renamed_in (in_version, new_name)), None -> + if syntax_version >= in_version then + String_with_vars.Var.fail var ~f:(fun old_name -> + sprintf "Variable %s has been renamed to %s since %s" + old_name + (String_with_vars.Var.(to_string (rename var ~new_name))) + (Syntax.Version.to_string in_version)) + else + expand t ~syntax_version:in_version + ~var:(String_with_vars.Var.rename var ~new_name) + | Some (Deleted_in in_version), Some v -> + if syntax_version < in_version then + Some v + else + String_with_vars.Var.fail var ~f:(fun var -> + sprintf "Variable %s has been deleted in version %s. \ + Current version is: %s" + var + (Syntax.Version.to_string in_version) + (Syntax.Version.to_string syntax_version) + ) + | Some (Renamed_in _), Some _ + | Some (Since _), None + | Some (Deleted_in _), None + | None, None -> assert false + ) + end +end + type t = { context : Context.t ; build_system : Build_system.t @@ -45,8 +264,8 @@ type t = ; artifacts : Artifacts.t ; stanzas_to_consider_for_install : Installable.t list ; cxx_flags : string list - ; vars : Value.t list String.Map.t - ; uppercase_vars : Value.t list String.Map.t + ; vars : Var.Kind.t Var.Map.t + ; forms : Var.Form.t Var.Map.t ; chdir : (Action.t, Action.t) Build.t ; host : t option ; libs_by_package : (Package.t * Lib.Set.t) Package.Name.Map.t @@ -85,40 +304,39 @@ let installed_libs t = t.installed_libs let find_scope_by_dir t dir = Scope.DB.find_by_dir t.scopes dir let find_scope_by_name t name = Scope.DB.find_by_name t.scopes name -let expand_var_no_root t loc syntax_version var = - match String.Map.find t.vars var with - | Some _ as v -> v - | None -> - begin match String.Map.find t.uppercase_vars var with - | None -> None - | Some _ as v -> - if syntax_version < (1, 0) then - v - else - Loc.fail loc "Uppercase variables are removed in dune files.@.\ - Hint: Did you mean %%{%s} instead?" - (String.lowercase var) - end +let expand_var_no_root t ~syntax_version ~var : Var.Kind.t option = + begin match String_with_vars.Var.destruct var with + | Single _ -> () + | Pair (_, _) -> + Exn.code_error "expand_var_no_root can't expand forms" + [ "var", String_with_vars.Var.sexp_of_t var + ] + end; + Var.Map.expand t.vars ~syntax_version ~var + +let expand_form t ~syntax_version ~var = + begin match String_with_vars.Var.destruct var with + | Pair (_, _) -> () + | Single _ -> + Exn.code_error "expand_var_no_root can't expand single variables" + [ "var", String_with_vars.Var.sexp_of_t var + ] + end; + Var.Map.expand t.forms ~syntax_version ~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 v syntax_version -> - match String_with_vars.Var.full_name v with - | "SCOPE_ROOT" -> - if syntax_version >= (1, 0) then - Loc.fail (String_with_vars.Var.loc v) - "Variable %%{SCOPE_ROOT} has been renamed to %%{project_root} \ - in dune files" - else - Some [Value.Path (Scope.root scope)] - | "project_root" when syntax_version >= (1, 0) -> - Some [Value.Path (Scope.root scope)] - | var -> - (match - expand_var_no_root t (String_with_vars.Var.loc v) syntax_version var - with - | Some _ as x -> x - | None -> String.Map.find extra_vars var)) + String_with_vars.expand ~mode:Single ~dir s ~f:(fun var syntax_version -> + match expand_var_no_root t ~syntax_version ~var with + | None -> + String.Map.find extra_vars (String_with_vars.Var.full_name var) + | Some v -> + begin match Var.Kind.to_value_no_deps_or_targets ~scope v with + | Some _ as v -> v + | None -> + String_with_vars.Var.fail var ~f:(fun var -> + sprintf "Variable %s is not allowed in this context" var) + end) in let expand_vars t ~scope ~dir ?extra_vars s = expand t ~scope ~dir ?extra_vars s @@ -295,68 +513,7 @@ let create List.filter context.ocamlc_cflags ~f:(fun s -> not (String.is_prefix s ~prefix:"-std=")) in - let (vars, uppercase_vars) = - let ocamlopt = - match context.ocamlopt with - | None -> Path.relative context.ocaml_bin "ocamlopt" - | Some p -> p - in - let string s = [Value.String s] in - let path p = [Value.Path p] in - let make = - match Bin.make with - | None -> string "make" - | Some p -> path p - in - let cflags = context.ocamlc_cflags in - let strings = Value.L.strings in - let lowercased = - [ "cpp" , strings (context.c_compiler :: cflags @ ["-E"]) - ; "cc" , strings (context.c_compiler :: cflags) - ; "cxx" , strings (context.c_compiler :: cxx_flags) - ; "ocaml" , path context.ocaml - ; "ocamlc" , path context.ocamlc - ; "ocamlopt" , path ocamlopt - ; "arch_sixtyfour" , string (string_of_bool context.arch_sixtyfour) - ; "make" , make - ; "root" , [Value.Dir context.build_dir] - ] in - let vars = - lowercased - @ [ "-verbose" , [] - ; "pa_cpp" , strings (context.c_compiler :: cflags - @ ["-undef"; "-traditional"; - "-x"; "c"; "-E"]) - ; "ocaml_bin" , path context.ocaml_bin - ; "ocaml_version" , string context.version_string - ; "ocaml_where" , string (Path.to_string context.stdlib_dir) - ; "null" , string (Path.to_string Config.dev_null) - ; "ext_obj" , string context.ext_obj - ; "ext_asm" , string context.ext_asm - ; "ext_lib" , string context.ext_lib - ; "ext_dll" , string context.ext_dll - ; "ext_exe" , string context.ext_exe - ; "profile" , string context.profile - ] - in - let uppercase_vars = - lowercased - |> List.map ~f:(fun (k, v) -> (String.uppercase k, v)) - |> String.Map.of_list_exn - in - let vars = - vars @ - List.map (Ocaml_config.to_list context.ocaml_config) ~f:(fun (k, v) -> - ("ocaml-config:" ^ k, - match (v : Ocaml_config.Value.t) with - | Bool x -> string (string_of_bool x) - | Int x -> string (string_of_int x) - | String x -> string x - | Words x -> strings x - | Prog_and_args x -> strings (x.prog :: x.args))) - in - (String.Map.of_list_exn vars, uppercase_vars) - in + let vars = Var.Map.create_vars ~context ~cxx_flags in let t = { context ; host @@ -370,8 +527,8 @@ let create ; stanzas_to_consider_for_install ; artifacts ; cxx_flags - ; uppercase_vars ; vars + ; forms = Var.Map.forms ; chdir = Build.arr (fun (action : Action.t) -> match action with | Chdir _ -> action @@ -666,90 +823,82 @@ module Action = struct Some (path_exp (Path.relative dir s) ) in match String_with_vars.Var.destruct var with - | Pair ("exe", s) -> Some (path_exp (map_exe (Path.relative dir s))) - | Pair ("path", s) when syntax_version < (1, 0) -> - path_with_dep s - | Pair ("dep", s) when syntax_version >= (1, 0) -> - path_with_dep s - | Pair ("dep", s) -> - Loc.fail - loc - "${dep:%s} is not supported in jbuild files.\n\ - Hint: Did you mean ${path:%s} instead?" - s - s - | Pair ("bin", s) -> begin - let sctx = host sctx in - match Artifacts.binary (artifacts sctx) s with - | Ok path -> Some (path_exp path) - | Error e -> - add_fail acc ({ fail = fun () -> Action.Prog.Not_found.raise e }) + | Single _ -> + begin match expand_var_no_root sctx ~syntax_version ~var with + | Some x -> Var.Kind.to_value_no_deps_or_targets x ~scope + | None -> String.Map.find extra_vars key end - | Pair ("findlib", s) when syntax_version >= (1, 0) -> - Loc.fail - loc - "The findlib special variable is not supported in jbuild files, \ - please use lib instead:\n%%{lib:%s} in dune files" - s - | Pair ("findlib", s) - | Pair ("lib", s) -> begin - let lib_dep, file = parse_lib_file ~loc s in - add_lib_dep acc lib_dep dep_kind; - match - Artifacts.file_of_lib (artifacts sctx) ~loc ~lib:lib_dep ~file - with - | Ok path -> Some (path_exp path) - | Error fail -> add_fail acc fail - end - | 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; - match - Artifacts.file_of_lib (artifacts sctx) ~loc ~lib:lib_dep ~file - with - | Error fail -> add_fail acc fail - | Ok path -> - if not Sys.win32 || Filename.extension s = ".exe" then begin - Some (path_exp path) - end else begin - let path_exe = Path.extend_basename path ~suffix:".exe" in - let dep = - Build.if_file_exists path_exe - ~then_:(Build.path path_exe >>^ fun _ -> path_exp path_exe) - ~else_:(Build.path path >>^ fun _ -> path_exp path) + | Pair (_, s)-> + begin match expand_form sctx ~syntax_version ~var with + | Some Var.Form.Exe -> Some (path_exp (map_exe (Path.relative dir s))) + | Some Dep -> path_with_dep s + | Some Bin -> begin + let sctx = host sctx in + match Artifacts.binary (artifacts sctx) s with + | Ok path -> Some (path_exp path) + | Error e -> + add_fail acc ({ fail = fun () -> Action.Prog.Not_found.raise e }) + end + | Some Lib -> begin + let lib_dep, file = parse_lib_file ~loc s in + add_lib_dep acc lib_dep dep_kind; + match + Artifacts.file_of_lib (artifacts sctx) ~loc ~lib:lib_dep ~file + with + | Ok path -> Some (path_exp path) + | Error fail -> add_fail acc fail + end + | Some Libexec -> begin + let sctx = host sctx in + let lib_dep, file = parse_lib_file ~loc s in + add_lib_dep acc lib_dep dep_kind; + match + Artifacts.file_of_lib (artifacts sctx) ~loc ~lib:lib_dep ~file + with + | Error fail -> add_fail acc fail + | Ok path -> + if not Sys.win32 || Filename.extension s = ".exe" then begin + Some (path_exp path) + end else begin + let path_exe = Path.extend_basename path ~suffix:".exe" in + let dep = + Build.if_file_exists path_exe + ~then_:(Build.path path_exe >>^ fun _ -> path_exp path_exe) + ~else_:(Build.path path >>^ fun _ -> path_exp path) + in + add_ddep acc ~key dep + end + end + | Some Lib_available -> begin + let lib = s in + add_lib_dep acc lib Optional; + Some (str_exp (string_of_bool ( + Lib.DB.available (Scope.libs scope) lib))) + end + | Some Version -> begin + match Package.Name.Map.find (Scope.project scope).packages + (Package.Name.of_string s) with + | Some p -> + let x = + Pkg_version.read sctx p >>^ function + | None -> [Value.String ""] + | Some s -> [String s] in - add_ddep acc ~key dep - end - end - | Pair ("lib-available", lib) -> - add_lib_dep acc lib Optional; - Some (str_exp (string_of_bool ( - Lib.DB.available (Scope.libs scope) lib))) - | Pair ("version", s) -> begin - match Package.Name.Map.find (Scope.project scope).packages - (Package.Name.of_string s) with - | Some p -> - let x = - Pkg_version.read sctx p >>^ function - | None -> [Value.String ""] - | Some s -> [String s] + add_ddep acc ~key x + | None -> + add_fail acc { fail = fun () -> + Loc.fail loc "Package %S doesn't exist in the current project." s + } + end + | Some Read -> begin + let path = Path.relative dir s in + let data = + Build.contents path + >>^ fun s -> [Value.String s] in - add_ddep acc ~key x - | None -> - add_fail acc { fail = fun () -> - Loc.fail loc "Package %S doesn't exist in the current project." s - } - end - | Pair ("read", s) -> begin - let path = Path.relative dir s in - let data = - Build.contents path - >>^ fun s -> [Value.String s] - in - add_ddep acc ~key data - end - | Pair ("read-lines", s) -> begin + add_ddep acc ~key data + end + | Some Read_lines -> begin let path = Path.relative dir s in let data = Build.lines_of path @@ -757,18 +906,19 @@ module Action = struct in add_ddep acc ~key data end - | Pair ("read-strings", s) -> begin - let path = Path.relative dir s in - let data = - Build.strings path - >>^ Value.L.strings - in - add_ddep acc ~key data + | Some Read_strings -> begin + let path = Path.relative dir s in + let data = + Build.strings path + >>^ Value.L.strings + in + add_ddep acc ~key data + end + | Some Path_no_dep -> Some [Value.Dir (Path.relative dir s)] + | None -> + String_with_vars.Var.fail var ~f:(fun var -> + sprintf "Unknown form: %s" var) end - | _ -> - match expand_var_no_root sctx loc syntax_version key with - | Some _ as x -> x - | None -> String.Map.find extra_vars key in let targets loc name = let var = diff --git a/test/blackbox-tests/test-cases/dune-jbuild-var-case/run.t b/test/blackbox-tests/test-cases/dune-jbuild-var-case/run.t index cda97388..d78b29db 100644 --- a/test/blackbox-tests/test-cases/dune-jbuild-var-case/run.t +++ b/test/blackbox-tests/test-cases/dune-jbuild-var-case/run.t @@ -6,8 +6,7 @@ All builtin variables are lower cased in Dune: $ dune runtest --root dune-upper Entering directory 'dune-upper' File "dune", line 3, characters 41-46: - Error: Uppercase variables are removed in dune files. - Hint: Did you mean %{make} instead? + Error: Variable %{MAKE} has been renamed to %{make} since 1.0 [1] jbuild files retain the the old names: diff --git a/test/blackbox-tests/test-cases/findlib-error/run.t b/test/blackbox-tests/test-cases/findlib-error/run.t index e704b5ba..3a1ee84f 100644 --- a/test/blackbox-tests/test-cases/findlib-error/run.t +++ b/test/blackbox-tests/test-cases/findlib-error/run.t @@ -3,8 +3,7 @@ We are dropping support for findlib in dune $ dune build --root in-dune target.txt Entering directory 'in-dune' File "dune", line 2, characters 25-37: - Error: The findlib special variable is not supported in jbuild files, please use lib instead: - %{lib:pkg} in dune files + Error: Variable %{findlib:pkg} has been renamed to %{lib:pkg} since 1.0 [1] But it must still be available in jbuild files diff --git a/test/blackbox-tests/test-cases/path-variables/run.t b/test/blackbox-tests/test-cases/path-variables/run.t index ccaca183..2cc8d0d2 100644 --- a/test/blackbox-tests/test-cases/path-variables/run.t +++ b/test/blackbox-tests/test-cases/path-variables/run.t @@ -8,7 +8,9 @@ In expands to a file name, and registers this as a dependency. $ dune build --root dune @test-dep Entering directory 'dune' - dynamic-contents + File "dune", line 13, characters 17-47: + Error: Variable %{path:file-that-does-not-exist} has been renamed to %{dep:file-that-does-not-exist} since 1.0 + [1] %{path-no-dep:string} --------------------- @@ -51,6 +53,5 @@ This form does not exist, but displays an hint: $ dune build --root jbuild-invalid @test-dep Entering directory 'jbuild-invalid' File "jbuild", line 5, characters 16-37: - Error: ${dep:generated-file} is not supported in jbuild files. - Hint: Did you mean ${path:generated-file} instead? + Error: Variable ${dep:generated-file} is available in since version 1.0. Current version is 0.0 [1] From 3f7ad7851293e373e1ed1e48e1d901fe4ae86fc9 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Sat, 7 Jul 2018 13:23:17 +0700 Subject: [PATCH 10/36] Replace more code with the variable system Signed-off-by: Rudi Grinberg --- src/super_context.ml | 84 ++++++------------- .../test-cases/path-variables/run.t | 2 +- 2 files changed, 26 insertions(+), 60 deletions(-) diff --git a/src/super_context.ml b/src/super_context.ml index 15942fcf..627ce86c 100644 --- a/src/super_context.ml +++ b/src/super_context.ml @@ -334,8 +334,8 @@ let (expand_vars, expand_vars_path) = begin match Var.Kind.to_value_no_deps_or_targets ~scope v with | Some _ as v -> v | None -> - String_with_vars.Var.fail var ~f:(fun var -> - sprintf "Variable %s is not allowed in this context" var) + String_with_vars.Var.fail var + ~f:(sprintf "Variable %s is not allowed in this context") end) in let expand_vars t ~scope ~dir ?extra_vars s = @@ -816,17 +816,33 @@ module Action = struct ; ddeps = String.Map.empty } in + let targets loc name = + let var = + match name with + | "@" -> sprintf "${%s}" name + | "targets" -> sprintf "%%{%s}" name + | _ -> assert false + in + match targets_written_by_user with + | Infer -> Loc.fail loc "You cannot use %s with inferred rules." var + | Alias -> Loc.fail loc "You cannot use %s in aliases." var + | Static l -> Some (Value.L.paths l) + in let expand var syntax_version = let loc = String_with_vars.Var.loc var in let key = String_with_vars.Var.full_name var in - let path_with_dep s = - Some (path_exp (Path.relative dir s) ) - in + let path_with_dep s = Some (path_exp (Path.relative dir s)) in match String_with_vars.Var.destruct var with - | Single _ -> + | Single var_name -> begin match expand_var_no_root sctx ~syntax_version ~var with - | Some x -> Var.Kind.to_value_no_deps_or_targets x ~scope | None -> String.Map.find extra_vars key + | Some Targets -> targets loc var_name + | Some v -> + let exp = Var.Kind.to_value_no_deps_or_targets ~scope v in + Option.iter exp ~f:(fun v -> + acc.sdeps <- Path.Set.union + (Path.Set.of_list (Value.L.deps_only v)) acc.sdeps); + exp end | Pair (_, s)-> begin match expand_form sctx ~syntax_version ~var with @@ -916,60 +932,10 @@ module Action = struct end | Some Path_no_dep -> Some [Value.Dir (Path.relative dir s)] | None -> - String_with_vars.Var.fail var ~f:(fun var -> - sprintf "Unknown form: %s" var) + String_with_vars.Var.fail var ~f:(sprintf "Unknown form: %s") end in - let targets loc name = - let var = - match name with - | "@" -> sprintf "${%s}" name - | "targets" -> sprintf "%%{%s}" name - | _ -> assert false - in - match targets_written_by_user with - | Infer -> Loc.fail loc "You cannot use %s with inferred rules." var - | Alias -> Loc.fail loc "You cannot use %s in aliases." var - | Static l -> Some (Value.L.paths l) - in - let t = - U.partial_expand t ~dir ~map_exe ~f:(fun var syntax_version -> - let var_name = String_with_vars.Var.full_name var in - let loc = String_with_vars.Var.loc var in - match var_name with - | "SCOPE_ROOT" -> - if syntax_version >= (1, 0) then - Loc.fail loc - "Variable %%{SCOPE_ROOT} has been renamed to %%{project_root} \ - in dune files" - else - Some (path_exp (Scope.root scope)) - | "project_root" when syntax_version >= (1, 0) -> - Some (path_exp (Scope.root scope)) - | "@" -> - if syntax_version < (1, 0) then - targets loc var_name - else - Loc.fail loc (* variable substitution to avoid ugly escaping *) - "Variable %s has been renamed to %%{targets} in dune files" "%{@}" - | "targets" when syntax_version >= (1, 0) -> targets loc var_name - | _ -> - match String_with_vars.Var.destruct var with - | Pair ("path-no-dep", s) -> - if syntax_version < (1, 0) then - Some (path_exp (Path.relative dir s)) - else - Loc.fail - loc - "The ${path-no-dep:...} syntax has been removed from dune." - | _ -> - let exp = expand var syntax_version in - Option.iter exp ~f:(fun vs -> - acc.sdeps <- Path.Set.union (Path.Set.of_list - (Value.L.deps_only vs)) acc.sdeps; - ); - exp) - in + let t = U.partial_expand t ~dir ~map_exe ~f:expand in (t, acc) let expand_step2 ~dir ~dynamic_expansions ~deps_written_by_user ~map_exe t = diff --git a/test/blackbox-tests/test-cases/path-variables/run.t b/test/blackbox-tests/test-cases/path-variables/run.t index 2cc8d0d2..5d6a2c26 100644 --- a/test/blackbox-tests/test-cases/path-variables/run.t +++ b/test/blackbox-tests/test-cases/path-variables/run.t @@ -20,7 +20,7 @@ This form does not exist, but displays an hint: $ dune build --root dune-invalid @test-path-no-dep Entering directory 'dune-invalid' File "dune", line 7, characters 17-54: - Error: The ${path-no-dep:...} syntax has been removed from dune. + Error: Variable %{path-no-dep:file-that-does-not-exist} has been deleted in version 1.0. Current version is: 1.0 [1] jbuild files From 3a7b62a57d5794a6511aa4747a44760961498533 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Sat, 7 Jul 2018 13:36:46 +0700 Subject: [PATCH 11/36] Use the variable for dynamic expansions as well Signed-off-by: Rudi Grinberg --- src/super_context.ml | 31 ++++++++++--------------------- 1 file changed, 10 insertions(+), 21 deletions(-) diff --git a/src/super_context.ml b/src/super_context.ml index 627ce86c..86e20125 100644 --- a/src/super_context.ml +++ b/src/super_context.ml @@ -203,6 +203,7 @@ module Var = struct |> List.concat |> String.Map.of_list_exn + let static_vars = String.Map.of_list_exn static_vars let rec expand t ~syntax_version ~var = let name = @@ -945,32 +946,20 @@ module Action = struct match String.Map.find dynamic_expansions key with | Some _ as opt -> opt | None -> - let first_dep () = - Some ( - match deps_written_by_user with + Var.Map.expand Var.Map.static_vars ~syntax_version ~var + |> Option.map ~f:(function + | Var.Kind.Deps -> (Value.L.paths deps_written_by_user) + | First_dep -> + begin match deps_written_by_user with | [] -> Loc.warn loc "Variable '%s' used with no explicit \ dependencies@." key; [Value.String ""] | v :: _ -> [Path v] - ) - in - match key with - | "<" -> - if syntax_version < (1, 0) then - first_dep () - else - Loc.fail loc "Variable '<' is renamed to 'first-dep' in dune files" - | "first-dep" when syntax_version >= (1, 0) -> first_dep () - | "^" -> - if syntax_version < (1, 0) then - Some (Value.L.paths deps_written_by_user) - else - Loc.fail loc - "Variable %%{^} has been renamed to %%{deps} in dune files" - | "deps" when syntax_version >= (1, 0) -> - Some (Value.L.paths deps_written_by_user) - | _ -> None) + end + | _ -> + Exn.code_error "Unexpected variable in step2" + ["var", String_with_vars.Var.sexp_of_t var])) let run sctx ~loc ?(extra_vars=String.Map.empty) t ~dir ~dep_kind ~targets:targets_written_by_user ~scope From 6159a2909cf3ab6a7737a5e441dd371ccc7b44b2 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Sat, 7 Jul 2018 13:37:53 +0700 Subject: [PATCH 12/36] Remove one off function Signed-off-by: Rudi Grinberg --- src/super_context.ml | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/src/super_context.ml b/src/super_context.ml index 86e20125..a397ed8a 100644 --- a/src/super_context.ml +++ b/src/super_context.ml @@ -832,7 +832,6 @@ module Action = struct let expand var syntax_version = let loc = String_with_vars.Var.loc var in let key = String_with_vars.Var.full_name var in - let path_with_dep s = Some (path_exp (Path.relative dir s)) in match String_with_vars.Var.destruct var with | Single var_name -> begin match expand_var_no_root sctx ~syntax_version ~var with @@ -848,7 +847,7 @@ module Action = struct | Pair (_, s)-> begin match expand_form sctx ~syntax_version ~var with | Some Var.Form.Exe -> Some (path_exp (map_exe (Path.relative dir s))) - | Some Dep -> path_with_dep s + | Some Dep -> Some (path_exp (Path.relative dir s)) | Some Bin -> begin let sctx = host sctx in match Artifacts.binary (artifacts sctx) s with From 2a71439c3e92cf03ab13b6fd07205e0587d70971 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Sat, 7 Jul 2018 14:30:07 +0700 Subject: [PATCH 13/36] Toyish gadtization to remove a few assert falses Signed-off-by: Rudi Grinberg --- src/super_context.ml | 110 +++++++++++++++++++++++++------------------ 1 file changed, 64 insertions(+), 46 deletions(-) diff --git a/src/super_context.ml b/src/super_context.ml index a397ed8a..e608d336 100644 --- a/src/super_context.ml +++ b/src/super_context.ml @@ -34,11 +34,29 @@ module Env_node = struct end module Var = struct + module Opt = struct + type with_value + type no_value + + type (_, _) t = + | None0 : (no_value , _) t + | Some0 : 'a -> (with_value, 'a) t + + let some + : 'a. (with_value, 'a) t -> 'a option + = fun (Some0 x) -> Some x + + let discard + : (no_value, _) t -> unit + = fun None0 -> () + end + module Info = struct - type t = - | Since of Syntax.Version.t - | Renamed_in of Syntax.Version.t * string - | Deleted_in of Syntax.Version.t + type _ t = + | Nothing : Opt.with_value t + | Since : Syntax.Version.t -> Opt.with_value t + | Deleted_in : Syntax.Version.t -> Opt.with_value t + | Renamed_in : Syntax.Version.t * string -> Opt.no_value t end module Kind = struct @@ -72,33 +90,35 @@ module Var = struct | Path_no_dep end - type 'a t = - { kind: 'a option - ; info: Info.t option + type ('a, 'b) t' = + { kind: ('a, 'b) Opt.t + ; info: 'a Info.t } + type _ t = V : ('a, 'b) t' -> 'b t + module Map = struct type nonrec 'a t = 'a t String.Map.t let values v = - { kind = Some (Kind.Values v) - ; info = None - } + V { kind = Some0 (Kind.Values v) + ; info = Info.Nothing + } let renamed_in ~new_name ~version = - { kind = None - ; info = Some (Info.Renamed_in (version, new_name)) - } + V { kind = None0 + ; info = Info.Renamed_in (version, new_name) + } let deleted_in ~version kind = - { kind = Some kind - ; info = Some (Info.Deleted_in version) - } + V { kind = Some0 kind + ; info = Info.Deleted_in version + } let since ~version v = - { kind = Some v - ; info = Some (Info.Since version) - } + V { kind = Some0 v + ; info = Info.Since version + } let static_vars = [ "first-dep", since ~version:(1, 0) Kind.First_dep @@ -114,9 +134,9 @@ module Var = struct let forms = let form kind = - { info = None - ; kind = Some kind - } + V { info = Info.Nothing + ; kind = Some0 kind + } in let open Form in [ "exe", form Exe @@ -211,12 +231,12 @@ module Var = struct | Single v -> v | Pair (v, _) -> v in - Option.bind (String.Map.find t name) ~f:(fun {kind; info} -> - match info, kind with - | None, Some v -> Some v - | Some (Since min_version), Some v -> + let f (V { kind; info}) = + match info with + | Info.Nothing -> Opt.some kind + | Info.Since min_version -> if syntax_version >= min_version then - Some v + Opt.some kind else String_with_vars.Var.fail var ~f:(fun var -> sprintf "Variable %s is available in since version %s. \ @@ -224,32 +244,30 @@ module Var = struct var (Syntax.Version.to_string min_version) (Syntax.Version.to_string syntax_version)) - | Some (Renamed_in (in_version, new_name)), None -> - if syntax_version >= in_version then - String_with_vars.Var.fail var ~f:(fun old_name -> - sprintf "Variable %s has been renamed to %s since %s" - old_name - (String_with_vars.Var.(to_string (rename var ~new_name))) - (Syntax.Version.to_string in_version)) - else - expand t ~syntax_version:in_version - ~var:(String_with_vars.Var.rename var ~new_name) - | Some (Deleted_in in_version), Some v -> + | Info.Renamed_in (in_version, new_name) -> begin + Opt.discard kind; + if syntax_version >= in_version then + String_with_vars.Var.fail var ~f:(fun old_name -> + sprintf "Variable %s has been renamed to %s since %s" + old_name + (String_with_vars.Var.(to_string (rename var ~new_name))) + (Syntax.Version.to_string in_version)) + else + expand t ~syntax_version:in_version + ~var:(String_with_vars.Var.rename var ~new_name) + end + | Info.Deleted_in in_version -> if syntax_version < in_version then - Some v + Opt.some kind else String_with_vars.Var.fail var ~f:(fun var -> sprintf "Variable %s has been deleted in version %s. \ Current version is: %s" var (Syntax.Version.to_string in_version) - (Syntax.Version.to_string syntax_version) - ) - | Some (Renamed_in _), Some _ - | Some (Since _), None - | Some (Deleted_in _), None - | None, None -> assert false - ) + (Syntax.Version.to_string syntax_version)) + in + Option.bind (String.Map.find t name) ~f end end From 972406a0dca17cef0d041ee3b060c801932dfbc2 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Sat, 7 Jul 2018 15:04:44 +0700 Subject: [PATCH 14/36] Fix static dependencies Signed-off-by: Rudi Grinberg --- src/super_context.ml | 192 ++++++++++++++++++++++--------------------- src/value.ml | 2 + src/value.mli | 2 + 3 files changed, 103 insertions(+), 93 deletions(-) diff --git a/src/super_context.ml b/src/super_context.ml index e608d336..cd8e8f0a 100644 --- a/src/super_context.ml +++ b/src/super_context.ml @@ -845,94 +845,81 @@ module Action = struct match targets_written_by_user with | Infer -> Loc.fail loc "You cannot use %s with inferred rules." var | Alias -> Loc.fail loc "You cannot use %s in aliases." var - | Static l -> Some (Value.L.paths l) + | Static l -> Some (Value.L.dirs l) (* XXX hack to signal no dep *) in - let expand var syntax_version = + let expand_form s var syntax_version = 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 - | Single var_name -> - begin match expand_var_no_root sctx ~syntax_version ~var with - | None -> String.Map.find extra_vars key - | Some Targets -> targets loc var_name - | Some v -> - let exp = Var.Kind.to_value_no_deps_or_targets ~scope v in - Option.iter exp ~f:(fun v -> - acc.sdeps <- Path.Set.union - (Path.Set.of_list (Value.L.deps_only v)) acc.sdeps); - exp + begin match expand_form sctx ~syntax_version ~var with + | Some Var.Form.Exe -> Some (path_exp (map_exe (Path.relative dir s))) + | Some Dep -> Some (path_exp (Path.relative dir s)) + | Some Bin -> begin + let sctx = host sctx in + match Artifacts.binary (artifacts sctx) s with + | Ok path -> Some (path_exp path) + | Error e -> + add_fail acc ({ fail = fun () -> Action.Prog.Not_found.raise e }) end - | Pair (_, s)-> - begin match expand_form sctx ~syntax_version ~var with - | Some Var.Form.Exe -> Some (path_exp (map_exe (Path.relative dir s))) - | Some Dep -> Some (path_exp (Path.relative dir s)) - | Some Bin -> begin - let sctx = host sctx in - match Artifacts.binary (artifacts sctx) s with - | Ok path -> Some (path_exp path) - | Error e -> - add_fail acc ({ fail = fun () -> Action.Prog.Not_found.raise e }) - end - | Some Lib -> begin - let lib_dep, file = parse_lib_file ~loc s in - add_lib_dep acc lib_dep dep_kind; - match - Artifacts.file_of_lib (artifacts sctx) ~loc ~lib:lib_dep ~file - with - | Ok path -> Some (path_exp path) - | Error fail -> add_fail acc fail - end - | Some Libexec -> begin - let sctx = host sctx in - let lib_dep, file = parse_lib_file ~loc s in - add_lib_dep acc lib_dep dep_kind; - match - Artifacts.file_of_lib (artifacts sctx) ~loc ~lib:lib_dep ~file - with - | Error fail -> add_fail acc fail - | Ok path -> - if not Sys.win32 || Filename.extension s = ".exe" then begin - Some (path_exp path) - end else begin - let path_exe = Path.extend_basename path ~suffix:".exe" in - let dep = - Build.if_file_exists path_exe - ~then_:(Build.path path_exe >>^ fun _ -> path_exp path_exe) - ~else_:(Build.path path >>^ fun _ -> path_exp path) - in - add_ddep acc ~key dep - end - end - | Some Lib_available -> begin - let lib = s in - add_lib_dep acc lib Optional; - Some (str_exp (string_of_bool ( - Lib.DB.available (Scope.libs scope) lib))) - end - | Some Version -> begin - match Package.Name.Map.find (Scope.project scope).packages - (Package.Name.of_string s) with - | Some p -> - let x = - Pkg_version.read sctx p >>^ function - | None -> [Value.String ""] - | Some s -> [String s] + | Some Lib -> begin + let lib_dep, file = parse_lib_file ~loc s in + add_lib_dep acc lib_dep dep_kind; + match + Artifacts.file_of_lib (artifacts sctx) ~loc ~lib:lib_dep ~file + with + | Ok path -> Some (path_exp path) + | Error fail -> add_fail acc fail + end + | Some Libexec -> begin + let sctx = host sctx in + let lib_dep, file = parse_lib_file ~loc s in + add_lib_dep acc lib_dep dep_kind; + match + Artifacts.file_of_lib (artifacts sctx) ~loc ~lib:lib_dep ~file + with + | Error fail -> add_fail acc fail + | Ok path -> + if not Sys.win32 || Filename.extension s = ".exe" then begin + Some (path_exp path) + end else begin + let path_exe = Path.extend_basename path ~suffix:".exe" in + let dep = + Build.if_file_exists path_exe + ~then_:(Build.path path_exe >>^ fun _ -> path_exp path_exe) + ~else_:(Build.path path >>^ fun _ -> path_exp path) in - add_ddep acc ~key x - | None -> - add_fail acc { fail = fun () -> - Loc.fail loc "Package %S doesn't exist in the current project." s - } - end - | Some Read -> begin - let path = Path.relative dir s in - let data = - Build.contents path - >>^ fun s -> [Value.String s] + add_ddep acc ~key dep + end + end + | Some Lib_available -> begin + let lib = s in + add_lib_dep acc lib Optional; + Some (str_exp (string_of_bool ( + Lib.DB.available (Scope.libs scope) lib))) + end + | Some Version -> begin + match Package.Name.Map.find (Scope.project scope).packages + (Package.Name.of_string s) with + | Some p -> + let x = + Pkg_version.read sctx p >>^ function + | None -> [Value.String ""] + | Some s -> [String s] in - add_ddep acc ~key data - end - | Some Read_lines -> begin + add_ddep acc ~key x + | None -> + add_fail acc { fail = fun () -> + Loc.fail loc "Package %S doesn't exist in the current project." s + } + end + | Some Read -> begin + let path = Path.relative dir s in + let data = + Build.contents path + >>^ fun s -> [Value.String s] + in + add_ddep acc ~key data + end + | Some Read_lines -> begin let path = Path.relative dir s in let data = Build.lines_of path @@ -940,18 +927,37 @@ module Action = struct in add_ddep acc ~key data end - | Some Read_strings -> begin - let path = Path.relative dir s in - let data = - Build.strings path - >>^ Value.L.strings - in - add_ddep acc ~key data - end - | Some Path_no_dep -> Some [Value.Dir (Path.relative dir s)] - | None -> - String_with_vars.Var.fail var ~f:(sprintf "Unknown form: %s") + | Some Read_strings -> begin + let path = Path.relative dir s in + let data = + Build.strings path + >>^ Value.L.strings + in + add_ddep acc ~key data end + | Some Path_no_dep -> Some [Value.Dir (Path.relative dir s)] + | None -> + String_with_vars.Var.fail var ~f:(sprintf "Unknown form: %s") + end + in + let expand var syntax_version = + let loc = String_with_vars.Var.loc var in + let key = String_with_vars.Var.full_name var in + let res = + match String_with_vars.Var.destruct var with + | Single var_name -> + begin match expand_var_no_root sctx ~syntax_version ~var with + | None -> String.Map.find extra_vars key + | Some Targets -> targets loc var_name + | Some v -> Var.Kind.to_value_no_deps_or_targets v ~scope + end + | Pair (_, s) -> expand_form s var syntax_version + in + Option.iter res ~f:(fun v -> + acc.sdeps <- Path.Set.union + (Path.Set.of_list (Value.L.deps_only v)) acc.sdeps + ); + res in let t = U.partial_expand t ~dir ~map_exe ~f:expand in (t, acc) diff --git a/src/value.ml b/src/value.ml index 3dfe7a54..f3dc587b 100644 --- a/src/value.ml +++ b/src/value.ml @@ -35,4 +35,6 @@ module L = struct let strings = List.map ~f:(fun x -> String x) let paths = List.map ~f:(fun x -> Path x) + + let dirs = List.map ~f:(fun x -> Dir x) end diff --git a/src/value.mli b/src/value.mli index 9f374642..ee7162dd 100644 --- a/src/value.mli +++ b/src/value.mli @@ -16,6 +16,8 @@ module L : sig val deps_only : t list -> Path.t list + val dirs : Path.t list -> t list + val concat : t list -> dir:Path.t -> string val to_strings : t list -> dir:Path.t -> string list From 73cc3b1e7ce2c984191ed28d83fba646c9403ee0 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Sat, 7 Jul 2018 15:21:05 +0700 Subject: [PATCH 15/36] Simplify Var.t definition Remove all gatd's and the extra record type Signed-off-by: Rudi Grinberg --- src/super_context.ml | 85 ++++++++++---------------------------------- 1 file changed, 18 insertions(+), 67 deletions(-) diff --git a/src/super_context.ml b/src/super_context.ml index cd8e8f0a..68c8d90f 100644 --- a/src/super_context.ml +++ b/src/super_context.ml @@ -34,31 +34,6 @@ module Env_node = struct end module Var = struct - module Opt = struct - type with_value - type no_value - - type (_, _) t = - | None0 : (no_value , _) t - | Some0 : 'a -> (with_value, 'a) t - - let some - : 'a. (with_value, 'a) t -> 'a option - = fun (Some0 x) -> Some x - - let discard - : (no_value, _) t -> unit - = fun None0 -> () - end - - module Info = struct - type _ t = - | Nothing : Opt.with_value t - | Since : Syntax.Version.t -> Opt.with_value t - | Deleted_in : Syntax.Version.t -> Opt.with_value t - | Renamed_in : Syntax.Version.t * string -> Opt.no_value t - end - module Kind = struct type t = | Values of Value.t list @@ -90,35 +65,19 @@ module Var = struct | Path_no_dep end - type ('a, 'b) t' = - { kind: ('a, 'b) Opt.t - ; info: 'a Info.t - } - - type _ t = V : ('a, 'b) t' -> 'b t + type 'a t = + | Nothing of 'a + | Since of 'a * Syntax.Version.t + | Deleted_in of 'a * Syntax.Version.t + | Renamed_in of Syntax.Version.t * string module Map = struct type nonrec 'a t = 'a t String.Map.t - let values v = - V { kind = Some0 (Kind.Values v) - ; info = Info.Nothing - } - - let renamed_in ~new_name ~version = - V { kind = None0 - ; info = Info.Renamed_in (version, new_name) - } - - let deleted_in ~version kind = - V { kind = Some0 kind - ; info = Info.Deleted_in version - } - - let since ~version v = - V { kind = Some0 v - ; info = Info.Since version - } + let values v = Nothing (Kind.Values v) + let renamed_in ~new_name ~version = Renamed_in (version, new_name) + let deleted_in ~version kind = Deleted_in (kind, version) + let since ~version v = Since (v, version) let static_vars = [ "first-dep", since ~version:(1, 0) Kind.First_dep @@ -133,11 +92,7 @@ module Var = struct ] let forms = - let form kind = - V { info = Info.Nothing - ; kind = Some0 kind - } - in + let form kind = Nothing kind in let open Form in [ "exe", form Exe ; "bin", form Bin @@ -231,12 +186,11 @@ module Var = struct | Single v -> v | Pair (v, _) -> v in - let f (V { kind; info}) = - match info with - | Info.Nothing -> Opt.some kind - | Info.Since min_version -> + Option.bind (String.Map.find t name) ~f:(function + | Nothing v -> Some v + | Since (v, min_version) -> if syntax_version >= min_version then - Opt.some kind + Some v else String_with_vars.Var.fail var ~f:(fun var -> sprintf "Variable %s is available in since version %s. \ @@ -244,8 +198,7 @@ module Var = struct var (Syntax.Version.to_string min_version) (Syntax.Version.to_string syntax_version)) - | Info.Renamed_in (in_version, new_name) -> begin - Opt.discard kind; + | Renamed_in (in_version, new_name) -> begin if syntax_version >= in_version then String_with_vars.Var.fail var ~f:(fun old_name -> sprintf "Variable %s has been renamed to %s since %s" @@ -256,18 +209,16 @@ module Var = struct expand t ~syntax_version:in_version ~var:(String_with_vars.Var.rename var ~new_name) end - | Info.Deleted_in in_version -> + | Deleted_in (v, in_version) -> if syntax_version < in_version then - Opt.some kind + Some v else String_with_vars.Var.fail var ~f:(fun var -> sprintf "Variable %s has been deleted in version %s. \ Current version is: %s" var (Syntax.Version.to_string in_version) - (Syntax.Version.to_string syntax_version)) - in - Option.bind (String.Map.find t name) ~f + (Syntax.Version.to_string syntax_version))) end end From 2f86a4d8574d039756b1600af2f19f4231cc12f5 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Sat, 7 Jul 2018 15:23:46 +0700 Subject: [PATCH 16/36] Rename the expand family of functions Signed-off-by: Rudi Grinberg --- src/gen_rules.ml | 4 ++-- src/super_context.ml | 18 +++++++++--------- src/super_context.mli | 2 +- 3 files changed, 12 insertions(+), 12 deletions(-) diff --git a/src/gen_rules.ml b/src/gen_rules.ml index e300704a..eee6291e 100644 --- a/src/gen_rules.ml +++ b/src/gen_rules.ml @@ -201,7 +201,7 @@ module Gen(P : Install_rules.Params) = struct let copy_files_rules (def: Copy_files.t) ~src_dir ~dir ~scope = let loc = String_with_vars.loc def.glob in let glob_in_src = - let src_glob = SC.expand_vars sctx ~dir def.glob ~scope in + let src_glob = SC.expand_vars_string sctx ~dir def.glob ~scope in Path.relative src_dir src_glob ~error_loc:loc in (* The following condition is required for merlin to work. @@ -1042,7 +1042,7 @@ module Gen(P : Install_rules.Params) = struct | Copy_files { glob; _ } -> let src_dir = let loc = String_with_vars.loc glob in - let src_glob = SC.expand_vars sctx ~dir glob ~scope in + let src_glob = SC.expand_vars_string sctx ~dir glob ~scope in Path.parent_exn (Path.relative src_dir src_glob ~error_loc:loc) in Some diff --git a/src/super_context.ml b/src/super_context.ml index 68c8d90f..7ee8c000 100644 --- a/src/super_context.ml +++ b/src/super_context.ml @@ -274,11 +274,11 @@ let installed_libs t = t.installed_libs let find_scope_by_dir t dir = Scope.DB.find_by_dir t.scopes dir let find_scope_by_name t name = Scope.DB.find_by_name t.scopes name -let expand_var_no_root t ~syntax_version ~var : Var.Kind.t option = +let expand_vars t ~syntax_version ~var : Var.Kind.t option = begin match String_with_vars.Var.destruct var with | Single _ -> () | Pair (_, _) -> - Exn.code_error "expand_var_no_root can't expand forms" + Exn.code_error "expand_vars can't expand forms" [ "var", String_with_vars.Var.sexp_of_t var ] end; @@ -288,16 +288,16 @@ let expand_form t ~syntax_version ~var = begin match String_with_vars.Var.destruct var with | Pair (_, _) -> () | Single _ -> - Exn.code_error "expand_var_no_root can't expand single variables" + Exn.code_error "expand_vars can't expand single variables" [ "var", String_with_vars.Var.sexp_of_t var ] end; Var.Map.expand t.forms ~syntax_version ~var -let (expand_vars, expand_vars_path) = +let (expand_vars_string, expand_vars_path) = let expand t ~scope ~dir ?(extra_vars=String.Map.empty) s = String_with_vars.expand ~mode:Single ~dir s ~f:(fun var syntax_version -> - match expand_var_no_root t ~syntax_version ~var with + match expand_vars t ~syntax_version ~var with | None -> String.Map.find extra_vars (String_with_vars.Var.full_name var) | Some v -> @@ -320,7 +320,7 @@ let (expand_vars, expand_vars_path) = 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 f = expand_vars_string t ~scope ~dir ?extra_vars in let parse ~loc:_ s = s in let (syntax, files) = Ordered_set_lang.Unexpanded.files set ~f in match String.Set.to_list files with @@ -648,7 +648,7 @@ module Deps = struct let make_alias t ~scope ~dir s = let loc = String_with_vars.loc s in - Alias.of_user_written_path ~loc ((expand_vars_path t ~scope ~dir s)) + Alias.of_user_written_path ~loc (expand_vars_path t ~scope ~dir s) let dep t ~scope ~dir = function | File s -> @@ -678,7 +678,7 @@ module Deps = struct Build.source_tree ~dir:path ~file_tree:t.file_tree >>^ Path.Set.to_list | Package p -> - let pkg = Package.Name.of_string (expand_vars t ~scope ~dir p) in + let pkg = Package.Name.of_string (expand_vars_string t ~scope ~dir p) in Alias.dep (Alias.package_install ~context:t.context ~pkg) >>^ fun () -> [] | Universe -> @@ -897,7 +897,7 @@ module Action = struct let res = match String_with_vars.Var.destruct var with | Single var_name -> - begin match expand_var_no_root sctx ~syntax_version ~var with + begin match expand_vars sctx ~syntax_version ~var with | None -> String.Map.find extra_vars key | Some Targets -> targets loc var_name | Some v -> Var.Kind.to_value_no_deps_or_targets v ~scope diff --git a/src/super_context.mli b/src/super_context.mli index ae4bc5c3..54dbe470 100644 --- a/src/super_context.mli +++ b/src/super_context.mli @@ -78,7 +78,7 @@ val dump_env : t -> dir:Path.t -> (unit, Sexp.t list) Build.t val find_scope_by_dir : t -> Path.t -> Scope.t val find_scope_by_name : t -> Dune_project.Name.t -> Scope.t -val expand_vars +val expand_vars_string : t -> scope:Scope.t -> dir:Path.t From 43b15bf9444fa0220ac3a14eeb40dda14051fbb4 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Sat, 7 Jul 2018 21:37:25 +0700 Subject: [PATCH 17/36] Add Var module to Super_context Signed-off-by: Rudi Grinberg --- src/super_context.ml | 56 +++++++++++++++++++++++++++++++++++++++++--- 1 file changed, 53 insertions(+), 3 deletions(-) diff --git a/src/super_context.ml b/src/super_context.ml index 7ee8c000..1cbf8206 100644 --- a/src/super_context.ml +++ b/src/super_context.ml @@ -33,7 +33,56 @@ module Env_node = struct } end -module Var = struct +module Var : sig + module Kind : sig + type t = + | Values of Value.t list + | Project_root + | First_dep + | Deps + | Targets + + val to_value_no_deps_or_targets : t -> scope:Scope.t -> Value.t list option + end + + module Form : sig + type t = + | Exe + | Dep + | Bin + | Lib + | Libexec + | Lib_available + | Version + | Read + | Read_strings + | Read_lines + | Path_no_dep + end + + type 'a t = + | Nothing of 'a + | Since of 'a * Syntax.Version.t + | Deleted_in of 'a * Syntax.Version.t + | Renamed_in of Syntax.Version.t * string + + module Map : sig + type 'a var + type 'a t + + val create_vars : context:Context.t -> cxx_flags:string list -> Kind.t t + + val forms : Form.t t + + val static_vars : Kind.t t + + val expand + : 'a t + -> syntax_version:Syntax.Version.t + -> var:String_with_vars.Var.t + -> 'a option + end with type 'a var := 'a t +end = struct module Kind = struct type t = | Values of Value.t list @@ -42,7 +91,8 @@ module Var = struct | Deps | Targets - let to_value_no_deps_or_targets ~scope = function + let to_value_no_deps_or_targets t ~scope = + match t with | Values v -> Some v | Project_root -> Some [Value.Dir (Scope.root scope)] | First_dep @@ -648,7 +698,7 @@ module Deps = struct let make_alias t ~scope ~dir s = let loc = String_with_vars.loc s in - Alias.of_user_written_path ~loc (expand_vars_path t ~scope ~dir s) + Alias.of_user_written_path ~loc ((expand_vars_path t ~scope ~dir s)) let dep t ~scope ~dir = function | File s -> From 843792ad5d3d10e9d0938f6311bb15a642ada1b4 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Sun, 8 Jul 2018 00:25:16 +0700 Subject: [PATCH 18/36] Switch from maps to tables for variables Signed-off-by: Rudi Grinberg --- src/stdune/hashtbl.ml | 18 ++++++++++++++++++ src/stdune/hashtbl_intf.ml | 2 ++ src/stdune/string.ml | 3 +++ src/stdune/string.mli | 1 + src/super_context.ml | 10 +++++----- 5 files changed, 29 insertions(+), 5 deletions(-) diff --git a/src/stdune/hashtbl.ml b/src/stdune/hashtbl.ml index abadd237..3e8c41e5 100644 --- a/src/stdune/hashtbl.ml +++ b/src/stdune/hashtbl.ml @@ -37,6 +37,24 @@ module Make(H : Hashable.S) = struct fold t ~init ~f:(fun ~key ~data acc -> f key data acc) let fold t ~init ~f = foldi t ~init ~f:(fun _ x -> f x) end + + let of_list l = + let h = create (List.length l) in + let rec loop = function + | [] -> Result.Ok h + | (k, v) :: xs -> + begin match find h k with + | None -> add h k v; loop xs + | Some v' -> Error (k, v', v) + end + in + loop l + + let of_list_exn l = + match of_list l with + | Result.Ok h -> h + | Error (_, _, _) -> + Exn.code_error "Hashtbl.of_list_exn duplicate keys" [] end open MoreLabels.Hashtbl diff --git a/src/stdune/hashtbl_intf.ml b/src/stdune/hashtbl_intf.ml index 3d30d0e1..c09d8d27 100644 --- a/src/stdune/hashtbl_intf.ml +++ b/src/stdune/hashtbl_intf.ml @@ -8,4 +8,6 @@ module type S = sig val fold : 'a t -> init:'b -> f:('a -> 'b -> 'b) -> 'b val foldi : 'a t -> init:'b -> f:(key -> 'a -> 'b -> 'b) -> 'b + + val of_list_exn : (key * 'a) list -> 'a t end diff --git a/src/stdune/string.ml b/src/stdune/string.ml index bc7e87f9..3bb7f50e 100644 --- a/src/stdune/string.ml +++ b/src/stdune/string.ml @@ -16,6 +16,8 @@ let compare a b = Ordering.of_int (String.compare a b) module T = struct type t = StringLabels.t let compare = compare + let equal (x : t) (y : t) = x = y + let hash (s : t) = Hashtbl.hash s end let capitalize = capitalize_ascii @@ -201,6 +203,7 @@ let maybe_quoted s = module Set = Set.Make(T) module Map = Map.Make(T) +module Table = Hashtbl.Make(T) let enumerate_gen s = let s = " " ^ s ^ " " in diff --git a/src/stdune/string.mli b/src/stdune/string.mli index a2c9d982..54818776 100644 --- a/src/stdune/string.mli +++ b/src/stdune/string.mli @@ -53,3 +53,4 @@ val enumerate_or : string list -> string module Set : Set.S with type elt = t module Map : Map.S with type key = t +module Table : Hashtbl.S with type key = t diff --git a/src/super_context.ml b/src/super_context.ml index 1cbf8206..e32cfa07 100644 --- a/src/super_context.ml +++ b/src/super_context.ml @@ -122,7 +122,7 @@ end = struct | Renamed_in of Syntax.Version.t * string module Map = struct - type nonrec 'a t = 'a t String.Map.t + type nonrec 'a t = 'a t String.Table.t let values v = Nothing (Kind.Values v) let renamed_in ~new_name ~version = Renamed_in (version, new_name) @@ -161,7 +161,7 @@ end = struct ; "path-no-dep", deleted_in ~version:(1, 0) Path_no_dep ] - |> String.Map.of_list_exn + |> String.Table.of_list_exn let create_vars ~(context : Context.t) ~cxx_flags = let ocamlopt = @@ -226,9 +226,9 @@ end = struct ; vars ] |> List.concat - |> String.Map.of_list_exn + |> String.Table.of_list_exn - let static_vars = String.Map.of_list_exn static_vars + let static_vars = String.Table.of_list_exn static_vars let rec expand t ~syntax_version ~var = let name = @@ -236,7 +236,7 @@ end = struct | Single v -> v | Pair (v, _) -> v in - Option.bind (String.Map.find t name) ~f:(function + Option.bind (String.Table.find t name) ~f:(function | Nothing v -> Some v | Since (v, min_version) -> if syntax_version >= min_version then From 9750f84b76b5d9b10299584ee09614ceeb3b5cae Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Sun, 8 Jul 2018 14:21:23 +0700 Subject: [PATCH 19/36] Remove String_with_var.Loc.fail Signed-off-by: Rudi Grinberg --- src/string_with_vars.ml | 2 +- src/string_with_vars.mli | 4 ++-- src/super_context.ml | 42 +++++++++++++++++++++------------------- 3 files changed, 25 insertions(+), 23 deletions(-) diff --git a/src/string_with_vars.ml b/src/string_with_vars.ml index 05d9d2ff..66aca1c7 100644 --- a/src/string_with_vars.ml +++ b/src/string_with_vars.ml @@ -211,7 +211,7 @@ module Var = struct let to_string = string_of_var - let fail v ~f = Loc.fail (loc v) "%s" (f (to_string v)) + let pp fmt t = Format.pp_print_string fmt (to_string t) let sexp_of_t t = Sexp.atom (to_string t) diff --git a/src/string_with_vars.mli b/src/string_with_vars.mli index 7dda300f..3bf6ee5b 100644 --- a/src/string_with_vars.mli +++ b/src/string_with_vars.mli @@ -49,6 +49,8 @@ end module Var : sig type t + val pp : t Fmt.t + val sexp_of_t : t -> Sexp.t val loc : t -> Loc.t @@ -60,8 +62,6 @@ module Var : sig val destruct : t -> kind - val fail : t -> f:(string -> string) -> _ - val to_string : t -> string val rename : t -> new_name:string -> t diff --git a/src/super_context.ml b/src/super_context.ml index e32cfa07..4649fbf6 100644 --- a/src/super_context.ml +++ b/src/super_context.ml @@ -242,19 +242,19 @@ end = struct if syntax_version >= min_version then Some v else - String_with_vars.Var.fail var ~f:(fun var -> - sprintf "Variable %s is available in since version %s. \ - Current version is %s" - var - (Syntax.Version.to_string min_version) - (Syntax.Version.to_string syntax_version)) + Loc.fail (String_with_vars.Var.loc var) + "Variable %a is available in since version %s. \ + Current version is %s" + String_with_vars.Var.pp var + (Syntax.Version.to_string min_version) + (Syntax.Version.to_string syntax_version) | Renamed_in (in_version, new_name) -> begin if syntax_version >= in_version then - String_with_vars.Var.fail var ~f:(fun old_name -> - sprintf "Variable %s has been renamed to %s since %s" - old_name - (String_with_vars.Var.(to_string (rename var ~new_name))) - (Syntax.Version.to_string in_version)) + Loc.fail (String_with_vars.Var.loc var) + "Variable %a has been renamed to %s since %s" + String_with_vars.Var.pp var + (String_with_vars.Var.(to_string (rename var ~new_name))) + (Syntax.Version.to_string in_version) else expand t ~syntax_version:in_version ~var:(String_with_vars.Var.rename var ~new_name) @@ -263,12 +263,12 @@ end = struct if syntax_version < in_version then Some v else - String_with_vars.Var.fail var ~f:(fun var -> - sprintf "Variable %s has been deleted in version %s. \ - Current version is: %s" - var - (Syntax.Version.to_string in_version) - (Syntax.Version.to_string syntax_version))) + Loc.fail (String_with_vars.Var.loc var) + "Variable %a has been deleted in version %s. \ + Current version is: %s" + String_with_vars.Var.pp var + (Syntax.Version.to_string in_version) + (Syntax.Version.to_string syntax_version)) end end @@ -354,8 +354,9 @@ let (expand_vars_string, expand_vars_path) = begin match Var.Kind.to_value_no_deps_or_targets ~scope v with | Some _ as v -> v | None -> - String_with_vars.Var.fail var - ~f:(sprintf "Variable %s is not allowed in this context") + Loc.fail (String_with_vars.Var.loc var) + "Variable %a is not allowed in this context" + String_with_vars.Var.pp var end) in let expand_vars t ~scope ~dir ?extra_vars s = @@ -938,7 +939,8 @@ module Action = struct end | Some Path_no_dep -> Some [Value.Dir (Path.relative dir s)] | None -> - String_with_vars.Var.fail var ~f:(sprintf "Unknown form: %s") + Loc.fail (String_with_vars.Var.loc var) "Unknown form: %a" + String_with_vars.Var.pp var end in let expand var syntax_version = From 7b05fc34b6dd360b17bf47ae0e5a7bbc26f400e6 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Sun, 8 Jul 2018 14:24:19 +0700 Subject: [PATCH 20/36] Add String_with_vars.Var.name Signed-off-by: Rudi Grinberg --- src/string_with_vars.ml | 2 ++ src/string_with_vars.mli | 1 + src/super_context.ml | 6 +----- 3 files changed, 4 insertions(+), 5 deletions(-) diff --git a/src/string_with_vars.ml b/src/string_with_vars.ml index 66aca1c7..1f8e1648 100644 --- a/src/string_with_vars.ml +++ b/src/string_with_vars.ml @@ -204,6 +204,8 @@ module Var = struct | None -> Single name | Some p -> Pair (name, p) + let name { name; _ } = name + let full_name t = match destruct t with | Single s -> s diff --git a/src/string_with_vars.mli b/src/string_with_vars.mli index 3bf6ee5b..d5c73ddc 100644 --- a/src/string_with_vars.mli +++ b/src/string_with_vars.mli @@ -53,6 +53,7 @@ module Var : sig val sexp_of_t : t -> Sexp.t + val name : t -> string val loc : t -> Loc.t val full_name : t -> string diff --git a/src/super_context.ml b/src/super_context.ml index 4649fbf6..15eadc98 100644 --- a/src/super_context.ml +++ b/src/super_context.ml @@ -231,11 +231,7 @@ end = struct let static_vars = String.Table.of_list_exn static_vars let rec expand t ~syntax_version ~var = - let name = - match String_with_vars.Var.destruct var with - | Single v -> v - | Pair (v, _) -> v - in + let name = String_with_vars.Var.name var in Option.bind (String.Table.find t name) ~f:(function | Nothing v -> Some v | Since (v, min_version) -> From 5f783be1b24baa3b7a022b5051289dad7f9d0ff4 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Sun, 8 Jul 2018 14:37:49 +0700 Subject: [PATCH 21/36] Use maps instead of hash tables for variable lookup Signed-off-by: Rudi Grinberg --- src/super_context.ml | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/src/super_context.ml b/src/super_context.ml index 15eadc98..ffbdf925 100644 --- a/src/super_context.ml +++ b/src/super_context.ml @@ -122,7 +122,7 @@ end = struct | Renamed_in of Syntax.Version.t * string module Map = struct - type nonrec 'a t = 'a t String.Table.t + type nonrec 'a t = 'a t String.Map.t let values v = Nothing (Kind.Values v) let renamed_in ~new_name ~version = Renamed_in (version, new_name) @@ -161,7 +161,7 @@ end = struct ; "path-no-dep", deleted_in ~version:(1, 0) Path_no_dep ] - |> String.Table.of_list_exn + |> String.Map.of_list_exn let create_vars ~(context : Context.t) ~cxx_flags = let ocamlopt = @@ -226,13 +226,13 @@ end = struct ; vars ] |> List.concat - |> String.Table.of_list_exn + |> String.Map.of_list_exn - let static_vars = String.Table.of_list_exn static_vars + let static_vars = String.Map.of_list_exn static_vars let rec expand t ~syntax_version ~var = let name = String_with_vars.Var.name var in - Option.bind (String.Table.find t name) ~f:(function + Option.bind (String.Map.find t name) ~f:(function | Nothing v -> Some v | Since (v, min_version) -> if syntax_version >= min_version then From 44dc0394b8cd9666dff89cdec2467f4424904ed2 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Sun, 8 Jul 2018 14:42:47 +0700 Subject: [PATCH 22/36] s/Nothing/No_info/ Signed-off-by: Rudi Grinberg --- src/super_context.ml | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/src/super_context.ml b/src/super_context.ml index ffbdf925..4b3f3a65 100644 --- a/src/super_context.ml +++ b/src/super_context.ml @@ -61,7 +61,7 @@ module Var : sig end type 'a t = - | Nothing of 'a + | No_info of 'a | Since of 'a * Syntax.Version.t | Deleted_in of 'a * Syntax.Version.t | Renamed_in of Syntax.Version.t * string @@ -116,7 +116,7 @@ end = struct end type 'a t = - | Nothing of 'a + | No_info of 'a | Since of 'a * Syntax.Version.t | Deleted_in of 'a * Syntax.Version.t | Renamed_in of Syntax.Version.t * string @@ -124,7 +124,7 @@ end = struct module Map = struct type nonrec 'a t = 'a t String.Map.t - let values v = Nothing (Kind.Values v) + let values v = No_info (Kind.Values v) let renamed_in ~new_name ~version = Renamed_in (version, new_name) let deleted_in ~version kind = Deleted_in (kind, version) let since ~version v = Since (v, version) @@ -142,7 +142,7 @@ end = struct ] let forms = - let form kind = Nothing kind in + let form kind = No_info kind in let open Form in [ "exe", form Exe ; "bin", form Bin @@ -233,7 +233,7 @@ end = struct let rec expand t ~syntax_version ~var = let name = String_with_vars.Var.name var in Option.bind (String.Map.find t name) ~f:(function - | Nothing v -> Some v + | No_info v -> Some v | Since (v, min_version) -> if syntax_version >= min_version then Some v From f95c9e01d55cae7d726acdb5ea01dacf52b9fac3 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Sun, 8 Jul 2018 14:46:54 +0700 Subject: [PATCH 23/36] Simplify some checks with an is_form function Signed-off-by: Rudi Grinberg --- src/string_with_vars.ml | 2 ++ src/string_with_vars.mli | 2 ++ src/super_context.ml | 22 ++++++++-------------- 3 files changed, 12 insertions(+), 14 deletions(-) diff --git a/src/string_with_vars.ml b/src/string_with_vars.ml index 1f8e1648..af5144ed 100644 --- a/src/string_with_vars.ml +++ b/src/string_with_vars.ml @@ -219,6 +219,8 @@ module Var = struct let rename t ~new_name = { t with name = new_name } + + let is_form t = Option.is_some t.payload end let partial_expand diff --git a/src/string_with_vars.mli b/src/string_with_vars.mli index d5c73ddc..7af055d2 100644 --- a/src/string_with_vars.mli +++ b/src/string_with_vars.mli @@ -66,6 +66,8 @@ module Var : sig val to_string : t -> string val rename : t -> new_name:string -> t + + val is_form : t -> bool end val expand diff --git a/src/super_context.ml b/src/super_context.ml index 4b3f3a65..dc0c7a66 100644 --- a/src/super_context.ml +++ b/src/super_context.ml @@ -321,24 +321,18 @@ let find_scope_by_dir t dir = Scope.DB.find_by_dir t.scopes dir let find_scope_by_name t name = Scope.DB.find_by_name t.scopes name let expand_vars t ~syntax_version ~var : Var.Kind.t option = - begin match String_with_vars.Var.destruct var with - | Single _ -> () - | Pair (_, _) -> + if String_with_vars.Var.is_form var then Exn.code_error "expand_vars can't expand forms" - [ "var", String_with_vars.Var.sexp_of_t var - ] - end; - Var.Map.expand t.vars ~syntax_version ~var + [ "var", String_with_vars.Var.sexp_of_t var ] + else + Var.Map.expand t.vars ~syntax_version ~var let expand_form t ~syntax_version ~var = - begin match String_with_vars.Var.destruct var with - | Pair (_, _) -> () - | Single _ -> + if String_with_vars.Var.is_form var then + Var.Map.expand t.forms ~syntax_version ~var + else Exn.code_error "expand_vars can't expand single variables" - [ "var", String_with_vars.Var.sexp_of_t var - ] - end; - Var.Map.expand t.forms ~syntax_version ~var + [ "var", String_with_vars.Var.sexp_of_t var ] let (expand_vars_string, expand_vars_path) = let expand t ~scope ~dir ?(extra_vars=String.Map.empty) s = From c244fa9d083ce1ab4dfd1929e86361da5d60d3e3 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Sun, 8 Jul 2018 15:22:01 +0700 Subject: [PATCH 24/36] Share error messages for renamed/since/deleted etc. Signed-off-by: Rudi Grinberg --- src/super_context.ml | 31 ++++++++----------- src/syntax.ml | 27 ++++++++++------ src/syntax.mli | 8 +++++ .../test-cases/dune-jbuild-var-case/run.t | 2 +- .../test-cases/findlib-error/run.t | 2 +- .../test-cases/path-variables/run.t | 6 ++-- 6 files changed, 44 insertions(+), 32 deletions(-) diff --git a/src/super_context.ml b/src/super_context.ml index dc0c7a66..c7fd420a 100644 --- a/src/super_context.ml +++ b/src/super_context.ml @@ -232,25 +232,24 @@ end = struct let rec expand t ~syntax_version ~var = let name = String_with_vars.Var.name var in - Option.bind (String.Map.find t name) ~f:(function + Option.bind (String.Map.find t name) ~f:(fun v -> + let what = + lazy (sprintf "Variable %s" (String_with_vars.Var.to_string var)) in + match v with | No_info v -> Some v | Since (v, min_version) -> if syntax_version >= min_version then Some v else - Loc.fail (String_with_vars.Var.loc var) - "Variable %a is available in since version %s. \ - Current version is %s" - String_with_vars.Var.pp var - (Syntax.Version.to_string min_version) - (Syntax.Version.to_string syntax_version) + Syntax.Error.since (String_with_vars.Var.loc var) + Stanza.syntax syntax_version + ~what:(Lazy.force what) | Renamed_in (in_version, new_name) -> begin if syntax_version >= in_version then - Loc.fail (String_with_vars.Var.loc var) - "Variable %a has been renamed to %s since %s" - String_with_vars.Var.pp var - (String_with_vars.Var.(to_string (rename var ~new_name))) - (Syntax.Version.to_string in_version) + Syntax.Error.renamed_in (String_with_vars.Var.loc var) + Stanza.syntax syntax_version + ~what:(Lazy.force what) + ~to_:(String_with_vars.Var.(to_string (rename var ~new_name))) else expand t ~syntax_version:in_version ~var:(String_with_vars.Var.rename var ~new_name) @@ -259,12 +258,8 @@ end = struct if syntax_version < in_version then Some v else - Loc.fail (String_with_vars.Var.loc var) - "Variable %a has been deleted in version %s. \ - Current version is: %s" - String_with_vars.Var.pp var - (Syntax.Version.to_string in_version) - (Syntax.Version.to_string syntax_version)) + Syntax.Error.deleted_in (String_with_vars.Var.loc var) + Stanza.syntax syntax_version ~what:(Lazy.force what)) end end diff --git a/src/syntax.ml b/src/syntax.ml index 8a95138c..3e778dc2 100644 --- a/src/syntax.ml +++ b/src/syntax.ml @@ -56,6 +56,21 @@ type t = ; supported_versions : Supported_versions.t } +module Error = struct + let since loc t ver ~what = + Loc.fail loc "%s is only available since version %s of %s" + what (Version.to_string ver) t.desc + + let renamed_in loc t ver ~what ~to_ = + Loc.fail loc "%s was renamed to '%s' in the %s version of %s" + what to_ (Version.to_string ver) t.desc + + let deleted_in loc t ver ~what = + Loc.fail loc "%s was deleted in version %s of %s" + what (Version.to_string ver) t.desc +end + + let create ~name ~desc supported_versions = { name ; desc @@ -112,9 +127,7 @@ let deleted_in t ver = return () else begin desc () >>= fun (loc, what) -> - Loc.fail loc - "%s was deleted in version %s of %s" what - (Version.to_string ver) t.desc + Error.deleted_in loc t ver ~what end let renamed_in t ver ~to_ = @@ -123,9 +136,7 @@ let renamed_in t ver ~to_ = return () else begin desc () >>= fun (loc, what) -> - Loc.fail loc - "%s was renamed to '%s' in the %s version of %s" what to_ - (Version.to_string ver) t.desc + Error.renamed_in loc t ver ~what ~to_ end let since t ver = @@ -134,7 +145,5 @@ let since t ver = return () else begin desc () >>= fun (loc, what) -> - Loc.fail loc - "%s is only available since version %s of %s" what - (Version.to_string ver) t.desc + Error.since loc t ver ~what end diff --git a/src/syntax.mli b/src/syntax.mli index 7faf305c..dd9c8e0b 100644 --- a/src/syntax.mli +++ b/src/syntax.mli @@ -20,6 +20,14 @@ end type t +module Error : sig + val since : Loc.t -> t -> Version.t -> what:string -> _ + + val renamed_in : Loc.t -> t -> Version.t -> what:string -> to_:string -> _ + + val deleted_in : Loc.t -> t -> Version.t -> what:string -> _ +end + (** [create ~name ~desc supported_versions] defines a new syntax. [supported_version] is the list of the last minor version of each supported major version. [desc] is used to describe what diff --git a/test/blackbox-tests/test-cases/dune-jbuild-var-case/run.t b/test/blackbox-tests/test-cases/dune-jbuild-var-case/run.t index d78b29db..c7b9f454 100644 --- a/test/blackbox-tests/test-cases/dune-jbuild-var-case/run.t +++ b/test/blackbox-tests/test-cases/dune-jbuild-var-case/run.t @@ -6,7 +6,7 @@ All builtin variables are lower cased in Dune: $ dune runtest --root dune-upper Entering directory 'dune-upper' File "dune", line 3, characters 41-46: - Error: Variable %{MAKE} has been renamed to %{make} since 1.0 + Error: Variable %{MAKE} was renamed to '%{make}' in the 1.0 version of the dune language [1] jbuild files retain the the old names: diff --git a/test/blackbox-tests/test-cases/findlib-error/run.t b/test/blackbox-tests/test-cases/findlib-error/run.t index 3a1ee84f..fe09a0e8 100644 --- a/test/blackbox-tests/test-cases/findlib-error/run.t +++ b/test/blackbox-tests/test-cases/findlib-error/run.t @@ -3,7 +3,7 @@ We are dropping support for findlib in dune $ dune build --root in-dune target.txt Entering directory 'in-dune' File "dune", line 2, characters 25-37: - Error: Variable %{findlib:pkg} has been renamed to %{lib:pkg} since 1.0 + Error: Variable %{findlib:pkg} was renamed to '%{lib:pkg}' in the 1.0 version of the dune language [1] But it must still be available in jbuild files diff --git a/test/blackbox-tests/test-cases/path-variables/run.t b/test/blackbox-tests/test-cases/path-variables/run.t index 5d6a2c26..e4f2afc5 100644 --- a/test/blackbox-tests/test-cases/path-variables/run.t +++ b/test/blackbox-tests/test-cases/path-variables/run.t @@ -9,7 +9,7 @@ In expands to a file name, and registers this as a dependency. $ dune build --root dune @test-dep Entering directory 'dune' File "dune", line 13, characters 17-47: - Error: Variable %{path:file-that-does-not-exist} has been renamed to %{dep:file-that-does-not-exist} since 1.0 + Error: Variable %{path:file-that-does-not-exist} was renamed to '%{dep:file-that-does-not-exist}' in the 1.0 version of the dune language [1] %{path-no-dep:string} @@ -20,7 +20,7 @@ This form does not exist, but displays an hint: $ dune build --root dune-invalid @test-path-no-dep Entering directory 'dune-invalid' File "dune", line 7, characters 17-54: - Error: Variable %{path-no-dep:file-that-does-not-exist} has been deleted in version 1.0. Current version is: 1.0 + Error: Variable %{path-no-dep:file-that-does-not-exist} was deleted in version 1.0 of the dune language [1] jbuild files @@ -53,5 +53,5 @@ This form does not exist, but displays an hint: $ dune build --root jbuild-invalid @test-dep Entering directory 'jbuild-invalid' File "jbuild", line 5, characters 16-37: - Error: Variable ${dep:generated-file} is available in since version 1.0. Current version is 0.0 + Error: Variable ${dep:generated-file} is only available since version 0.0 of the dune language [1] From 78140ca2354766d9c370f041ee422dc057b94fa5 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Sun, 8 Jul 2018 15:30:29 +0700 Subject: [PATCH 25/36] Remove the targets helper function Signed-off-by: Rudi Grinberg --- src/super_context.ml | 30 ++++++++++++++++-------------- 1 file changed, 16 insertions(+), 14 deletions(-) diff --git a/src/super_context.ml b/src/super_context.ml index c7fd420a..ad9fd54b 100644 --- a/src/super_context.ml +++ b/src/super_context.ml @@ -822,18 +822,6 @@ module Action = struct ; ddeps = String.Map.empty } in - let targets loc name = - let var = - match name with - | "@" -> sprintf "${%s}" name - | "targets" -> sprintf "%%{%s}" name - | _ -> assert false - in - match targets_written_by_user with - | Infer -> Loc.fail loc "You cannot use %s with inferred rules." var - | Alias -> Loc.fail loc "You cannot use %s in aliases." var - | Static l -> Some (Value.L.dirs l) (* XXX hack to signal no dep *) - in let expand_form s var syntax_version = let loc = String_with_vars.Var.loc var in let key = String_with_vars.Var.full_name var in @@ -933,13 +921,27 @@ module Action = struct let key = String_with_vars.Var.full_name var in let res = match String_with_vars.Var.destruct var with + | Pair (_, s) -> expand_form s var syntax_version | Single var_name -> begin match expand_vars sctx ~syntax_version ~var with | None -> String.Map.find extra_vars key - | Some Targets -> targets loc var_name + | Some Targets -> + let var () = + match var_name with + | "@" -> sprintf "${%s}" var_name + | "targets" -> sprintf "%%{%s}" var_name + | _ -> assert false + in + begin match targets_written_by_user with + | Infer -> + Loc.fail loc "You cannot use %s with inferred rules." (var ()) + | Alias -> + Loc.fail loc "You cannot use %s in aliases." (var ()) + | Static l -> + Some (Value.L.dirs l) (* XXX hack to signal no dep *) + end | Some v -> Var.Kind.to_value_no_deps_or_targets v ~scope end - | Pair (_, s) -> expand_form s var syntax_version in Option.iter res ~f:(fun v -> acc.sdeps <- Path.Set.union From 1b918ecc74bdddd1241460e1bdc9fc7a3b3c02ae Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Sun, 8 Jul 2018 15:52:58 +0700 Subject: [PATCH 26/36] Improve error message for renamed forms Don't include the payload in these messages Signed-off-by: Rudi Grinberg --- src/string_with_vars.ml | 7 +++++-- src/string_with_vars.mli | 4 +++- src/super_context.ml | 21 ++++++++++++------- .../test-cases/findlib-error/run.t | 2 +- .../test-cases/path-variables/run.t | 2 +- 5 files changed, 24 insertions(+), 12 deletions(-) diff --git a/src/string_with_vars.ml b/src/string_with_vars.ml index af5144ed..ee28cb0e 100644 --- a/src/string_with_vars.ml +++ b/src/string_with_vars.ml @@ -217,8 +217,11 @@ module Var = struct let sexp_of_t t = Sexp.atom (to_string t) - let rename t ~new_name = - { t with name = new_name } + let with_payload t ~payload = + { t with payload } + + let with_name t ~name = + { t with name } let is_form t = Option.is_some t.payload end diff --git a/src/string_with_vars.mli b/src/string_with_vars.mli index 7af055d2..cfd39633 100644 --- a/src/string_with_vars.mli +++ b/src/string_with_vars.mli @@ -65,7 +65,9 @@ module Var : sig val to_string : t -> string - val rename : t -> new_name:string -> t + val with_name : t -> name:string -> t + + val with_payload : t -> payload:string option -> t val is_form : t -> bool end diff --git a/src/super_context.ml b/src/super_context.ml index ad9fd54b..bb228365 100644 --- a/src/super_context.ml +++ b/src/super_context.ml @@ -233,8 +233,8 @@ end = struct let rec expand t ~syntax_version ~var = let name = String_with_vars.Var.name var in Option.bind (String.Map.find t name) ~f:(fun v -> - let what = - lazy (sprintf "Variable %s" (String_with_vars.Var.to_string var)) in + let what var = + sprintf "Variable %s" (String_with_vars.Var.to_string var) in match v with | No_info v -> Some v | Since (v, min_version) -> @@ -243,23 +243,30 @@ end = struct else Syntax.Error.since (String_with_vars.Var.loc var) Stanza.syntax syntax_version - ~what:(Lazy.force what) + ~what:(what var) | Renamed_in (in_version, new_name) -> begin if syntax_version >= in_version then + let var = + if String_with_vars.Var.is_form var then + String_with_vars.Var.with_payload var ~payload:(Some "..") + else + var + in Syntax.Error.renamed_in (String_with_vars.Var.loc var) Stanza.syntax syntax_version - ~what:(Lazy.force what) - ~to_:(String_with_vars.Var.(to_string (rename var ~new_name))) + ~what:(what var) + ~to_:(let open String_with_vars.Var in + to_string (with_name var ~name:new_name)) else expand t ~syntax_version:in_version - ~var:(String_with_vars.Var.rename var ~new_name) + ~var:(String_with_vars.Var.with_name var ~name:new_name) end | Deleted_in (v, in_version) -> if syntax_version < in_version then Some v else Syntax.Error.deleted_in (String_with_vars.Var.loc var) - Stanza.syntax syntax_version ~what:(Lazy.force what)) + Stanza.syntax syntax_version ~what:(what var)) end end diff --git a/test/blackbox-tests/test-cases/findlib-error/run.t b/test/blackbox-tests/test-cases/findlib-error/run.t index fe09a0e8..d1e64918 100644 --- a/test/blackbox-tests/test-cases/findlib-error/run.t +++ b/test/blackbox-tests/test-cases/findlib-error/run.t @@ -3,7 +3,7 @@ We are dropping support for findlib in dune $ dune build --root in-dune target.txt Entering directory 'in-dune' File "dune", line 2, characters 25-37: - Error: Variable %{findlib:pkg} was renamed to '%{lib:pkg}' in the 1.0 version of the dune language + Error: Variable %{findlib:..} was renamed to '%{lib:..}' in the 1.0 version of the dune language [1] But it must still be available in jbuild files diff --git a/test/blackbox-tests/test-cases/path-variables/run.t b/test/blackbox-tests/test-cases/path-variables/run.t index e4f2afc5..def72b6c 100644 --- a/test/blackbox-tests/test-cases/path-variables/run.t +++ b/test/blackbox-tests/test-cases/path-variables/run.t @@ -9,7 +9,7 @@ In expands to a file name, and registers this as a dependency. $ dune build --root dune @test-dep Entering directory 'dune' File "dune", line 13, characters 17-47: - Error: Variable %{path:file-that-does-not-exist} was renamed to '%{dep:file-that-does-not-exist}' in the 1.0 version of the dune language + Error: Variable %{path:..} was renamed to '%{dep:..}' in the 1.0 version of the dune language [1] %{path-no-dep:string} From 647f68dfe969911cb299a3bb6be02ac7d81779b3 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Sun, 8 Jul 2018 15:54:26 +0700 Subject: [PATCH 27/36] Move Super_context.Var into own module Signed-off-by: Rudi Grinberg --- src/super_context.ml | 237 ------------------------------------------- src/var.ml | 187 ++++++++++++++++++++++++++++++++++ src/var.mli | 48 +++++++++ 3 files changed, 235 insertions(+), 237 deletions(-) create mode 100644 src/var.ml create mode 100644 src/var.mli diff --git a/src/super_context.ml b/src/super_context.ml index bb228365..6c59e708 100644 --- a/src/super_context.ml +++ b/src/super_context.ml @@ -33,243 +33,6 @@ module Env_node = struct } end -module Var : sig - module Kind : sig - type t = - | Values of Value.t list - | Project_root - | First_dep - | Deps - | Targets - - val to_value_no_deps_or_targets : t -> scope:Scope.t -> Value.t list option - end - - module Form : sig - type t = - | Exe - | Dep - | Bin - | Lib - | Libexec - | Lib_available - | Version - | Read - | Read_strings - | Read_lines - | Path_no_dep - end - - type 'a t = - | No_info of 'a - | Since of 'a * Syntax.Version.t - | Deleted_in of 'a * Syntax.Version.t - | Renamed_in of Syntax.Version.t * string - - module Map : sig - type 'a var - type 'a t - - val create_vars : context:Context.t -> cxx_flags:string list -> Kind.t t - - val forms : Form.t t - - val static_vars : Kind.t t - - val expand - : 'a t - -> syntax_version:Syntax.Version.t - -> var:String_with_vars.Var.t - -> 'a option - end with type 'a var := 'a t -end = struct - module Kind = struct - type t = - | Values of Value.t list - | Project_root - | First_dep - | Deps - | Targets - - let to_value_no_deps_or_targets t ~scope = - match t with - | Values v -> Some v - | Project_root -> Some [Value.Dir (Scope.root scope)] - | First_dep - | Deps - | Targets -> None - end - - module Form = struct - type t = - | Exe - | Dep - | Bin - | Lib - | Libexec - | Lib_available - | Version - | Read - | Read_strings - | Read_lines - | Path_no_dep - end - - type 'a t = - | No_info of 'a - | Since of 'a * Syntax.Version.t - | Deleted_in of 'a * Syntax.Version.t - | Renamed_in of Syntax.Version.t * string - - module Map = struct - type nonrec 'a t = 'a t String.Map.t - - let values v = No_info (Kind.Values v) - let renamed_in ~new_name ~version = Renamed_in (version, new_name) - let deleted_in ~version kind = Deleted_in (kind, version) - let since ~version v = Since (v, version) - - let static_vars = - [ "first-dep", since ~version:(1, 0) Kind.First_dep - ; "targets", since ~version:(1, 0) Kind.Targets - ; "deps", since ~version:(1, 0) Kind.Deps - ; "project_root", since ~version:(1, 0) Kind.Project_root - - ; "<", renamed_in ~version:(1, 0) ~new_name:"first-dep" - ; "@", renamed_in ~version:(1, 0) ~new_name:"targets" - ; "^", renamed_in ~version:(1, 0) ~new_name:"deps" - ; "SCOPE_ROOT", renamed_in ~version:(1, 0) ~new_name:"project_root" - ] - - let forms = - let form kind = No_info kind in - let open Form in - [ "exe", form Exe - ; "bin", form Bin - ; "lib", form Lib - ; "libexec", form Libexec - ; "lib-available", form Lib_available - ; "version", form Version - ; "read", form Read - ; "read-lines", form Read_lines - ; "read-strings", form Read_strings - - ; "dep", since ~version:(1, 0) Dep - - ; "path", renamed_in ~version:(1, 0) ~new_name:"dep" - ; "findlib", renamed_in ~version:(1, 0) ~new_name:"lib" - - ; "path-no-dep", deleted_in ~version:(1, 0) Path_no_dep - ] - |> String.Map.of_list_exn - - let create_vars ~(context : Context.t) ~cxx_flags = - let ocamlopt = - match context.ocamlopt with - | None -> Path.relative context.ocaml_bin "ocamlopt" - | Some p -> p - in - let string s = values [Value.String s] in - let path p = values [Value.Path p] in - let make = - match Bin.make with - | None -> string "make" - | Some p -> path p - in - let cflags = context.ocamlc_cflags in - let strings s = values (Value.L.strings s) in - let lowercased = - [ "cpp" , strings (context.c_compiler :: cflags @ ["-E"]) - ; "cc" , strings (context.c_compiler :: cflags) - ; "cxx" , strings (context.c_compiler :: cxx_flags) - ; "ocaml" , path context.ocaml - ; "ocamlc" , path context.ocamlc - ; "ocamlopt" , path ocamlopt - ; "arch_sixtyfour" , string (string_of_bool context.arch_sixtyfour) - ; "make" , make - ; "root" , values [Value.Dir context.build_dir] - ] in - let uppercased = - List.map lowercased ~f:(fun (k, _) -> - (String.uppercase k, renamed_in ~new_name:k ~version:(1, 0))) in - let vars = - [ "-verbose" , values [] - ; "pa_cpp" , strings (context.c_compiler :: cflags - @ ["-undef"; "-traditional"; - "-x"; "c"; "-E"]) - ; "ocaml_bin" , path context.ocaml_bin - ; "ocaml_version" , string context.version_string - ; "ocaml_where" , string (Path.to_string context.stdlib_dir) - ; "null" , string (Path.to_string Config.dev_null) - ; "ext_obj" , string context.ext_obj - ; "ext_asm" , string context.ext_asm - ; "ext_lib" , string context.ext_lib - ; "ext_dll" , string context.ext_dll - ; "ext_exe" , string context.ext_exe - ; "profile" , string context.profile - ] - in - let ocaml_config = - List.map (Ocaml_config.to_list context.ocaml_config) ~f:(fun (k, v) -> - ("ocaml-config:" ^ k, - match (v : Ocaml_config.Value.t) with - | Bool x -> string (string_of_bool x) - | Int x -> string (string_of_int x) - | String x -> string x - | Words x -> strings x - | Prog_and_args x -> strings (x.prog :: x.args))) - in - [ ocaml_config - ; static_vars - ; lowercased - ; uppercased - ; vars - ] - |> List.concat - |> String.Map.of_list_exn - - let static_vars = String.Map.of_list_exn static_vars - - let rec expand t ~syntax_version ~var = - let name = String_with_vars.Var.name var in - Option.bind (String.Map.find t name) ~f:(fun v -> - let what var = - sprintf "Variable %s" (String_with_vars.Var.to_string var) in - match v with - | No_info v -> Some v - | Since (v, min_version) -> - if syntax_version >= min_version then - Some v - else - Syntax.Error.since (String_with_vars.Var.loc var) - Stanza.syntax syntax_version - ~what:(what var) - | Renamed_in (in_version, new_name) -> begin - if syntax_version >= in_version then - let var = - if String_with_vars.Var.is_form var then - String_with_vars.Var.with_payload var ~payload:(Some "..") - else - var - in - Syntax.Error.renamed_in (String_with_vars.Var.loc var) - Stanza.syntax syntax_version - ~what:(what var) - ~to_:(let open String_with_vars.Var in - to_string (with_name var ~name:new_name)) - else - expand t ~syntax_version:in_version - ~var:(String_with_vars.Var.with_name var ~name:new_name) - end - | Deleted_in (v, in_version) -> - if syntax_version < in_version then - Some v - else - Syntax.Error.deleted_in (String_with_vars.Var.loc var) - Stanza.syntax syntax_version ~what:(what var)) - end -end - type t = { context : Context.t ; build_system : Build_system.t diff --git a/src/var.ml b/src/var.ml new file mode 100644 index 00000000..7713a6a1 --- /dev/null +++ b/src/var.ml @@ -0,0 +1,187 @@ +open Import + +module Kind = struct + type t = + | Values of Value.t list + | Project_root + | First_dep + | Deps + | Targets + + let to_value_no_deps_or_targets t ~scope = + match t with + | Values v -> Some v + | Project_root -> Some [Value.Dir (Scope.root scope)] + | First_dep + | Deps + | Targets -> None +end + +module Form = struct + type t = + | Exe + | Dep + | Bin + | Lib + | Libexec + | Lib_available + | Version + | Read + | Read_strings + | Read_lines + | Path_no_dep +end + +type 'a t = + | No_info of 'a + | Since of 'a * Syntax.Version.t + | Deleted_in of 'a * Syntax.Version.t + | Renamed_in of Syntax.Version.t * string + +module Map = struct + type nonrec 'a t = 'a t String.Map.t + + let values v = No_info (Kind.Values v) + let renamed_in ~new_name ~version = Renamed_in (version, new_name) + let deleted_in ~version kind = Deleted_in (kind, version) + let since ~version v = Since (v, version) + + let static_vars = + [ "first-dep", since ~version:(1, 0) Kind.First_dep + ; "targets", since ~version:(1, 0) Kind.Targets + ; "deps", since ~version:(1, 0) Kind.Deps + ; "project_root", since ~version:(1, 0) Kind.Project_root + + ; "<", renamed_in ~version:(1, 0) ~new_name:"first-dep" + ; "@", renamed_in ~version:(1, 0) ~new_name:"targets" + ; "^", renamed_in ~version:(1, 0) ~new_name:"deps" + ; "SCOPE_ROOT", renamed_in ~version:(1, 0) ~new_name:"project_root" + ] + + let forms = + let form kind = No_info kind in + let open Form in + [ "exe", form Exe + ; "bin", form Bin + ; "lib", form Lib + ; "libexec", form Libexec + ; "lib-available", form Lib_available + ; "version", form Version + ; "read", form Read + ; "read-lines", form Read_lines + ; "read-strings", form Read_strings + + ; "dep", since ~version:(1, 0) Dep + + ; "path", renamed_in ~version:(1, 0) ~new_name:"dep" + ; "findlib", renamed_in ~version:(1, 0) ~new_name:"lib" + + ; "path-no-dep", deleted_in ~version:(1, 0) Path_no_dep + ] + |> String.Map.of_list_exn + + let create_vars ~(context : Context.t) ~cxx_flags = + let ocamlopt = + match context.ocamlopt with + | None -> Path.relative context.ocaml_bin "ocamlopt" + | Some p -> p + in + let string s = values [Value.String s] in + let path p = values [Value.Path p] in + let make = + match Bin.make with + | None -> string "make" + | Some p -> path p + in + let cflags = context.ocamlc_cflags in + let strings s = values (Value.L.strings s) in + let lowercased = + [ "cpp" , strings (context.c_compiler :: cflags @ ["-E"]) + ; "cc" , strings (context.c_compiler :: cflags) + ; "cxx" , strings (context.c_compiler :: cxx_flags) + ; "ocaml" , path context.ocaml + ; "ocamlc" , path context.ocamlc + ; "ocamlopt" , path ocamlopt + ; "arch_sixtyfour" , string (string_of_bool context.arch_sixtyfour) + ; "make" , make + ; "root" , values [Value.Dir context.build_dir] + ] in + let uppercased = + List.map lowercased ~f:(fun (k, _) -> + (String.uppercase k, renamed_in ~new_name:k ~version:(1, 0))) in + let vars = + [ "-verbose" , values [] + ; "pa_cpp" , strings (context.c_compiler :: cflags + @ ["-undef"; "-traditional"; + "-x"; "c"; "-E"]) + ; "ocaml_bin" , path context.ocaml_bin + ; "ocaml_version" , string context.version_string + ; "ocaml_where" , string (Path.to_string context.stdlib_dir) + ; "null" , string (Path.to_string Config.dev_null) + ; "ext_obj" , string context.ext_obj + ; "ext_asm" , string context.ext_asm + ; "ext_lib" , string context.ext_lib + ; "ext_dll" , string context.ext_dll + ; "ext_exe" , string context.ext_exe + ; "profile" , string context.profile + ] + in + let ocaml_config = + List.map (Ocaml_config.to_list context.ocaml_config) ~f:(fun (k, v) -> + ("ocaml-config:" ^ k, + match (v : Ocaml_config.Value.t) with + | Bool x -> string (string_of_bool x) + | Int x -> string (string_of_int x) + | String x -> string x + | Words x -> strings x + | Prog_and_args x -> strings (x.prog :: x.args))) + in + [ ocaml_config + ; static_vars + ; lowercased + ; uppercased + ; vars + ] + |> List.concat + |> String.Map.of_list_exn + + let static_vars = String.Map.of_list_exn static_vars + + let rec expand t ~syntax_version ~var = + let name = String_with_vars.Var.name var in + Option.bind (String.Map.find t name) ~f:(fun v -> + let what var = + sprintf "Variable %s" (String_with_vars.Var.to_string var) in + match v with + | No_info v -> Some v + | Since (v, min_version) -> + if syntax_version >= min_version then + Some v + else + Syntax.Error.since (String_with_vars.Var.loc var) + Stanza.syntax syntax_version + ~what:(what var) + | Renamed_in (in_version, new_name) -> begin + if syntax_version >= in_version then + let var = + if String_with_vars.Var.is_form var then + String_with_vars.Var.with_payload var ~payload:(Some "..") + else + var + in + Syntax.Error.renamed_in (String_with_vars.Var.loc var) + Stanza.syntax syntax_version + ~what:(what var) + ~to_:(let open String_with_vars.Var in + to_string (with_name var ~name:new_name)) + else + expand t ~syntax_version:in_version + ~var:(String_with_vars.Var.with_name var ~name:new_name) + end + | Deleted_in (v, in_version) -> + if syntax_version < in_version then + Some v + else + Syntax.Error.deleted_in (String_with_vars.Var.loc var) + Stanza.syntax syntax_version ~what:(what var)) +end diff --git a/src/var.mli b/src/var.mli new file mode 100644 index 00000000..06778460 --- /dev/null +++ b/src/var.mli @@ -0,0 +1,48 @@ +module Kind : sig + type t = + | Values of Value.t list + | Project_root + | First_dep + | Deps + | Targets + + val to_value_no_deps_or_targets : t -> scope:Scope.t -> Value.t list option +end + +module Form : sig + type t = + | Exe + | Dep + | Bin + | Lib + | Libexec + | Lib_available + | Version + | Read + | Read_strings + | Read_lines + | Path_no_dep +end + +type 'a t = + | No_info of 'a + | Since of 'a * Syntax.Version.t + | Deleted_in of 'a * Syntax.Version.t + | Renamed_in of Syntax.Version.t * string + +module Map : sig + type 'a var + type 'a t + + val create_vars : context:Context.t -> cxx_flags:string list -> Kind.t t + + val forms : Form.t t + + val static_vars : Kind.t t + + val expand + : 'a t + -> syntax_version:Syntax.Version.t + -> var:String_with_vars.Var.t + -> 'a option +end with type 'a var := 'a t From 813b8d9dbcfca78694ea12544425ebc9fa24ddf7 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Sun, 8 Jul 2018 16:20:12 +0700 Subject: [PATCH 28/36] Use correct syntax for error Signed-off-by: Rudi Grinberg --- src/var.ml | 2 +- test/blackbox-tests/test-cases/path-variables/run.t | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/src/var.ml b/src/var.ml index 7713a6a1..03dedd59 100644 --- a/src/var.ml +++ b/src/var.ml @@ -159,7 +159,7 @@ module Map = struct Some v else Syntax.Error.since (String_with_vars.Var.loc var) - Stanza.syntax syntax_version + Stanza.syntax min_version ~what:(what var) | Renamed_in (in_version, new_name) -> begin if syntax_version >= in_version then diff --git a/test/blackbox-tests/test-cases/path-variables/run.t b/test/blackbox-tests/test-cases/path-variables/run.t index def72b6c..e02f6e51 100644 --- a/test/blackbox-tests/test-cases/path-variables/run.t +++ b/test/blackbox-tests/test-cases/path-variables/run.t @@ -53,5 +53,5 @@ This form does not exist, but displays an hint: $ dune build --root jbuild-invalid @test-dep Entering directory 'jbuild-invalid' File "jbuild", line 5, characters 16-37: - Error: Variable ${dep:generated-file} is only available since version 0.0 of the dune language + Error: Variable ${dep:generated-file} is only available since version 1.0 of the dune language [1] From 7cb068d1eb7f59d40a41fe53cd5fb9ca3ac9b601 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Sun, 8 Jul 2018 16:23:40 +0700 Subject: [PATCH 29/36] Improve error messages for all forms Signed-off-by: Rudi Grinberg --- src/var.ml | 16 +++++++--------- .../test-cases/dune-jbuild-var-case/run.t | 2 +- .../test-cases/findlib-error/run.t | 2 +- .../test-cases/path-variables/run.t | 6 +++--- 4 files changed, 12 insertions(+), 14 deletions(-) diff --git a/src/var.ml b/src/var.ml index 03dedd59..eb7a534e 100644 --- a/src/var.ml +++ b/src/var.ml @@ -151,7 +151,12 @@ module Map = struct let name = String_with_vars.Var.name var in Option.bind (String.Map.find t name) ~f:(fun v -> let what var = - sprintf "Variable %s" (String_with_vars.Var.to_string var) in + String_with_vars.Var.to_string ( + if String_with_vars.Var.is_form var then + String_with_vars.Var.with_payload var ~payload:(Some "..") + else + var) + in match v with | No_info v -> Some v | Since (v, min_version) -> @@ -163,17 +168,10 @@ module Map = struct ~what:(what var) | Renamed_in (in_version, new_name) -> begin if syntax_version >= in_version then - let var = - if String_with_vars.Var.is_form var then - String_with_vars.Var.with_payload var ~payload:(Some "..") - else - var - in Syntax.Error.renamed_in (String_with_vars.Var.loc var) Stanza.syntax syntax_version ~what:(what var) - ~to_:(let open String_with_vars.Var in - to_string (with_name var ~name:new_name)) + ~to_:(what (String_with_vars.Var.with_name var ~name:new_name)) else expand t ~syntax_version:in_version ~var:(String_with_vars.Var.with_name var ~name:new_name) diff --git a/test/blackbox-tests/test-cases/dune-jbuild-var-case/run.t b/test/blackbox-tests/test-cases/dune-jbuild-var-case/run.t index c7b9f454..766de354 100644 --- a/test/blackbox-tests/test-cases/dune-jbuild-var-case/run.t +++ b/test/blackbox-tests/test-cases/dune-jbuild-var-case/run.t @@ -6,7 +6,7 @@ All builtin variables are lower cased in Dune: $ dune runtest --root dune-upper Entering directory 'dune-upper' File "dune", line 3, characters 41-46: - Error: Variable %{MAKE} was renamed to '%{make}' in the 1.0 version of the dune language + Error: %{MAKE} was renamed to '%{make}' in the 1.0 version of the dune language [1] jbuild files retain the the old names: diff --git a/test/blackbox-tests/test-cases/findlib-error/run.t b/test/blackbox-tests/test-cases/findlib-error/run.t index d1e64918..248caa52 100644 --- a/test/blackbox-tests/test-cases/findlib-error/run.t +++ b/test/blackbox-tests/test-cases/findlib-error/run.t @@ -3,7 +3,7 @@ We are dropping support for findlib in dune $ dune build --root in-dune target.txt Entering directory 'in-dune' File "dune", line 2, characters 25-37: - Error: Variable %{findlib:..} was renamed to '%{lib:..}' in the 1.0 version of the dune language + Error: %{findlib:..} was renamed to '%{lib:..}' in the 1.0 version of the dune language [1] But it must still be available in jbuild files diff --git a/test/blackbox-tests/test-cases/path-variables/run.t b/test/blackbox-tests/test-cases/path-variables/run.t index e02f6e51..56f4c48f 100644 --- a/test/blackbox-tests/test-cases/path-variables/run.t +++ b/test/blackbox-tests/test-cases/path-variables/run.t @@ -9,7 +9,7 @@ In expands to a file name, and registers this as a dependency. $ dune build --root dune @test-dep Entering directory 'dune' File "dune", line 13, characters 17-47: - Error: Variable %{path:..} was renamed to '%{dep:..}' in the 1.0 version of the dune language + Error: %{path:..} was renamed to '%{dep:..}' in the 1.0 version of the dune language [1] %{path-no-dep:string} @@ -20,7 +20,7 @@ This form does not exist, but displays an hint: $ dune build --root dune-invalid @test-path-no-dep Entering directory 'dune-invalid' File "dune", line 7, characters 17-54: - Error: Variable %{path-no-dep:file-that-does-not-exist} was deleted in version 1.0 of the dune language + Error: %{path-no-dep:..} was deleted in version 1.0 of the dune language [1] jbuild files @@ -53,5 +53,5 @@ This form does not exist, but displays an hint: $ dune build --root jbuild-invalid @test-dep Entering directory 'jbuild-invalid' File "jbuild", line 5, characters 16-37: - Error: Variable ${dep:generated-file} is only available since version 1.0 of the dune language + Error: ${dep:..} is only available since version 1.0 of the dune language [1] From 1a9895aec43ee8f0987309ea77197c70b47c2cef Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Sun, 8 Jul 2018 16:27:47 +0700 Subject: [PATCH 30/36] Consistent naming for vars and forms Signed-off-by: Rudi Grinberg --- src/string_with_vars.ml | 18 +++++++++--------- src/string_with_vars.mli | 6 +++--- src/super_context.ml | 24 ++++++++++++------------ src/var.ml | 28 ++++++++++++++-------------- src/var.mli | 4 ++-- 5 files changed, 40 insertions(+), 40 deletions(-) diff --git a/src/string_with_vars.ml b/src/string_with_vars.ml index ee28cb0e..04aa239f 100644 --- a/src/string_with_vars.ml +++ b/src/string_with_vars.ml @@ -196,20 +196,20 @@ module Var = struct let loc (t : t) = t.loc type kind = - | Single of string - | Pair of string * string + | Var of string + | Macro of string * string let destruct { loc = _ ; name; payload; syntax = _ } = match payload with - | None -> Single name - | Some p -> Pair (name, p) + | None -> Var name + | Some p -> Macro (name, p) let name { name; _ } = name let full_name t = match destruct t with - | Single s -> s - | Pair (k, v) -> k ^ ":" ^ v + | Var s -> s + | Macro (k, v) -> k ^ ":" ^ v let to_string = string_of_var @@ -223,7 +223,7 @@ module Var = struct let with_name t ~name = { t with name } - let is_form t = Option.is_some t.payload + let is_macro t = Option.is_some t.payload end let partial_expand @@ -278,8 +278,8 @@ let expand t ~mode ~dir ~f = 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) + | Var v -> Loc.fail var.loc "unknown variable %S" v + | Macro _ -> Loc.fail var.loc "unknown form %s" (string_of_var var) end | Dollar_brace | Dollar_paren -> Some [Value.String (string_of_var var)] diff --git a/src/string_with_vars.mli b/src/string_with_vars.mli index cfd39633..ddb09575 100644 --- a/src/string_with_vars.mli +++ b/src/string_with_vars.mli @@ -58,8 +58,8 @@ module Var : sig val full_name : t -> string type kind = - | Single of string - | Pair of string * string + | Var of string + | Macro of string * string val destruct : t -> kind @@ -69,7 +69,7 @@ module Var : sig val with_payload : t -> payload:string option -> t - val is_form : t -> bool + val is_macro : t -> bool end val expand diff --git a/src/super_context.ml b/src/super_context.ml index 6c59e708..4d3f69e4 100644 --- a/src/super_context.ml +++ b/src/super_context.ml @@ -46,7 +46,7 @@ type t = ; stanzas_to_consider_for_install : Installable.t list ; cxx_flags : string list ; vars : Var.Kind.t Var.Map.t - ; forms : Var.Form.t Var.Map.t + ; macros : Var.Macro.t Var.Map.t ; chdir : (Action.t, Action.t) Build.t ; host : t option ; libs_by_package : (Package.t * Lib.Set.t) Package.Name.Map.t @@ -86,17 +86,17 @@ let find_scope_by_dir t dir = Scope.DB.find_by_dir t.scopes dir let find_scope_by_name t name = Scope.DB.find_by_name t.scopes name let expand_vars t ~syntax_version ~var : Var.Kind.t option = - if String_with_vars.Var.is_form var then - Exn.code_error "expand_vars can't expand forms" + if String_with_vars.Var.is_macro var then + Exn.code_error "expand_vars can't expand macros" [ "var", String_with_vars.Var.sexp_of_t var ] else Var.Map.expand t.vars ~syntax_version ~var -let expand_form t ~syntax_version ~var = - if String_with_vars.Var.is_form var then - Var.Map.expand t.forms ~syntax_version ~var +let expand_macro t ~syntax_version ~var = + if String_with_vars.Var.is_macro var then + Var.Map.expand t.macros ~syntax_version ~var else - Exn.code_error "expand_vars can't expand single variables" + Exn.code_error "expand_macro can't expand variables" [ "var", String_with_vars.Var.sexp_of_t var ] let (expand_vars_string, expand_vars_path) = @@ -304,7 +304,7 @@ let create ; artifacts ; cxx_flags ; vars - ; forms = Var.Map.forms + ; macros = Var.Map.macros ; chdir = Build.arr (fun (action : Action.t) -> match action with | Chdir _ -> action @@ -595,8 +595,8 @@ module Action = struct let expand_form s var syntax_version = let loc = String_with_vars.Var.loc var in let key = String_with_vars.Var.full_name var in - begin match expand_form sctx ~syntax_version ~var with - | Some Var.Form.Exe -> Some (path_exp (map_exe (Path.relative dir s))) + begin match expand_macro sctx ~syntax_version ~var with + | Some Var.Macro.Exe -> Some (path_exp (map_exe (Path.relative dir s))) | Some Dep -> Some (path_exp (Path.relative dir s)) | Some Bin -> begin let sctx = host sctx in @@ -691,8 +691,8 @@ module Action = struct let key = String_with_vars.Var.full_name var in let res = match String_with_vars.Var.destruct var with - | Pair (_, s) -> expand_form s var syntax_version - | Single var_name -> + | Macro (_, s) -> expand_form s var syntax_version + | Var var_name -> begin match expand_vars sctx ~syntax_version ~var with | None -> String.Map.find extra_vars key | Some Targets -> diff --git a/src/var.ml b/src/var.ml index eb7a534e..8f82d897 100644 --- a/src/var.ml +++ b/src/var.ml @@ -17,7 +17,7 @@ module Kind = struct | Targets -> None end -module Form = struct +module Macro = struct type t = | Exe | Dep @@ -58,18 +58,18 @@ module Map = struct ; "SCOPE_ROOT", renamed_in ~version:(1, 0) ~new_name:"project_root" ] - let forms = - let form kind = No_info kind in - let open Form in - [ "exe", form Exe - ; "bin", form Bin - ; "lib", form Lib - ; "libexec", form Libexec - ; "lib-available", form Lib_available - ; "version", form Version - ; "read", form Read - ; "read-lines", form Read_lines - ; "read-strings", form Read_strings + let macros = + let macro kind = No_info kind in + let open Macro in + [ "exe", macro Exe + ; "bin", macro Bin + ; "lib", macro Lib + ; "libexec", macro Libexec + ; "lib-available", macro Lib_available + ; "version", macro Version + ; "read", macro Read + ; "read-lines", macro Read_lines + ; "read-strings", macro Read_strings ; "dep", since ~version:(1, 0) Dep @@ -152,7 +152,7 @@ module Map = struct Option.bind (String.Map.find t name) ~f:(fun v -> let what var = String_with_vars.Var.to_string ( - if String_with_vars.Var.is_form var then + if String_with_vars.Var.is_macro var then String_with_vars.Var.with_payload var ~payload:(Some "..") else var) diff --git a/src/var.mli b/src/var.mli index 06778460..7adec4f4 100644 --- a/src/var.mli +++ b/src/var.mli @@ -9,7 +9,7 @@ module Kind : sig val to_value_no_deps_or_targets : t -> scope:Scope.t -> Value.t list option end -module Form : sig +module Macro : sig type t = | Exe | Dep @@ -36,7 +36,7 @@ module Map : sig val create_vars : context:Context.t -> cxx_flags:string list -> Kind.t t - val forms : Form.t t + val macros : Macro.t t val static_vars : Kind.t t From 1fb3af8ae8185930b047fa4cc0b02b820d67715e Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Sun, 8 Jul 2018 16:30:24 +0700 Subject: [PATCH 31/36] Rename var to pform Signed-off-by: Rudi Grinberg --- src/{var.ml => pform.ml} | 0 src/{var.mli => pform.mli} | 0 src/super_context.ml | 24 ++++++++++++------------ 3 files changed, 12 insertions(+), 12 deletions(-) rename src/{var.ml => pform.ml} (100%) rename src/{var.mli => pform.mli} (100%) diff --git a/src/var.ml b/src/pform.ml similarity index 100% rename from src/var.ml rename to src/pform.ml diff --git a/src/var.mli b/src/pform.mli similarity index 100% rename from src/var.mli rename to src/pform.mli diff --git a/src/super_context.ml b/src/super_context.ml index 4d3f69e4..efad0fd5 100644 --- a/src/super_context.ml +++ b/src/super_context.ml @@ -45,8 +45,8 @@ type t = ; artifacts : Artifacts.t ; stanzas_to_consider_for_install : Installable.t list ; cxx_flags : string list - ; vars : Var.Kind.t Var.Map.t - ; macros : Var.Macro.t Var.Map.t + ; vars : Pform.Kind.t Pform.Map.t + ; macros : Pform.Macro.t Pform.Map.t ; chdir : (Action.t, Action.t) Build.t ; host : t option ; libs_by_package : (Package.t * Lib.Set.t) Package.Name.Map.t @@ -85,16 +85,16 @@ let installed_libs t = t.installed_libs let find_scope_by_dir t dir = Scope.DB.find_by_dir t.scopes dir let find_scope_by_name t name = Scope.DB.find_by_name t.scopes name -let expand_vars t ~syntax_version ~var : Var.Kind.t option = +let expand_vars t ~syntax_version ~var = if String_with_vars.Var.is_macro var then Exn.code_error "expand_vars can't expand macros" [ "var", String_with_vars.Var.sexp_of_t var ] else - Var.Map.expand t.vars ~syntax_version ~var + Pform.Map.expand t.vars ~syntax_version ~var let expand_macro t ~syntax_version ~var = if String_with_vars.Var.is_macro var then - Var.Map.expand t.macros ~syntax_version ~var + Pform.Map.expand t.macros ~syntax_version ~var else Exn.code_error "expand_macro can't expand variables" [ "var", String_with_vars.Var.sexp_of_t var ] @@ -106,7 +106,7 @@ let (expand_vars_string, expand_vars_path) = | None -> String.Map.find extra_vars (String_with_vars.Var.full_name var) | Some v -> - begin match Var.Kind.to_value_no_deps_or_targets ~scope v with + begin match Pform.Kind.to_value_no_deps_or_targets ~scope v with | Some _ as v -> v | None -> Loc.fail (String_with_vars.Var.loc var) @@ -289,7 +289,7 @@ let create List.filter context.ocamlc_cflags ~f:(fun s -> not (String.is_prefix s ~prefix:"-std=")) in - let vars = Var.Map.create_vars ~context ~cxx_flags in + let vars = Pform.Map.create_vars ~context ~cxx_flags in let t = { context ; host @@ -304,7 +304,7 @@ let create ; artifacts ; cxx_flags ; vars - ; macros = Var.Map.macros + ; macros = Pform.Map.macros ; chdir = Build.arr (fun (action : Action.t) -> match action with | Chdir _ -> action @@ -596,7 +596,7 @@ module Action = struct let loc = String_with_vars.Var.loc var in let key = String_with_vars.Var.full_name var in begin match expand_macro sctx ~syntax_version ~var with - | Some Var.Macro.Exe -> Some (path_exp (map_exe (Path.relative dir s))) + | Some Pform.Macro.Exe -> Some (path_exp (map_exe (Path.relative dir s))) | Some Dep -> Some (path_exp (Path.relative dir s)) | Some Bin -> begin let sctx = host sctx in @@ -710,7 +710,7 @@ module Action = struct | Static l -> Some (Value.L.dirs l) (* XXX hack to signal no dep *) end - | Some v -> Var.Kind.to_value_no_deps_or_targets v ~scope + | Some v -> Pform.Kind.to_value_no_deps_or_targets v ~scope end in Option.iter res ~f:(fun v -> @@ -729,9 +729,9 @@ module Action = struct match String.Map.find dynamic_expansions key with | Some _ as opt -> opt | None -> - Var.Map.expand Var.Map.static_vars ~syntax_version ~var + Pform.Map.expand Pform.Map.static_vars ~syntax_version ~var |> Option.map ~f:(function - | Var.Kind.Deps -> (Value.L.paths deps_written_by_user) + | Pform.Kind.Deps -> (Value.L.paths deps_written_by_user) | First_dep -> begin match deps_written_by_user with | [] -> From bfd246c6679edc0d3842820c99e99b2364c640a8 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Sun, 8 Jul 2018 16:31:39 +0700 Subject: [PATCH 32/36] Rename Kind to Var in Pform Signed-off-by: Rudi Grinberg --- src/pform.ml | 12 ++++++------ src/pform.mli | 6 +++--- src/super_context.ml | 8 ++++---- 3 files changed, 13 insertions(+), 13 deletions(-) diff --git a/src/pform.ml b/src/pform.ml index 8f82d897..f975473b 100644 --- a/src/pform.ml +++ b/src/pform.ml @@ -1,6 +1,6 @@ open Import -module Kind = struct +module Var = struct type t = | Values of Value.t list | Project_root @@ -41,16 +41,16 @@ type 'a t = module Map = struct type nonrec 'a t = 'a t String.Map.t - let values v = No_info (Kind.Values v) + let values v = No_info (Var.Values v) let renamed_in ~new_name ~version = Renamed_in (version, new_name) let deleted_in ~version kind = Deleted_in (kind, version) let since ~version v = Since (v, version) let static_vars = - [ "first-dep", since ~version:(1, 0) Kind.First_dep - ; "targets", since ~version:(1, 0) Kind.Targets - ; "deps", since ~version:(1, 0) Kind.Deps - ; "project_root", since ~version:(1, 0) Kind.Project_root + [ "first-dep", since ~version:(1, 0) Var.First_dep + ; "targets", since ~version:(1, 0) Var.Targets + ; "deps", since ~version:(1, 0) Var.Deps + ; "project_root", since ~version:(1, 0) Var.Project_root ; "<", renamed_in ~version:(1, 0) ~new_name:"first-dep" ; "@", renamed_in ~version:(1, 0) ~new_name:"targets" diff --git a/src/pform.mli b/src/pform.mli index 7adec4f4..d36d3624 100644 --- a/src/pform.mli +++ b/src/pform.mli @@ -1,4 +1,4 @@ -module Kind : sig +module Var : sig type t = | Values of Value.t list | Project_root @@ -34,11 +34,11 @@ module Map : sig type 'a var type 'a t - val create_vars : context:Context.t -> cxx_flags:string list -> Kind.t t + val create_vars : context:Context.t -> cxx_flags:string list -> Var.t t val macros : Macro.t t - val static_vars : Kind.t t + val static_vars : Var.t t val expand : 'a t diff --git a/src/super_context.ml b/src/super_context.ml index efad0fd5..e3c8dbec 100644 --- a/src/super_context.ml +++ b/src/super_context.ml @@ -45,7 +45,7 @@ type t = ; artifacts : Artifacts.t ; stanzas_to_consider_for_install : Installable.t list ; cxx_flags : string list - ; vars : Pform.Kind.t Pform.Map.t + ; vars : Pform.Var.t Pform.Map.t ; macros : Pform.Macro.t Pform.Map.t ; chdir : (Action.t, Action.t) Build.t ; host : t option @@ -106,7 +106,7 @@ let (expand_vars_string, expand_vars_path) = | None -> String.Map.find extra_vars (String_with_vars.Var.full_name var) | Some v -> - begin match Pform.Kind.to_value_no_deps_or_targets ~scope v with + begin match Pform.Var.to_value_no_deps_or_targets ~scope v with | Some _ as v -> v | None -> Loc.fail (String_with_vars.Var.loc var) @@ -710,7 +710,7 @@ module Action = struct | Static l -> Some (Value.L.dirs l) (* XXX hack to signal no dep *) end - | Some v -> Pform.Kind.to_value_no_deps_or_targets v ~scope + | Some v -> Pform.Var.to_value_no_deps_or_targets v ~scope end in Option.iter res ~f:(fun v -> @@ -731,7 +731,7 @@ module Action = struct | None -> Pform.Map.expand Pform.Map.static_vars ~syntax_version ~var |> Option.map ~f:(function - | Pform.Kind.Deps -> (Value.L.paths deps_written_by_user) + | Pform.Var.Deps -> (Value.L.paths deps_written_by_user) | First_dep -> begin match deps_written_by_user with | [] -> From a24b55ed8162f76421ec5cd04701a93eb2cc3c28 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Sun, 8 Jul 2018 17:18:38 +0700 Subject: [PATCH 33/36] Add error for %{read:x} in wrong place Signed-off-by: Rudi Grinberg --- test/blackbox-tests/dune.inc | 10 ++++++ .../blackbox-tests/test-cases/form-error/dune | 1 + .../test-cases/form-error/run.t | 34 +++++++++++++++++++ 3 files changed, 45 insertions(+) create mode 100644 test/blackbox-tests/test-cases/form-error/dune create mode 100644 test/blackbox-tests/test-cases/form-error/run.t diff --git a/test/blackbox-tests/dune.inc b/test/blackbox-tests/dune.inc index 89ee0193..4a8a5b08 100644 --- a/test/blackbox-tests/dune.inc +++ b/test/blackbox-tests/dune.inc @@ -168,6 +168,14 @@ test-cases/force-test (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))) +(alias + (name form-error) + (deps (package dune) (source_tree test-cases/form-error)) + (action + (chdir + test-cases/form-error + (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))) + (alias (name gen-opam-install-file) (deps (package dune) (source_tree test-cases/gen-opam-install-file)) @@ -659,6 +667,7 @@ (alias findlib) (alias findlib-error) (alias force-test) + (alias form-error) (alias gen-opam-install-file) (alias github20) (alias github24) @@ -737,6 +746,7 @@ (alias findlib) (alias findlib-error) (alias force-test) + (alias form-error) (alias gen-opam-install-file) (alias github20) (alias github24) diff --git a/test/blackbox-tests/test-cases/form-error/dune b/test/blackbox-tests/test-cases/form-error/dune new file mode 100644 index 00000000..02ade138 --- /dev/null +++ b/test/blackbox-tests/test-cases/form-error/dune @@ -0,0 +1 @@ +(copy_files %{read:x}/*) \ No newline at end of file diff --git a/test/blackbox-tests/test-cases/form-error/run.t b/test/blackbox-tests/test-cases/form-error/run.t new file mode 100644 index 00000000..a9f8e620 --- /dev/null +++ b/test/blackbox-tests/test-cases/form-error/run.t @@ -0,0 +1,34 @@ +we're getting an acceptable error message when adding a macro form in an +inappropariate place: + + $ dune build + Info: creating file dune-project with this contents: (lang dune 1.0) + /----------------------------------------------------------------------- + | Internal error: Fiber.Execution_context.forward_error: error handler raised. + | Invalid_argument("atom '%{read:x}' cannot be in dune syntax") + | Raised at file "pervasives.ml", line 33, characters 20-45 + | Called from file "src/usexp/usexp.ml", line 26, characters 31-52 + | Called from file "list.ml", line 100, characters 12-15 + | Called from file "src/usexp/usexp.ml", line 36, characters 4-96 + | Called from file "list.ml", line 100, characters 12-15 + | Called from file "src/usexp/usexp.ml", line 36, characters 4-96 + | Called from file "format.ml", line 1288, characters 32-48 + | Called from file "format.ml", line 1337, characters 20-38 + | Called from file "src/report_error.ml", line 108, characters 4-12 + | Called from file "src/fiber/fiber.ml", line 243, characters 6-18 + | Re-raised at file "src/fiber/fiber.ml", line 39, characters 19-26 + | Called from file "src/fiber/fiber.ml", line 56, characters 6-20 + | + | Original exception was: Invalid_argument("atom '%{read:x}' cannot be in dune syntax") + | Raised at file "pervasives.ml", line 33, characters 20-45 + | Called from file "src/usexp/usexp.ml", line 26, characters 31-52 + | Called from file "list.ml", line 100, characters 12-15 + | Called from file "src/usexp/usexp.ml", line 36, characters 4-96 + | Called from file "list.ml", line 100, characters 12-15 + | Called from file "src/usexp/usexp.ml", line 36, characters 4-96 + | Called from file "format.ml", line 1288, characters 32-48 + | Called from file "format.ml", line 1337, characters 20-38 + | Called from file "src/report_error.ml", line 108, characters 4-12 + | Called from file "src/fiber/fiber.ml", line 243, characters 6-18 + \----------------------------------------------------------------------- + [1] From ccabeb7181f2d85512be7d142ad269222171549f Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Sun, 8 Jul 2018 17:25:26 +0700 Subject: [PATCH 34/36] Hack to fix printing of errors This is a temporary hack until we have a real sexp type Signed-off-by: Rudi Grinberg --- src/report_error.ml | 2 +- src/usexp/usexp.ml | 12 +++++ src/usexp/usexp.mli | 4 ++ .../test-cases/form-error/run.t | 54 +++++++++---------- 4 files changed, 43 insertions(+), 29 deletions(-) diff --git a/src/report_error.ml b/src/report_error.ml index 8e6dc01b..f19eaa7e 100644 --- a/src/report_error.ml +++ b/src/report_error.ml @@ -75,7 +75,7 @@ let report_with_backtrace exn = Format.fprintf ppf "@{Internal error, please report upstream \ including the contents of _build/log.@}\n\ Description:%a\n" - (Usexp.pp Dune) sexp + Usexp.pp_quoted sexp } | Unix.Unix_error (err, func, fname) -> { p with pp = fun ppf -> diff --git a/src/usexp/usexp.ml b/src/usexp/usexp.ml index b687686e..eb28b04a 100644 --- a/src/usexp/usexp.ml +++ b/src/usexp/usexp.ml @@ -41,6 +41,18 @@ let rec pp syntax ppf = function Format.pp_close_box ppf () | Template t -> Template.pp syntax ppf t +let pp_quoted = + let rec loop = function + | Atom (A s) as t -> + if Atom.is_valid_dune s then + t + else + Quoted_string s + | List xs -> List (List.map ~f:loop xs) + | (Quoted_string _ | Template _) as t -> t + in + fun ppf t -> pp Dune ppf (loop t) + let pp_print_quoted_string ppf s = let syntax = Dune in if String.contains s '\n' then begin diff --git a/src/usexp/usexp.mli b/src/usexp/usexp.mli index bc0ad768..31810267 100644 --- a/src/usexp/usexp.mli +++ b/src/usexp/usexp.mli @@ -76,6 +76,10 @@ val to_string : t -> syntax:syntax -> string (** Serialize a S-expression using indentation to improve readability *) val pp : syntax -> Format.formatter -> t -> unit +(** Serialization that never fails because it quotes atoms when necessary + TODO remove this once we have a proper sexp type *) +val pp_quoted : Format.formatter -> t -> unit + (** 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 diff --git a/test/blackbox-tests/test-cases/form-error/run.t b/test/blackbox-tests/test-cases/form-error/run.t index a9f8e620..cccf6546 100644 --- a/test/blackbox-tests/test-cases/form-error/run.t +++ b/test/blackbox-tests/test-cases/form-error/run.t @@ -3,32 +3,30 @@ inappropariate place: $ dune build Info: creating file dune-project with this contents: (lang dune 1.0) - /----------------------------------------------------------------------- - | Internal error: Fiber.Execution_context.forward_error: error handler raised. - | Invalid_argument("atom '%{read:x}' cannot be in dune syntax") - | Raised at file "pervasives.ml", line 33, characters 20-45 - | Called from file "src/usexp/usexp.ml", line 26, characters 31-52 - | Called from file "list.ml", line 100, characters 12-15 - | Called from file "src/usexp/usexp.ml", line 36, characters 4-96 - | Called from file "list.ml", line 100, characters 12-15 - | Called from file "src/usexp/usexp.ml", line 36, characters 4-96 - | Called from file "format.ml", line 1288, characters 32-48 - | Called from file "format.ml", line 1337, characters 20-38 - | Called from file "src/report_error.ml", line 108, characters 4-12 - | Called from file "src/fiber/fiber.ml", line 243, characters 6-18 - | Re-raised at file "src/fiber/fiber.ml", line 39, characters 19-26 - | Called from file "src/fiber/fiber.ml", line 56, characters 6-20 - | - | Original exception was: Invalid_argument("atom '%{read:x}' cannot be in dune syntax") - | Raised at file "pervasives.ml", line 33, characters 20-45 - | Called from file "src/usexp/usexp.ml", line 26, characters 31-52 - | Called from file "list.ml", line 100, characters 12-15 - | Called from file "src/usexp/usexp.ml", line 36, characters 4-96 - | Called from file "list.ml", line 100, characters 12-15 - | Called from file "src/usexp/usexp.ml", line 36, characters 4-96 - | Called from file "format.ml", line 1288, characters 32-48 - | Called from file "format.ml", line 1337, characters 20-38 - | Called from file "src/report_error.ml", line 108, characters 4-12 - | Called from file "src/fiber/fiber.ml", line 243, characters 6-18 - \----------------------------------------------------------------------- + Internal error, please report upstream including the contents of _build/log. + Description: + ("expand_vars can't expand macros" (var "\%{read:x}")) + Backtrace: + Raised at file "src/stdune/exn.ml", line 32, characters 5-10 + Called from file "src/super_context.ml", line 105, characters 12-46 + Called from file "src/string_with_vars.ml", line 276, characters 12-32 + Called from file "src/string_with_vars.ml", line 252, characters 20-40 + Called from file "src/string_with_vars.ml", line 275, characters 4-487 + Called from file "src/super_context.ml", line 118, characters 4-38 + Called from file "src/gen_rules.ml", line 204, characters 21-68 + Called from file "src/gen_rules.ml", line 261, characters 25-68 + Called from file "list.ml", line 82, characters 20-23 + Called from file "src/stdune/list.ml" (inlined), line 29, characters 29-39 + Called from file "src/gen_rules.ml", line 254, characters 12-827 + Called from file "src/stdune/hashtbl.ml", line 80, characters 12-17 + Called from file "src/gen_rules.ml", line 1023, characters 16-39 + Called from file "src/gen_rules.ml", line 1086, characters 19-30 + Called from file "src/build_system.ml", line 917, characters 6-62 + Called from file "src/build_system.ml", line 893, characters 6-59 + Re-raised at file "src/build_system.ml", line 904, characters 6-17 + Called from file "src/build_system.ml" (inlined), line 861, characters 32-63 + Called from file "src/build_system.ml", line 871, characters 4-24 + Called from file "src/build_system.ml" (inlined), line 861, characters 32-63 + Called from file "src/build_system.ml", line 1115, characters 6-21 + Called from file "src/fiber/fiber.ml", line 160, characters 6-169 [1] From a2153539e147e0a124338cee18cfea354a22adfe Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Sun, 8 Jul 2018 17:27:35 +0700 Subject: [PATCH 35/36] Fix error messages when percent macros are used incorrectly Signed-off-by: Rudi Grinberg --- src/super_context.ml | 4 +-- .../test-cases/form-error/run.t | 28 ++----------------- 2 files changed, 4 insertions(+), 28 deletions(-) diff --git a/src/super_context.ml b/src/super_context.ml index e3c8dbec..21b3fe09 100644 --- a/src/super_context.ml +++ b/src/super_context.ml @@ -87,8 +87,8 @@ let find_scope_by_name t name = Scope.DB.find_by_name t.scopes name let expand_vars t ~syntax_version ~var = if String_with_vars.Var.is_macro var then - Exn.code_error "expand_vars can't expand macros" - [ "var", String_with_vars.Var.sexp_of_t var ] + Loc.fail (String_with_vars.Var.loc var) + "macros of the form %%{name:..} cannot be expanded here" else Pform.Map.expand t.vars ~syntax_version ~var diff --git a/test/blackbox-tests/test-cases/form-error/run.t b/test/blackbox-tests/test-cases/form-error/run.t index cccf6546..832d5db8 100644 --- a/test/blackbox-tests/test-cases/form-error/run.t +++ b/test/blackbox-tests/test-cases/form-error/run.t @@ -3,30 +3,6 @@ inappropariate place: $ dune build Info: creating file dune-project with this contents: (lang dune 1.0) - Internal error, please report upstream including the contents of _build/log. - Description: - ("expand_vars can't expand macros" (var "\%{read:x}")) - Backtrace: - Raised at file "src/stdune/exn.ml", line 32, characters 5-10 - Called from file "src/super_context.ml", line 105, characters 12-46 - Called from file "src/string_with_vars.ml", line 276, characters 12-32 - Called from file "src/string_with_vars.ml", line 252, characters 20-40 - Called from file "src/string_with_vars.ml", line 275, characters 4-487 - Called from file "src/super_context.ml", line 118, characters 4-38 - Called from file "src/gen_rules.ml", line 204, characters 21-68 - Called from file "src/gen_rules.ml", line 261, characters 25-68 - Called from file "list.ml", line 82, characters 20-23 - Called from file "src/stdune/list.ml" (inlined), line 29, characters 29-39 - Called from file "src/gen_rules.ml", line 254, characters 12-827 - Called from file "src/stdune/hashtbl.ml", line 80, characters 12-17 - Called from file "src/gen_rules.ml", line 1023, characters 16-39 - Called from file "src/gen_rules.ml", line 1086, characters 19-30 - Called from file "src/build_system.ml", line 917, characters 6-62 - Called from file "src/build_system.ml", line 893, characters 6-59 - Re-raised at file "src/build_system.ml", line 904, characters 6-17 - Called from file "src/build_system.ml" (inlined), line 861, characters 32-63 - Called from file "src/build_system.ml", line 871, characters 4-24 - Called from file "src/build_system.ml" (inlined), line 861, characters 32-63 - Called from file "src/build_system.ml", line 1115, characters 6-21 - Called from file "src/fiber/fiber.ml", line 160, characters 6-169 + File "dune", line 1, characters 14-21: + Error: macros of the form %{name:..} cannot be expanded here [1] From 78370d39831828ca1e2864e3c2596a61a6bf908b Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Sun, 8 Jul 2018 17:30:47 +0700 Subject: [PATCH 36/36] Rename test not to use outdated form term Signed-off-by: Rudi Grinberg --- test/blackbox-tests/dune.inc | 20 +++++++++---------- .../{form-error => macro-expand-error}/dune | 0 .../{form-error => macro-expand-error}/run.t | 0 3 files changed, 10 insertions(+), 10 deletions(-) rename test/blackbox-tests/test-cases/{form-error => macro-expand-error}/dune (100%) rename test/blackbox-tests/test-cases/{form-error => macro-expand-error}/run.t (100%) diff --git a/test/blackbox-tests/dune.inc b/test/blackbox-tests/dune.inc index 4a8a5b08..bf0c54a1 100644 --- a/test/blackbox-tests/dune.inc +++ b/test/blackbox-tests/dune.inc @@ -168,14 +168,6 @@ test-cases/force-test (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))) -(alias - (name form-error) - (deps (package dune) (source_tree test-cases/form-error)) - (action - (chdir - test-cases/form-error - (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))) - (alias (name gen-opam-install-file) (deps (package dune) (source_tree test-cases/gen-opam-install-file)) @@ -378,6 +370,14 @@ test-cases/loop (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))) +(alias + (name macro-expand-error) + (deps (package dune) (source_tree test-cases/macro-expand-error)) + (action + (chdir + test-cases/macro-expand-error + (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))) + (alias (name menhir) (deps (package dune) (source_tree test-cases/menhir)) @@ -667,7 +667,6 @@ (alias findlib) (alias findlib-error) (alias force-test) - (alias form-error) (alias gen-opam-install-file) (alias github20) (alias github24) @@ -691,6 +690,7 @@ (alias lib-available) (alias link-deps) (alias loop) + (alias macro-expand-error) (alias menhir) (alias merlin-tests) (alias meta-gen) @@ -746,7 +746,6 @@ (alias findlib) (alias findlib-error) (alias force-test) - (alias form-error) (alias gen-opam-install-file) (alias github20) (alias github24) @@ -768,6 +767,7 @@ (alias lib-available) (alias link-deps) (alias loop) + (alias macro-expand-error) (alias merlin-tests) (alias meta-gen) (alias misc) diff --git a/test/blackbox-tests/test-cases/form-error/dune b/test/blackbox-tests/test-cases/macro-expand-error/dune similarity index 100% rename from test/blackbox-tests/test-cases/form-error/dune rename to test/blackbox-tests/test-cases/macro-expand-error/dune diff --git a/test/blackbox-tests/test-cases/form-error/run.t b/test/blackbox-tests/test-cases/macro-expand-error/run.t similarity index 100% rename from test/blackbox-tests/test-cases/form-error/run.t rename to test/blackbox-tests/test-cases/macro-expand-error/run.t