matthieu
/
dune
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Fix shadowing of forms 

Signed-off-by: Jeremie Dimino <jeremie@dimino.org>
This commit is contained in:
Jeremie Dimino 2018-07-10 05:16:40 +01:00 committed by Jérémie Dimino
parent a738e1bc38
commit bfa73a8cac
5 changed files with 216 additions and 170 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
src/inline_tests.ml
View File

@ -203,7 +203,7 @@ include Sub_system.Register_end_point(
let target = Path.relative inline_test_dir main_module_filename in
let source_modules = Module.Name.Map.values source_modules in
let files ml_kind =
Pform.Values (Value.L.paths (
Pform.Var.Values (Value.L.paths (
List.filter_map source_modules ~f:(fun m ->
Module.file m ~dir ml_kind)))
in

265
src/pform.ml
View File

@ -1,73 +1,93 @@
open Import
type t =
| Values of Value.t list
| Project_root
| First_dep
| Deps
| Targets
| Named_local
| Exe
| Dep
| Bin
| Lib
| Libexec
| Lib_available
| Version
| Read
| Read_strings
| Read_lines
| Path_no_dep
| Ocaml_config
module Var = struct
type t =
| Values of Value.t list
| Project_root
| First_dep
| Deps
| Targets
| Named_local
end
type with_info =
| No_info of t
| Since of t * Syntax.Version.t
| Deleted_in of t * Syntax.Version.t * string option
module Macro = struct
type t =
| Exe
| Dep
| Bin
| Lib
| Libexec
| Lib_available
| Version
| Read
| Read_strings
| Read_lines
| Path_no_dep
| Ocaml_config
end
module Expansion = struct
type t =
| Var of Var.t
| Macro of Macro.t * string
end
type 'a t =
| No_info of 'a
| Since of 'a * Syntax.Version.t
| Deleted_in of 'a * Syntax.Version.t * string option
| Renamed_in of Syntax.Version.t * string
let values v = No_info (Var.Values v)
let renamed_in ~new_name ~version = Renamed_in (version, new_name)
let deleted_in ~version ?repl kind = Deleted_in (kind, version, repl)
let since ~version v = Since (v, version)
module Map = struct
type t = with_info String.Map.t
type 'a map = 'a t String.Map.t
let values v = No_info (Values v)
let renamed_in ~new_name ~version = Renamed_in (version, new_name)
let deleted_in ~version ?repl kind = Deleted_in (kind, version, repl)
let since ~version v = Since (v, version)
type t =
{ vars : Var.t map
; macros : Macro.t map
}
let static =
let macro x = No_info x in
[ "targets", since ~version:(1, 0) Targets
; "deps", since ~version:(1, 0) Deps
; "project_root", since ~version:(1, 0) Project_root
let static_vars =
String.Map.of_list_exn
[ "targets", since ~version:(1, 0) Var.Targets
; "deps", since ~version:(1, 0) Var.Deps
; "project_root", since ~version:(1, 0) Var.Project_root
; "<", deleted_in First_dep ~version:(1, 0)
~repl:"Use a named dependency instead:\
\n\
\n\ (deps (:x <dep>) ...)\
\n\ ... %{x} ..."
; "@", 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"
; "<", deleted_in Var.First_dep ~version:(1, 0)
~repl:"Use a named dependency instead:\
\n\
\n\ (deps (:x <dep>) ...)\
\n\ ... %{x} ..."
; "@", 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"
]
; "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
let macros =
let macro (x : Macro.t) = No_info x in
String.Map.of_list_exn
[ "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
; "dep", since ~version:(1, 0) Macro.Dep
; "path", renamed_in ~version:(1, 0) ~new_name:"dep"
; "findlib", renamed_in ~version:(1, 0) ~new_name:"lib"
; "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
; "ocaml-config", macro Ocaml_config
]
|> String.Map.of_list_exn
; "path-no-dep", deleted_in ~version:(1, 0) Macro.Path_no_dep
; "ocaml-config", macro Ocaml_config
]
let create ~(context : Context.t) ~cxx_flags =
let ocamlopt =
@ -117,67 +137,96 @@ module Map = struct
; "profile" , string context.profile
]
in
String.Map.superpose
static
(String.Map.of_list_exn
(List.concat
[ lowercased
; uppercased
; other
]))
{ vars =
String.Map.superpose
static_vars
(String.Map.of_list_exn
(List.concat
[ lowercased
; uppercased
; other
]))
; macros
}
let superpose = String.Map.superpose
let superpose a b =
{ vars = String.Map.superpose a.vars b.vars
; macros = String.Map.superpose a.macros b.macros
}
let rec expand t ~syntax_version ~pform =
let rec expand map ~syntax_version ~pform =
let open Option.O in
let name = String_with_vars.Var.name pform in
Option.bind (String.Map.find t name) ~f:(fun v ->
let describe = String_with_vars.Var.describe 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 pform)
Stanza.syntax min_version
String.Map.find map name >>= fun v ->
let describe = String_with_vars.Var.describe 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 pform)
Stanza.syntax min_version
~what:(describe pform)
| Renamed_in (in_version, new_name) -> begin
if syntax_version >= in_version then
Syntax.Error.renamed_in (String_with_vars.Var.loc pform)
Stanza.syntax syntax_version
~what:(describe pform)
| Renamed_in (in_version, new_name) -> begin
if syntax_version >= in_version then
Syntax.Error.renamed_in (String_with_vars.Var.loc pform)
Stanza.syntax syntax_version
~what:(describe pform)
~to_:(describe
(String_with_vars.Var.with_name pform ~name:new_name))
else
expand t ~syntax_version:in_version
~pform:(String_with_vars.Var.with_name pform ~name:new_name)
end
| Deleted_in (v, in_version, repl) ->
if syntax_version < in_version then
Some v
~to_:(describe
(String_with_vars.Var.with_name pform ~name:new_name))
else
Syntax.Error.deleted_in (String_with_vars.Var.loc pform)
Stanza.syntax syntax_version ~what:(describe pform) ?repl)
expand map ~syntax_version:in_version
~pform:(String_with_vars.Var.with_name pform ~name:new_name)
end
| Deleted_in (v, in_version, repl) ->
if syntax_version < in_version then
Some v
else
Syntax.Error.deleted_in (String_with_vars.Var.loc pform)
Stanza.syntax syntax_version ~what:(describe pform) ?repl
let empty = String.Map.empty
let expand t ~syntax_version ~pform =
match String_with_vars.Var.payload pform with
| None ->
Option.map (expand t.vars ~syntax_version ~pform) ~f:(fun x ->
Expansion.Var x)
| Some payload ->
Option.map (expand t.macros ~syntax_version ~pform) ~f:(fun x ->
Expansion.Macro (x, payload))
let singleton k v = String.Map.singleton k (No_info v)
let empty =
{ vars = String.Map.empty
; macros = String.Map.empty
}
let singleton k v =
{ vars = String.Map.singleton k (No_info v)
; macros = String.Map.empty
}
let of_list_exn pforms =
List.map ~f:(fun (k, x) -> (k, No_info x)) pforms
|> String.Map.of_list_exn
{ vars = List.map ~f:(fun (k, x) -> (k, No_info x)) pforms
|> String.Map.of_list_exn
; macros = String.Map.empty
}
let of_bindings =
Jbuild.Bindings.fold ~f:(fun x acc ->
match x with
| Unnamed _ -> acc
| Named (s, _) -> String.Map.add acc s (No_info Named_local)
) ~init:empty
let of_bindings bindings =
{ vars =
Jbuild.Bindings.fold bindings ~init:String.Map.empty ~f:(fun x acc ->
match x with
| Unnamed _ -> acc
| Named (s, _) -> String.Map.add acc s (No_info Var.Named_local))
; macros = String.Map.empty
}
let input_file path =
let value = Values (Value.L.paths [path]) in
[ "input-file", since ~version:(1, 0) value
; "<", renamed_in ~new_name:"input-file" ~version:(1, 0)
]
|> String.Map.of_list_exn
let value = Var.Values (Value.L.paths [path]) in
{ vars =
String.Map.of_list_exn
[ "input-file", since ~version:(1, 0) value
; "<", renamed_in ~new_name:"input-file" ~version:(1, 0)
]
; macros = String.Map.empty
}
end

