From b8ad65ccd2c9f95a920aa31450725bd3c1244660 Mon Sep 17 00:00:00 2001 From: Jeremie Dimino Date: Tue, 15 Jan 2019 13:39:23 +0000 Subject: [PATCH 1/3] Add {Blang,String_with_vars}.fold_vars Signed-off-by: Jeremie Dimino --- src/blang.ml | 14 ++++++++++++++ src/blang.mli | 2 ++ src/string_with_vars.ml | 9 +++++++++ src/string_with_vars.mli | 1 + 4 files changed, 26 insertions(+) diff --git a/src/blang.ml b/src/blang.ml index 93f80782ffa..715f55939ae 100644 --- a/src/blang.ml +++ b/src/blang.ml @@ -102,3 +102,17 @@ let decode = and+ decode = decode in decode + +let rec fold_vars t ~init ~f = + match t with + | Const _ -> init + | Expr sw -> String_with_vars.fold_vars sw ~init ~f + | And l | Or l -> fold_vars_list l ~init ~f + | Compare (_, x, y) -> + String_with_vars.fold_vars y ~f + ~init:(String_with_vars.fold_vars x ~f ~init) + +and fold_vars_list ts ~init ~f = + match ts with + | [] -> init + | t :: ts -> fold_vars_list ts ~f ~init:(fold_vars t ~init ~f) diff --git a/src/blang.mli b/src/blang.mli index 4c2ee29c0f4..480e8a71bad 100644 --- a/src/blang.mli +++ b/src/blang.mli @@ -19,6 +19,8 @@ type t = val true_ : t +val fold_vars : t -> init:'a -> f:(String_with_vars.Var.t -> 'a -> 'a) -> 'a + val eval : t -> dir:Path.t diff --git a/src/string_with_vars.ml b/src/string_with_vars.ml index 5f9d482fd66..2e7f3a604fb 100644 --- a/src/string_with_vars.ml +++ b/src/string_with_vars.ml @@ -253,6 +253,15 @@ let known_prefix = | Var v :: _ -> Partial (String.concat ~sep:"" (List.rev acc), v) in fun t -> go t.template.parts [] +let fold_vars = + let rec loop parts acc f = + match parts with + | [] -> acc + | Text _ :: parts -> loop parts acc f + | Var v :: parts -> loop parts (f v acc) f + in + fun t ~init ~f -> + loop t.template.parts init f type 'a expander = Var.t -> Syntax.Version.t -> 'a diff --git a/src/string_with_vars.mli b/src/string_with_vars.mli index 182c6c0377a..c6954defe20 100644 --- a/src/string_with_vars.mli +++ b/src/string_with_vars.mli @@ -93,6 +93,7 @@ val known_prefix : t -> known_prefix val is_suffix : t -> suffix:string -> yes_no_unknown val is_prefix : t -> prefix:string -> yes_no_unknown +val fold_vars : t -> init:'a -> f:(Var.t -> 'a -> 'a) -> 'a type 'a expander = Var.t -> Syntax.Version.t -> 'a From 61fbe771a85b47d861ea9c3c732eb86fa8f6ce85 Mon Sep 17 00:00:00 2001 From: Jeremie Dimino Date: Tue, 15 Jan 2019 14:03:58 +0000 Subject: [PATCH 2/3] Add the os_type variable Signed-off-by: Jeremie Dimino --- CHANGES.md | 3 +++ doc/dune-files.rst | 2 ++ src/pform.ml | 2 ++ 3 files changed, 7 insertions(+) diff --git a/CHANGES.md b/CHANGES.md index b2aa51e989e..1d2763e7224 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -65,6 +65,9 @@ unreleased - Make `dune subst` add a `(version ...)` field to the `dune-project` file (#2148, @diml) +- Add the `%{os_type}` variable, which is a short-hand for + `%{ocaml-config:os_type}` (#1764, @diml) + 1.9.3 (06/05/2019) ------------------ diff --git a/doc/dune-files.rst b/doc/dune-files.rst index 21ec92c9e8d..45248a53c72 100644 --- a/doc/dune-files.rst +++ b/doc/dune-files.rst @@ -1087,6 +1087,8 @@ Dune supports the following variables: - ``profile`` the profile selected via ``--profile`` - ``context_name`` the name of the context (``default`` or defined in the workspace file) +- ``os_type`` is the type of the OS the build is targetting. This is + the same as ``ocaml-config:os_type`` In addition, ``(action ...)`` fields support the following special variables: diff --git a/src/pform.ml b/src/pform.ml index 282723f9cb8..089c12dcff0 100644 --- a/src/pform.ml +++ b/src/pform.ml @@ -208,6 +208,8 @@ module Map = struct ; "workspace_root" , values [Value.Dir context.build_dir] ; "context_name" , string (Context.name context) ; "ROOT" , renamed_in ~version:(1, 0) ~new_name:"workspace_root" + ; "os_type" , since ~version:(1, 10) + (Var.Values [String context.os_type]) ] in { vars = From 1e59fa4b2d15c91cbc3bf11bc4d59ce862a09dc2 Mon Sep 17 00:00:00 2001 From: Jeremie Dimino Date: Tue, 15 Jan 2019 14:41:24 +0000 Subject: [PATCH 3/3] Allow the enabled_if field in library stanzas Only allow the %{os_type} variable, in order to not make the library database too dynamic. Signed-off-by: Jeremie Dimino --- CHANGES.md | 3 ++ doc/dune-files.rst | 8 +++++ src/context.ml | 1 + src/dune_file.ml | 33 +++++++++++++------ src/dune_file.mli | 1 + src/lib.ml | 18 ++++++---- src/lib_config.ml | 1 + src/lib_info.ml | 30 ++++++++++++++--- src/lib_info.mli | 9 ++++- src/scope.ml | 7 ++-- .../blackbox-tests/test-cases/enabled_if/dune | 19 +++++++++++ .../test-cases/enabled_if/dune-project | 2 +- .../test-cases/enabled_if/run.t | 13 ++++++++ 13 files changed, 120 insertions(+), 25 deletions(-) diff --git a/CHANGES.md b/CHANGES.md index 1d2763e7224..93d77f848b9 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -68,6 +68,9 @@ unreleased - Add the `%{os_type}` variable, which is a short-hand for `%{ocaml-config:os_type}` (#1764, @diml) +- Allow `enabled_if` fields in `library` stanzas, restricted to the + `%{os_type}` variable (#1764, @diml) + 1.9.3 (06/05/2019) ------------------ diff --git a/doc/dune-files.rst b/doc/dune-files.rst index 45248a53c72..42282082ad7 100644 --- a/doc/dune-files.rst +++ b/doc/dune-files.rst @@ -209,6 +209,14 @@ to use the :ref:`include_subdirs` stanza. we were waiting for proper support for virtual libraries. Do not use in new code, it will be deleted in dune 2.0 +- ``(enabled_if )`` allows to conditionally disable + a library. A disabled library cannot be built and will not be + installed. The condition is specified using the blang_, and the + field allows for the ``%{os_type}`` variable, which is expanded to + the type of OS being targeted by the current build. Its value is + the same as the value of the ``os_type`` parameter in the output of + ``ocamlc -config`` + Note that when binding C libraries, dune doesn't provide special support for tools such as ``pkg-config``, however it integrates easily with configurator_ by using ``(c_flags (:include ...))`` and ``(c_library_flags (:include ...))``. diff --git a/src/context.ml b/src/context.ml index fe293f2542e..31ebfdc1009 100644 --- a/src/context.ml +++ b/src/context.ml @@ -702,4 +702,5 @@ let lib_config t = has_native = has_native t ; ext_obj = t.ext_obj ; ext_lib = t.ext_lib + ; os_type = t.os_type } diff --git a/src/dune_file.ml b/src/dune_file.ml index 765da028f0a..e6f5dbb290f 100644 --- a/src/dune_file.ml +++ b/src/dune_file.ml @@ -361,10 +361,13 @@ module Preprocess = struct ])) end - -let enabled_if = - field "enabled_if" ~default:Blang.true_ - (Syntax.since Stanza.syntax (1, 4) >>> Blang.decode) +let enabled_if ~since = + let decode = + match since with + | None -> Blang.decode + | Some since -> Syntax.since Stanza.syntax since >>> Blang.decode + in + field "enabled_if" ~default:Blang.true_ decode module Per_module = struct include Per_item.Make(Module.Name) @@ -896,6 +899,7 @@ module Library = struct ; private_modules : Ordered_set_lang.t option ; stdlib : Stdlib.t option ; special_builtin_support : Special_builtin_support.t option + ; enabled_if : Blang.t } let decode = @@ -956,7 +960,7 @@ module Library = struct field_o "special_builtin_support" (Syntax.since Stanza.syntax (1, 10) >>> Special_builtin_support.decode) - in + and+ enabled_if = enabled_if ~since:(Some (1, 10)) in let wrapped = Wrapped.make ~wrapped ~implements in let name = let open Syntax.Version.Infix in @@ -1021,6 +1025,14 @@ module Library = struct "A library cannot use (self_build_stubs_archive ...) \ and (%s ...) simultaneously." name in + Blang.fold_vars enabled_if ~init:() ~f:(fun var () -> + match String_with_vars.Var.name var, + String_with_vars.Var.payload var with + | "os_type", None -> () + | _ -> + Errors.fail (String_with_vars.Var.loc var) + "Only the 'os_type' variable is allowed in the 'enabled_if' \ + field of libraries."); { name ; public ; synopsis @@ -1050,6 +1062,7 @@ module Library = struct ; private_modules ; stdlib ; special_builtin_support + ; enabled_if }) let has_stubs t = @@ -1659,7 +1672,7 @@ module Rule = struct | false, Some mode -> Ok mode | true, None -> Ok Fallback | false, None -> Ok Standard) - and+ enabled_if = enabled_if + and+ enabled_if = enabled_if ~since:(Some (1, 4)) in { targets ; deps @@ -1732,7 +1745,7 @@ module Rule = struct record (let+ modules = field "modules" (list string) and+ mode = Mode.field - and+ enabled_if = enabled_if + and+ enabled_if = enabled_if ~since:(Some (1, 4)) in { modules; mode; enabled_if })) ~else_:( @@ -1818,7 +1831,7 @@ module Menhir = struct and+ mode = Rule.Mode.field and+ infer = field_o_b "infer" ~check:(Syntax.since syntax (2, 0)) and+ menhir_syntax = Syntax.get_exn syntax - and+ enabled_if = enabled_if + and+ enabled_if = enabled_if ~since:(Some (1, 4)) and+ loc = loc in let infer = @@ -1911,7 +1924,7 @@ module Coq = struct and+ modules = modules_field "modules" and+ libraries = field "libraries" (list (located Lib_name.decode)) ~default:[] - and+ enabled_if = enabled_if + and+ enabled_if = enabled_if ~since:None in let name = let (loc, res) = name in @@ -2016,7 +2029,7 @@ module Tests = struct ~default:Executables.Link_mode.Set.default and+ deps = field "deps" (Bindings.decode Dep_conf.decode) ~default:Bindings.empty - and+ enabled_if = enabled_if + and+ enabled_if = enabled_if ~since:(Some (1, 4)) and+ action = field_o "action" diff --git a/src/dune_file.mli b/src/dune_file.mli index 9aa1b420798..9e2606eca67 100644 --- a/src/dune_file.mli +++ b/src/dune_file.mli @@ -235,6 +235,7 @@ module Library : sig ; private_modules : Ordered_set_lang.t option ; stdlib : Stdlib.t option ; special_builtin_support : Special_builtin_support.t option + ; enabled_if : Blang.t } val has_stubs : t -> bool diff --git a/src/lib.ml b/src/lib.ml index a227d146783..7c564c1704b 100644 --- a/src/lib.ml +++ b/src/lib.ml @@ -891,12 +891,16 @@ let rec instantiate db name (info : Lib_info.t) ~stack ~hidden = let res = let hidden = match hidden with - | None -> - Option.some_if - (info.optional && - not (Result.is_ok t.requires && Result.is_ok t.ppx_runtime_deps)) - "optional with unavailable dependencies" | Some _ -> hidden + | None -> + match info.enabled with + | Normal -> None + | Optional -> + Option.some_if + (not (Result.is_ok t.requires && Result.is_ok t.ppx_runtime_deps)) + "optional with unavailable dependencies" + | Disabled_because_of_enabled_if -> + Some "unsatisfied 'enabled_if'" in match hidden with | None -> St_found t @@ -1265,7 +1269,9 @@ module Compile = struct make_lib_deps_info ~user_written_deps:(Lib_info.user_written_deps t.info) ~pps:t.info.pps - ~kind:(Lib_deps_info.Kind.of_optional t.info.optional) + ~kind:(match t.info.enabled with + | Normal -> Required + | _ -> Optional) in let requires_link = lazy ( t.requires >>= closure_with_overlap_checks diff --git a/src/lib_config.ml b/src/lib_config.ml index 82c3f9c1e55..fc75bfa9e29 100644 --- a/src/lib_config.ml +++ b/src/lib_config.ml @@ -4,4 +4,5 @@ type t = { has_native : bool ; ext_lib : string ; ext_obj : string + ; os_type : string } diff --git a/src/lib_info.ml b/src/lib_info.ml index 318c17160f3..8f4eadd7027 100644 --- a/src/lib_info.ml +++ b/src/lib_info.ml @@ -47,6 +47,13 @@ module Source = struct | External of 'a end +module Enabled_status = struct + type t = + | Normal + | Optional + | Disabled_because_of_enabled_if +end + type t = { loc : Loc.t ; name : Lib_name.t @@ -66,7 +73,7 @@ type t = ; requires : Deps.t ; ppx_runtime_deps : (Loc.t * Lib_name.t) list ; pps : (Loc.t * Lib_name.t) list - ; optional : bool + ; enabled : Enabled_status.t ; virtual_deps : (Loc.t * Lib_name.t) list ; dune_version : Syntax.Version.t option ; sub_systems : Sub_system_info.t Sub_system_name.Map.t @@ -86,7 +93,7 @@ let user_written_deps t = ~f:(fun acc s -> Dune_file.Lib_dep.Direct s :: acc) let of_library_stanza ~dir - ~lib_config:{ Lib_config.has_native; ext_lib; ext_obj} + ~lib_config:{ Lib_config.has_native; ext_lib; ext_obj; os_type} (conf : Dune_file.Library.t) = let (_loc, lib_name) = conf.name in let obj_dir = @@ -154,6 +161,21 @@ let of_library_stanza ~dir let main_module_name = Dune_file.Library.main_module_name conf in let name = Dune_file.Library.best_name conf in let modes = Dune_file.Mode_conf.Set.eval ~has_native conf.modes in + let enabled = + let enabled_if_result = + Blang.eval conf.enabled_if ~dir ~f:(fun v _ver -> + match String_with_vars.Var.name v, + String_with_vars.Var.payload v with + | "os_type", None -> Some [String os_type] + | _ -> None) + in + if not enabled_if_result then + Enabled_status.Disabled_because_of_enabled_if + else if conf.optional then + Optional + else + Normal + in { loc = conf.buildable.loc ; name ; kind = conf.kind @@ -164,7 +186,7 @@ let of_library_stanza ~dir ; synopsis = conf.synopsis ; archives ; plugins - ; optional = conf.optional + ; enabled ; foreign_objects ; foreign_archives ; jsoo_runtime @@ -219,7 +241,7 @@ let of_dune_lib dp = ; jsoo_runtime = Lib.jsoo_runtime dp ; jsoo_archive = None ; pps = [] - ; optional = false + ; enabled = Normal ; virtual_deps = [] ; dune_version = None ; sub_systems = Lib.sub_systems dp diff --git a/src/lib_info.mli b/src/lib_info.mli index 657ff05785f..81ae56a4be7 100644 --- a/src/lib_info.mli +++ b/src/lib_info.mli @@ -28,6 +28,13 @@ module Source : sig | External of 'a end +module Enabled_status : sig + type t = + | Normal + | Optional + | Disabled_because_of_enabled_if +end + type t = private { loc : Loc.t ; name : Lib_name.t @@ -47,7 +54,7 @@ type t = private ; requires : Deps.t ; ppx_runtime_deps : (Loc.t * Lib_name.t) list ; pps : (Loc.t * Lib_name.t) list - ; optional : bool + ; enabled : Enabled_status.t ; virtual_deps : (Loc.t * Lib_name.t) list ; dune_version : Syntax.Version.t option ; sub_systems : Sub_system_info.t Sub_system_name.Map.t diff --git a/src/scope.ml b/src/scope.ml index 4ed4e6e8e6a..8d6fe7be2c3 100644 --- a/src/scope.ml +++ b/src/scope.ml @@ -130,13 +130,14 @@ module DB = struct ~f:(fun _name project libs -> let project = Option.value_exn project in let libs = Option.value libs ~default:[] in - let db = Lib.DB.create_from_library_stanzas libs - ~parent:public_libs ~lib_config in + let db = Lib.DB.create_from_library_stanzas libs ~parent:public_libs + ~lib_config in let root = Path.append_source build_context_dir (Dune_project.root project) in Some { project; db; root }) - let create ~projects ~context ~installed_libs ~lib_config internal_libs = + let create ~projects ~context ~installed_libs ~lib_config + internal_libs = let t = Fdecl.create () in let public_libs = public_libs t ~installed_libs internal_libs in let by_name = diff --git a/test/blackbox-tests/test-cases/enabled_if/dune b/test/blackbox-tests/test-cases/enabled_if/dune index 7102b6c2eec..70e0d79a54a 100644 --- a/test/blackbox-tests/test-cases/enabled_if/dune +++ b/test/blackbox-tests/test-cases/enabled_if/dune @@ -21,3 +21,22 @@ (echo "Building file b") (with-stdout-to b (progn)))) (enabled_if true)) + +(library + (name foo) + (modules) + (enabled_if false)) + +(library + (name bar) + (modules) + (libraries foo)) + +(library + (name baz) + (modules) + (libraries bar)) + +(rule (with-stdout-to main.ml (echo ""))) + +(executable (name main) (libraries baz)) diff --git a/test/blackbox-tests/test-cases/enabled_if/dune-project b/test/blackbox-tests/test-cases/enabled_if/dune-project index f9337290c30..42c0c167431 100644 --- a/test/blackbox-tests/test-cases/enabled_if/dune-project +++ b/test/blackbox-tests/test-cases/enabled_if/dune-project @@ -1 +1 @@ -(lang dune 1.4) +(lang dune 1.10) diff --git a/test/blackbox-tests/test-cases/enabled_if/run.t b/test/blackbox-tests/test-cases/enabled_if/run.t index 71475e1fdb0..142964fd178 100644 --- a/test/blackbox-tests/test-cases/enabled_if/run.t +++ b/test/blackbox-tests/test-cases/enabled_if/run.t @@ -16,3 +16,16 @@ This rule is disabled, trying to build a should fail: This one is enabled: $ dune build b Building file b + +Test the enabled_if field for libraries: + + $ dune build main.exe + File "dune", line 33, characters 12-15: + 33 | (libraries foo)) + ^^^ + Error: Library "foo" in _build/default is hidden (unsatisfied 'enabled_if'). + Hint: try: dune external-lib-deps --missing main.exe + [1] + +Ideally, the above message should mention the dependency path between +the requested target and the unsatisfied `enabled_if`.