60
src/pform.mli
View File

@ -1,30 +1,38 @@
open Stdune
type t =
(* Variables *)
| Values of Value.t list
| Project_root
| First_dep
| Deps
| Targets
| Named_local
module Var : sig
type t =
| Values of Value.t list
| Project_root
| First_dep
| Deps
| Targets
| Named_local
end
(* Macros *)
| Exe
| Dep
| Bin
| Lib
| Libexec
| Lib_available
| Version
| Read
| Read_strings
| Read_lines
| Path_no_dep
| Ocaml_config
module Macro : sig
type t =
| Exe
| Dep
| Bin
| Lib
| Libexec
| Lib_available
| Version
| Read
| Read_strings
| Read_lines
| Path_no_dep
| Ocaml_config
end
module Expansion : sig
type t =
| Var of Var.t
| Macro of Macro.t * string
end
module Map : sig
type pform
type t
val create : context:Context.t -> cxx_flags:string list -> t
@ -34,9 +42,9 @@ module Map : sig
(** Map with all named values as [Named_local] *)
val of_bindings : _ Jbuild.Bindings.t -> t
val singleton : string -> pform -> t
val singleton : string -> Var.t -> t
val of_list_exn : (string * pform) list -> t
val of_list_exn : (string * Var.t) list -> t
val input_file : Path.t -> t
@ -44,7 +52,7 @@ module Map : sig
: t
-> syntax_version:Syntax.Version.t
-> pform:String_with_vars.Var.t
-> pform option
-> Expansion.t option
val empty : t
end with type pform := t
end

48
src/super_context.ml
View File

@ -85,8 +85,7 @@ 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_ocaml_config t pform =
let name = Option.value_exn (String_with_vars.Var.payload pform) in
let expand_ocaml_config t pform name =
match String.Map.find t.ocaml_config name with
| Some x -> x
| None ->
@ -101,9 +100,9 @@ let (expand_vars_string, expand_vars_path) =
| None -> Pform.Map.expand t.pforms ~syntax_version ~pform
| Some _ as x -> x)
|> Option.map ~f:(function
| Pform.Values l -> l
| Ocaml_config -> expand_ocaml_config t pform
| Project_root -> [Value.Dir (Scope.root scope)]
| Pform.Expansion.Var (Values l) -> l
| Macro (Ocaml_config, s) -> expand_ocaml_config t pform s
| Var Project_root -> [Value.Dir (Scope.root scope)]
| _ ->
Loc.fail (String_with_vars.Var.loc pform)
"%s isn't allowed in this position"
@ -618,15 +617,14 @@ module Action = struct
let expand pform syntax_version =
let loc = String_with_vars.Var.loc pform in
let key = String_with_vars.Var.full_name pform in
let s = Option.value (String_with_vars.Var.payload pform) ~default:"" in
let res =
Pform.Map.expand bindings ~syntax_version ~pform
|> Option.bind ~f:(function
| Pform.Values l -> Some l
| Ocaml_config -> Some (expand_ocaml_config sctx pform)
| Project_root -> Some [Value.Dir (Scope.root scope)]
| First_dep | Deps | Named_local -> None
| Targets ->
| Pform.Expansion.Var (Values l) -> Some l
| Macro (Ocaml_config, s) -> Some (expand_ocaml_config sctx pform s)
| Var Project_root -> Some [Value.Dir (Scope.root scope)]
| Var (First_dep | Deps | Named_local) -> None
| Var Targets ->
begin match targets_written_by_user with
| Infer ->
Loc.fail loc "You cannot use %s with inferred rules."
@ -637,9 +635,9 @@ module Action = struct
| Static l ->
Some (Value.L.dirs l) (* XXX hack to signal no dep *)
end
| Exe -> Some (path_exp (map_exe (Path.relative dir s)))
| Dep -> Some (path_exp (Path.relative dir s))
| Bin -> begin
| Macro (Exe, s) -> Some (path_exp (map_exe (Path.relative dir s)))
| Macro (Dep, s) -> Some (path_exp (Path.relative dir s))
| Macro (Bin, s) -> begin
let sctx = host sctx in
match Artifacts.binary (artifacts sctx) s with
| Ok path -> Some (path_exp path)
@ -647,7 +645,7 @@ module Action = struct
add_fail acc
({ fail = fun () -> Action.Prog.Not_found.raise e })
end
| Lib -> begin
| Macro (Lib, s) -> begin
let lib_dep, file = parse_lib_file ~loc s in
add_lib_dep acc lib_dep dep_kind;
match
@ -656,7 +654,7 @@ module Action = struct
| Ok path -> Some (path_exp path)
| Error fail -> add_fail acc fail
end
| Libexec -> begin
| Macro (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;
@ -679,13 +677,13 @@ module Action = struct
add_ddep acc ~key dep
end
end
| Lib_available -> begin
| Macro (Lib_available, s) -> 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
| Version -> begin
| Macro (Version, s) -> begin
match Package.Name.Map.find (Scope.project scope).packages
(Package.Name.of_string s) with
| Some p ->
@ -701,7 +699,7 @@ module Action = struct
"Package %S doesn't exist in the current project." s
}
end
| Read -> begin
| Macro (Read, s) -> begin
let path = Path.relative dir s in
let data =
Build.contents path
@ -709,7 +707,7 @@ module Action = struct
in
add_ddep acc ~key data
end
| Read_lines -> begin
| Macro (Read_lines, s) -> begin
let path = Path.relative dir s in
let data =
Build.lines_of path
@ -717,7 +715,7 @@ module Action = struct
in
add_ddep acc ~key data
end
| Read_strings -> begin
| Macro (Read_strings, s) -> begin
let path = Path.relative dir s in
let data =
Build.strings path
@ -725,7 +723,7 @@ module Action = struct
in
add_ddep acc ~key data
end
| Path_no_dep -> Some [Value.Dir (Path.relative dir s)])
| Macro (Path_no_dep, s) -> Some [Value.Dir (Path.relative dir s)])
in
Option.iter res ~f:(fun v ->
acc.sdeps <- Path.Set.union
@ -746,7 +744,7 @@ module Action = struct
| Some _ as opt -> opt
| None ->
Option.map (Pform.Map.expand bindings ~syntax_version ~pform) ~f:(function
| Named_local ->
| Var Named_local ->
begin match Jbuild.Bindings.find deps_written_by_user key with
| None ->
Exn.code_error "Local named variable not present in named deps"
@ -756,11 +754,11 @@ module Action = struct
]
| Some x -> Value.L.paths x
end
| Deps ->
| Var Deps ->
deps_written_by_user
|> Jbuild.Bindings.to_list
|> Value.L.paths
| First_dep ->
| Var First_dep ->
begin match deps_written_by_user with
| Named _ :: _ ->
(* This case is not possible: ${<} only exist in jbuild

11
test/blackbox-tests/test-cases/shadow-bindings/run.t
View File

@ -1,14 +1,5 @@
Bindings introduced by user dependencies should shadow existing bindings
$ dune runtest
Internal error, please report upstream including the contents of _build/log.
Description:
("Local named variable not present in named deps"
(pform "\%{read:y}")
(deps_written_by_user ((:read (In_build_dir default/x)))))
Backtrace:
Raised at file "src/dep_path.ml" (inlined), line 45, characters 24-55
Called from file "src/build_system.ml", line 89, characters 6-48
Called from file "src/fiber/fiber.ml", line 243, characters 6-18
xb
foo
[1]