From c0eafdb59b81255d6d0837ff19e5d47f367a8dfd Mon Sep 17 00:00:00 2001 From: Greta Yorsh Date: Thu, 20 Dec 2018 13:29:47 +0000 Subject: [PATCH 01/13] Add c_flags to env profile settings Signed-off-by: Greta Yorsh --- src/dune_env.ml | 6 +++++ src/dune_env.mli | 2 ++ src/env_node.ml | 54 +++++++++++++++++++++++++++++++++++++++++++ src/env_node.mli | 6 +++++ src/lib_rules.ml | 20 ++++++++-------- src/super_context.ml | 39 +++++++++++++++++++++++++++++++ src/super_context.mli | 14 +++++++++++ 7 files changed, 131 insertions(+), 10 deletions(-) diff --git a/src/dune_env.ml b/src/dune_env.ml index df99b38734f..1a028c40333 100644 --- a/src/dune_env.ml +++ b/src/dune_env.ml @@ -11,6 +11,8 @@ module Stanza = struct { flags : Ordered_set_lang.Unexpanded.t ; ocamlc_flags : Ordered_set_lang.Unexpanded.t ; ocamlopt_flags : Ordered_set_lang.Unexpanded.t + ; c_flags : Ordered_set_lang.Unexpanded.t + ; cxx_flags : Ordered_set_lang.Unexpanded.t ; env_vars : Env.t ; binaries : File_bindings.Unexpanded.t } @@ -39,6 +41,8 @@ module Stanza = struct let%map flags = field_oslu "flags" and ocamlc_flags = field_oslu "ocamlc_flags" and ocamlopt_flags = field_oslu "ocamlopt_flags" + and c_flags = field_oslu "c_flags" + and cxx_flags = field_oslu "cxx_flags" and env_vars = env_vars_field and binaries = field ~default:File_bindings.empty "binaries" (Syntax.since Stanza.syntax (1, 6) @@ -47,6 +51,8 @@ module Stanza = struct { flags ; ocamlc_flags ; ocamlopt_flags + ; c_flags + ; cxx_flags ; env_vars ; binaries } diff --git a/src/dune_env.mli b/src/dune_env.mli index cd1f0d2de27..f13ca5f3d33 100644 --- a/src/dune_env.mli +++ b/src/dune_env.mli @@ -7,6 +7,8 @@ module Stanza : sig { flags : Ordered_set_lang.Unexpanded.t ; ocamlc_flags : Ordered_set_lang.Unexpanded.t ; ocamlopt_flags : Ordered_set_lang.Unexpanded.t + ; c_flags : Ordered_set_lang.Unexpanded.t + ; cxx_flags : Ordered_set_lang.Unexpanded.t ; env_vars : Env.t ; binaries : File_bindings.Unexpanded.t } diff --git a/src/env_node.ml b/src/env_node.ml index bbfaa69c18e..dbda028aa28 100644 --- a/src/env_node.ml +++ b/src/env_node.ml @@ -7,6 +7,8 @@ type t = ; config : Dune_env.Stanza.t option ; mutable local_binaries : string File_bindings.t option ; mutable ocaml_flags : Ocaml_flags.t option + ; mutable c_flags : (unit, string list) Build.t option + ; mutable cxx_flags : (unit, string list) Build.t option ; mutable external_ : Env.t option ; mutable artifacts : Artifacts.t option } @@ -19,6 +21,8 @@ let make ~dir ~inherit_from ~scope ~config ~env = ; scope ; config ; ocaml_flags = None + ; c_flags = None + ; cxx_flags = None ; external_ = env ; artifacts = None ; local_binaries = None @@ -109,3 +113,53 @@ let rec ocaml_flags t ~profile ~expander = in t.ocaml_flags <- Some flags; flags + + + +let rec c_flags t ~profile ~expander = + match t.c_flags with + | Some x -> x + | None -> + let default = + match t.inherit_from with + | None -> Build.return ([]) + | Some (lazy t) -> c_flags t ~profile ~expander + in + let flags = + match find_config t ~profile with + | None -> default + | Some cfg -> + let expander = Expander.set_dir expander ~dir:t.dir in + let eval = Expander.expand_and_eval_set expander in + let f = cfg.c_flags in + if Ordered_set_lang.Unexpanded.has_special_forms f then + eval f ~standard:default + else + eval f ~standard:(Build.return []) + in + t.c_flags <- Some flags; + flags + +let rec cxx_flags t ~profile ~expander = + match t.cxx_flags with + | Some x -> x + | None -> + let default = + match t.inherit_from with + | None -> Build.return ([]) + | Some (lazy t) -> cxx_flags t ~profile ~expander + in + let flags = + match find_config t ~profile with + | None -> default + | Some cfg -> + let expander = Expander.set_dir expander ~dir:t.dir in + let eval = Expander.expand_and_eval_set expander in + let f = cfg.cxx_flags in + if Ordered_set_lang.Unexpanded.has_special_forms f then + eval f ~standard:default + else + eval f ~standard:(Build.return []) + in + t.cxx_flags <- Some flags; + flags diff --git a/src/env_node.mli b/src/env_node.mli index 505fe32a05d..1c025c45f2f 100644 --- a/src/env_node.mli +++ b/src/env_node.mli @@ -19,6 +19,12 @@ val external_ : t -> profile:string -> default:Env.t -> Env.t val ocaml_flags : t -> profile:string -> expander:Expander.t -> Ocaml_flags.t +val c_flags : t -> profile:string -> expander:Expander.t + -> (unit, string list) Build.t + +val cxx_flags : t -> profile:string -> expander:Expander.t + -> (unit, string list) Build.t + val local_binaries : t -> profile:string diff --git a/src/lib_rules.ml b/src/lib_rules.ml index 8241104aed6..3bbff14513e 100644 --- a/src/lib_rules.ml +++ b/src/lib_rules.ml @@ -162,10 +162,10 @@ module Gen (P : Install_rules.Params) = struct let cctx = Compilation_context.for_wrapped_compat cctx wrapped_compat in Module_compilation.build_modules cctx ~js_of_ocaml ~dynlink ~dep_graphs - let build_c_file (lib : Library.t) ~expander ~dir ~includes (loc, src, dst) = + let build_c_file (lib : Library.t) ~dir ~includes (loc, src, dst) = + let c_flags = SC.c_flags sctx ~dir ~lib (Context.cc_g ctx) in SC.add_rule sctx ~loc ~dir - (Expander.expand_and_eval_set expander lib.c_flags - ~standard:(Build.return (Context.cc_g ctx)) + (c_flags >>> Build.run (* We have to execute the rule in the library directory as @@ -180,7 +180,7 @@ module Gen (P : Install_rules.Params) = struct ]); dst - let build_cxx_file (lib : Library.t) ~expander ~dir ~includes (loc, src, dst) = + let build_cxx_file (lib : Library.t) ~dir ~includes (loc, src, dst) = let open Arg_spec in let output_param = if ctx.ccomp_type = "msvc" then @@ -188,9 +188,9 @@ module Gen (P : Install_rules.Params) = struct else [A "-o"; Target dst] in + let cxx_flags = SC.cxx_flags_gather sctx ~dir ~lib (Context.cc_g ctx) in SC.add_rule sctx ~loc ~dir - (Expander.expand_and_eval_set expander lib.cxx_flags - ~standard:(Build.return (Context.cc_g ctx)) + (cxx_flags >>> Build.run (* We have to execute the rule in the library directory as @@ -253,7 +253,7 @@ module Gen (P : Install_rules.Params) = struct ocamlmklib ~sandbox:true ~custom:false ~targets:[dynamic] end - let build_o_files lib ~dir ~expander ~requires ~dir_contents = + let build_o_files lib ~dir ~requires ~dir_contents = let all_dirs = Dir_contents.dirs dir_contents in let h_files = List.fold_left all_dirs ~init:[] ~f:(fun acc dc -> @@ -288,15 +288,15 @@ module Gen (P : Install_rules.Params) = struct ] in List.map lib.c_names ~f:(fun name -> - build_c_file lib ~expander ~dir ~includes (resolve_name name ~ext:".c") + build_c_file lib ~dir ~includes (resolve_name name ~ext:".c") ) @ List.map lib.cxx_names ~f:(fun name -> - build_cxx_file lib ~expander ~dir ~includes (resolve_name name ~ext:".cpp") + build_cxx_file lib ~dir ~includes (resolve_name name ~ext:".cpp") ) let build_stubs lib ~dir ~expander ~requires ~dir_contents ~vlib_stubs_o_files = let lib_o_files = if Library.has_stubs lib then - build_o_files lib ~dir ~expander ~requires ~dir_contents + build_o_files lib ~dir ~requires ~dir_contents else [] in diff --git a/src/super_context.ml b/src/super_context.ml index 94538dac6e5..75e7d1f122c 100644 --- a/src/super_context.ml +++ b/src/super_context.ml @@ -71,6 +71,8 @@ module External_env = Env module Env : sig val ocaml_flags : t -> dir:Path.t -> Ocaml_flags.t + val c_flags : t -> dir:Path.t -> (unit, string list) Build.t + val cxx_flags : t -> dir:Path.t -> (unit, string list) Build.t val external_ : t -> dir:Path.t -> External_env.t val artifacts_host : t -> dir:Path.t -> Artifacts.t val expander : t -> dir:Path.t -> Expander.t @@ -151,6 +153,14 @@ end = struct let ocaml_flags t ~dir = Env_node.ocaml_flags (get t ~dir) ~profile:(profile t) ~expander:(expander t ~dir) + + let c_flags t ~dir = + Env_node.c_flags (get t ~dir) + ~profile:(profile t) ~expander:(expander t ~dir) + + let cxx_flags t ~dir = + Env_node.cxx_flags (get t ~dir) + ~profile:(profile t) ~expander:(expander t ~dir) end let expander = Env.expander @@ -237,6 +247,35 @@ let ocaml_flags t ~dir (x : Buildable.t) = ~default:(Env.ocaml_flags t ~dir) ~eval:(Expander.expand_and_eval_set expander) +let c_flags t ~dir ~(lib : Library.t) ccg = + let expander = Env.expander t ~dir in + let eval = Expander.expand_and_eval_set expander in + let flags = lib.c_flags in + let default = Env.c_flags t ~dir in + Build.memoize "c flags" + begin + if Ordered_set_lang.Unexpanded.has_special_forms flags then + let c = eval flags ~standard:default in + let open Build.O in (c >>^ fun l -> l @ ccg) + else + eval flags ~standard:(Build.return ccg) + end + + +let cxx_flags_gather t ~dir ~(lib : Library.t) ccg = + let expander = Env.expander t ~dir in + let eval = Expander.expand_and_eval_set expander in + let flags = lib.cxx_flags in + let default = Env.cxx_flags t ~dir in + Build.memoize "c flags" + begin + if Ordered_set_lang.Unexpanded.has_special_forms flags then + let c = eval flags ~standard:default in + let open Build.O in (c >>^ fun l -> l @ ccg) + else + eval flags ~standard:(Build.return ccg) + end + let local_binaries t ~dir = Env.local_binaries t ~dir let dump_env t ~dir = diff --git a/src/super_context.mli b/src/super_context.mli index 7d823fe00e0..280c7b3e0bc 100644 --- a/src/super_context.mli +++ b/src/super_context.mli @@ -53,6 +53,20 @@ val ocaml_flags -> Buildable.t -> Ocaml_flags.t +val c_flags + : t + -> dir:Path.t + -> lib:Library.t + -> string list + -> (unit, string list) Build.t + +val cxx_flags_gather + : t + -> dir:Path.t + -> lib:Library.t + -> string list + -> (unit, string list) Build.t + (** Binaries that are symlinked in the associated .bin directory of [dir]. This associated directory is [Path.relative dir ".bin"] *) val local_binaries : t -> dir:Path.t -> string File_bindings.t From 23f2ac7d5f9a0a50ecdca9d85cd77e1e32970725 Mon Sep 17 00:00:00 2001 From: Greta Yorsh Date: Thu, 20 Dec 2018 14:31:49 +0000 Subject: [PATCH 02/13] update documentation of env Signed-off-by: Greta Yorsh --- doc/dune-files.rst | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/doc/dune-files.rst b/doc/dune-files.rst index d60b6d05cf5..3467c97be19 100644 --- a/doc/dune-files.rst +++ b/doc/dune-files.rst @@ -794,6 +794,10 @@ Fields supported in ```` are: - any OCaml flags field, see `OCaml flags`_ for more details. +- ``(c_flags )`` and ``(cxx_flags )`` + to specify compilation flags for C and C++ stubs, respectively. + See `library`_ for more details. + - ``(env-vars ( ) .. ( ))``. This will add the corresponding variables to the environment in which the build commands are executed, and under which ``dune exec`` runs. At the moment, this mechanism is From 05a046fac5cb3429b18e27157bd00e5a3bb125d7 Mon Sep 17 00:00:00 2001 From: Greta Yorsh Date: Thu, 20 Dec 2018 16:23:28 +0000 Subject: [PATCH 03/13] Add tests for c_flags in env Signed-off-by: Greta Yorsh --- src/super_context.ml | 15 ++++++++++- test/blackbox-tests/dune.inc | 10 +++++++ .../test-cases/env-cflags/bin/dune | 4 +++ .../blackbox-tests/test-cases/env-cflags/dune | 4 +++ .../test-cases/env-cflags/dune-project | 1 + .../test-cases/env-cflags/run.t | 26 +++++++++++++++++++ .../test-cases/env-cflags/src/dune | 5 ++++ test/blackbox-tests/test-cases/env/run.t | 14 ++++++++++ .../test-cases/workspaces/run.t | 2 ++ 9 files changed, 80 insertions(+), 1 deletion(-) create mode 100644 test/blackbox-tests/test-cases/env-cflags/bin/dune create mode 100644 test/blackbox-tests/test-cases/env-cflags/dune create mode 100644 test/blackbox-tests/test-cases/env-cflags/dune-project create mode 100644 test/blackbox-tests/test-cases/env-cflags/run.t create mode 100644 test/blackbox-tests/test-cases/env-cflags/src/dune diff --git a/src/super_context.ml b/src/super_context.ml index 75e7d1f122c..ca5dea467f6 100644 --- a/src/super_context.ml +++ b/src/super_context.ml @@ -279,7 +279,20 @@ let cxx_flags_gather t ~dir ~(lib : Library.t) ccg = let local_binaries t ~dir = Env.local_binaries t ~dir let dump_env t ~dir = - Ocaml_flags.dump (Env.ocaml_flags t ~dir) + let open Build.O in + let o_dump = Ocaml_flags.dump (Env.ocaml_flags t ~dir) in + let c_flags = Env.c_flags t ~dir in + let cxx_flags = Env.cxx_flags t ~dir in + let c_dump = + Build.fanout c_flags cxx_flags + >>^ fun (c_flags, cxx_flags) -> + List.map ~f:Dune_lang.Encoder.(pair string (list string)) + [ "c_flags", c_flags + ; "cxx_flags", cxx_flags + ] + in (* combine o_dump and c_dump *) + (o_dump &&& c_dump) >>^ (fun (x, y) -> x @ y) + let resolve_program t ~dir ?hint ~loc bin = let artifacts = Env.artifacts_host t ~dir in diff --git a/test/blackbox-tests/dune.inc b/test/blackbox-tests/dune.inc index 6d55fe6e50a..ba0b6864cbb 100644 --- a/test/blackbox-tests/dune.inc +++ b/test/blackbox-tests/dune.inc @@ -255,6 +255,14 @@ test-cases/env-bins (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))) +(alias + (name env-cflags) + (deps (package dune) (source_tree test-cases/env-cflags)) + (action + (chdir + test-cases/env-cflags + (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))) + (alias (name env-dune-file) (deps (package dune) (source_tree test-cases/env-dune-file)) @@ -1267,6 +1275,7 @@ (alias env) (alias env-and-flags-include) (alias env-bins) + (alias env-cflags) (alias env-dune-file) (alias env-tracking) (alias env-var-expansion) @@ -1420,6 +1429,7 @@ (alias env) (alias env-and-flags-include) (alias env-bins) + (alias env-cflags) (alias env-dune-file) (alias env-tracking) (alias env-var-expansion) diff --git a/test/blackbox-tests/test-cases/env-cflags/bin/dune b/test/blackbox-tests/test-cases/env-cflags/bin/dune new file mode 100644 index 00000000000..e347ed876ee --- /dev/null +++ b/test/blackbox-tests/test-cases/env-cflags/bin/dune @@ -0,0 +1,4 @@ +(env + (default + (c_flags "in bin") + (cxx_flags "in bin"))) diff --git a/test/blackbox-tests/test-cases/env-cflags/dune b/test/blackbox-tests/test-cases/env-cflags/dune new file mode 100644 index 00000000000..26d4672910d --- /dev/null +++ b/test/blackbox-tests/test-cases/env-cflags/dune @@ -0,0 +1,4 @@ +(env + (default + (c_flags :standard ":standard + in .") + (cxx_flags :standard ":standard + in ."))) diff --git a/test/blackbox-tests/test-cases/env-cflags/dune-project b/test/blackbox-tests/test-cases/env-cflags/dune-project new file mode 100644 index 00000000000..de4fc209200 --- /dev/null +++ b/test/blackbox-tests/test-cases/env-cflags/dune-project @@ -0,0 +1 @@ +(lang dune 1.0) diff --git a/test/blackbox-tests/test-cases/env-cflags/run.t b/test/blackbox-tests/test-cases/env-cflags/run.t new file mode 100644 index 00000000000..8783c53d9cf --- /dev/null +++ b/test/blackbox-tests/test-cases/env-cflags/run.t @@ -0,0 +1,26 @@ + $ dune printenv --profile default . + ( + (flags (-w -40)) + (ocamlc_flags (-g)) + (ocamlopt_flags (-g)) + (c_flags (":standard + in .")) + (cxx_flags (":standard + in .")) + ) + + $ dune printenv --profile default src + ( + (flags (-w -40)) + (ocamlc_flags (-g)) + (ocamlopt_flags (-g)) + (c_flags (":standard + in ." ":standard + in src")) + (cxx_flags (":standard + in ." ":standard + in src")) + ) + + $ dune printenv --profile default bin + ( + (flags (-w -40)) + (ocamlc_flags (-g)) + (ocamlopt_flags (-g)) + (c_flags ("in bin")) + (cxx_flags ("in bin")) + ) diff --git a/test/blackbox-tests/test-cases/env-cflags/src/dune b/test/blackbox-tests/test-cases/env-cflags/src/dune new file mode 100644 index 00000000000..8a82a489c2c --- /dev/null +++ b/test/blackbox-tests/test-cases/env-cflags/src/dune @@ -0,0 +1,5 @@ +(env + (default + (c_flags :standard ":standard + in src") + (cxx_flags :standard ":standard + in src") + )) diff --git a/test/blackbox-tests/test-cases/env/run.t b/test/blackbox-tests/test-cases/env/run.t index e255c02bf2b..0b911c0494e 100644 --- a/test/blackbox-tests/test-cases/env/run.t +++ b/test/blackbox-tests/test-cases/env/run.t @@ -3,24 +3,32 @@ (flags (-w -40 ":standard + in .")) (ocamlc_flags (-g)) (ocamlopt_flags (-g)) + (c_flags ()) + (cxx_flags ()) ) $ dune printenv --profile default src ( (flags (-w -40 ":standard + in ." ":standard + in src")) (ocamlc_flags (-g)) (ocamlopt_flags (-g)) + (c_flags ()) + (cxx_flags ()) ) $ dune printenv --profile default bin ( (flags ("in bin")) (ocamlc_flags (-g)) (ocamlopt_flags (-g)) + (c_flags ()) + (cxx_flags ()) ) $ dune printenv --profile default vendor ( (flags (-w -40 ":standard + in .")) (ocamlc_flags (-g)) (ocamlopt_flags (-g)) + (c_flags ()) + (cxx_flags ()) ) Vendored project without env customization, the global default should @@ -31,6 +39,8 @@ apply: (flags (-w -40)) (ocamlc_flags (-g)) (ocamlopt_flags (-g)) + (c_flags ()) + (cxx_flags ()) ) Vendored project with env customization, the global default + @@ -41,11 +51,15 @@ customization of vendored project should apply: (flags (-w -40 ":standard + in vendor/with-env-customization")) (ocamlc_flags (-g)) (ocamlopt_flags (-g)) + (c_flags ()) + (cxx_flags ()) ) $ dune printenv --profile default vendor/with-env-customization/src ( (flags ("in vendor/with-env-customization/src")) (ocamlc_flags (-g)) (ocamlopt_flags (-g)) + (c_flags ()) + (cxx_flags ()) ) diff --git a/test/blackbox-tests/test-cases/workspaces/run.t b/test/blackbox-tests/test-cases/workspaces/run.t index 83bc0f877e1..7e182596c0f 100644 --- a/test/blackbox-tests/test-cases/workspaces/run.t +++ b/test/blackbox-tests/test-cases/workspaces/run.t @@ -65,4 +65,6 @@ Workspaces also allow you to set the env for a context: (flags (-w -40 -machin)) (ocamlc_flags (-g -verbose)) (ocamlopt_flags (-g)) + (c_flags ()) + (cxx_flags ()) ) From f571836c64120bf46c2dae419b9672400c8cb408 Mon Sep 17 00:00:00 2001 From: Greta Yorsh Date: Fri, 21 Dec 2018 12:48:06 +0000 Subject: [PATCH 04/13] fix PR review comments Signed-off-by: Greta Yorsh --- CHANGES.md | 2 ++ src/dune_env.ml | 6 ++++-- src/env_node.ml | 7 +++---- src/env_node.mli | 10 ++++++++-- src/lib_rules.ml | 16 ++++++++-------- src/super_context.ml | 7 ++----- src/super_context.mli | 2 ++ .../test-cases/env-cflags/dune-project | 2 +- 8 files changed, 30 insertions(+), 22 deletions(-) diff --git a/CHANGES.md b/CHANGES.md index 7005d8e6cc2..30d2b0127d8 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -93,6 +93,8 @@ unreleased - Generate `.merlin` files that account for normal preprocessors defined using a subset of the `action` language. (#1768, @rgrinberg) +- Add c_flags and cxx_flags to env profile settings (#1700, @gretay-js) + 1.6.2 (05/12/2018) ------------------ diff --git a/src/dune_env.ml b/src/dune_env.ml index 1a028c40333..7f2c5729daf 100644 --- a/src/dune_env.ml +++ b/src/dune_env.ml @@ -41,8 +41,10 @@ module Stanza = struct let%map flags = field_oslu "flags" and ocamlc_flags = field_oslu "ocamlc_flags" and ocamlopt_flags = field_oslu "ocamlopt_flags" - and c_flags = field_oslu "c_flags" - and cxx_flags = field_oslu "cxx_flags" + and c_flags = Ordered_set_lang.Unexpanded.field "c_flags" + ~check:(Syntax.since Stanza.syntax (1, 7)) + and cxx_flags = Ordered_set_lang.Unexpanded.field "cxx_flags" + ~check:(Syntax.since Stanza.syntax (1, 7)) and env_vars = env_vars_field and binaries = field ~default:File_bindings.empty "binaries" (Syntax.since Stanza.syntax (1, 6) diff --git a/src/env_node.ml b/src/env_node.ml index dbda028aa28..0adf767f6b5 100644 --- a/src/env_node.ml +++ b/src/env_node.ml @@ -114,15 +114,13 @@ let rec ocaml_flags t ~profile ~expander = t.ocaml_flags <- Some flags; flags - - let rec c_flags t ~profile ~expander = match t.c_flags with | Some x -> x | None -> let default = match t.inherit_from with - | None -> Build.return ([]) + | None -> Build.return [] | Some (lazy t) -> c_flags t ~profile ~expander in let flags = @@ -140,13 +138,14 @@ let rec c_flags t ~profile ~expander = t.c_flags <- Some flags; flags + let rec cxx_flags t ~profile ~expander = match t.cxx_flags with | Some x -> x | None -> let default = match t.inherit_from with - | None -> Build.return ([]) + | None -> Build.return [] | Some (lazy t) -> cxx_flags t ~profile ~expander in let flags = diff --git a/src/env_node.mli b/src/env_node.mli index 1c025c45f2f..44f9b09d43b 100644 --- a/src/env_node.mli +++ b/src/env_node.mli @@ -19,10 +19,16 @@ val external_ : t -> profile:string -> default:Env.t -> Env.t val ocaml_flags : t -> profile:string -> expander:Expander.t -> Ocaml_flags.t -val c_flags : t -> profile:string -> expander:Expander.t +val c_flags + : t + -> profile:string + -> expander:Expander.t -> (unit, string list) Build.t -val cxx_flags : t -> profile:string -> expander:Expander.t +val cxx_flags + : t + -> profile:string + -> expander:Expander.t -> (unit, string list) Build.t val local_binaries diff --git a/src/lib_rules.ml b/src/lib_rules.ml index 3bbff14513e..6ccbe59fce0 100644 --- a/src/lib_rules.ml +++ b/src/lib_rules.ml @@ -162,8 +162,8 @@ module Gen (P : Install_rules.Params) = struct let cctx = Compilation_context.for_wrapped_compat cctx wrapped_compat in Module_compilation.build_modules cctx ~js_of_ocaml ~dynlink ~dep_graphs - let build_c_file (lib : Library.t) ~dir ~includes (loc, src, dst) = - let c_flags = SC.c_flags sctx ~dir ~lib (Context.cc_g ctx) in + let build_c_file (lib : Library.t) ~dir ~expander ~includes (loc, src, dst) = + let c_flags = SC.c_flags sctx ~dir ~expander ~lib (Context.cc_g ctx) in SC.add_rule sctx ~loc ~dir (c_flags >>> @@ -180,7 +180,7 @@ module Gen (P : Install_rules.Params) = struct ]); dst - let build_cxx_file (lib : Library.t) ~dir ~includes (loc, src, dst) = + let build_cxx_file (lib : Library.t) ~dir ~expander ~includes (loc, src, dst) = let open Arg_spec in let output_param = if ctx.ccomp_type = "msvc" then @@ -188,7 +188,7 @@ module Gen (P : Install_rules.Params) = struct else [A "-o"; Target dst] in - let cxx_flags = SC.cxx_flags_gather sctx ~dir ~lib (Context.cc_g ctx) in + let cxx_flags = SC.cxx_flags_gather sctx ~dir ~expander ~lib (Context.cc_g ctx) in SC.add_rule sctx ~loc ~dir (cxx_flags >>> @@ -253,7 +253,7 @@ module Gen (P : Install_rules.Params) = struct ocamlmklib ~sandbox:true ~custom:false ~targets:[dynamic] end - let build_o_files lib ~dir ~requires ~dir_contents = + let build_o_files lib ~dir ~expander ~requires ~dir_contents = let all_dirs = Dir_contents.dirs dir_contents in let h_files = List.fold_left all_dirs ~init:[] ~f:(fun acc dc -> @@ -288,15 +288,15 @@ module Gen (P : Install_rules.Params) = struct ] in List.map lib.c_names ~f:(fun name -> - build_c_file lib ~dir ~includes (resolve_name name ~ext:".c") + build_c_file lib ~dir ~expander ~includes (resolve_name name ~ext:".c") ) @ List.map lib.cxx_names ~f:(fun name -> - build_cxx_file lib ~dir ~includes (resolve_name name ~ext:".cpp") + build_cxx_file lib ~dir ~expander ~includes (resolve_name name ~ext:".cpp") ) let build_stubs lib ~dir ~expander ~requires ~dir_contents ~vlib_stubs_o_files = let lib_o_files = if Library.has_stubs lib then - build_o_files lib ~dir ~requires ~dir_contents + build_o_files lib ~dir ~expander ~requires ~dir_contents else [] in diff --git a/src/super_context.ml b/src/super_context.ml index ca5dea467f6..ab0538787af 100644 --- a/src/super_context.ml +++ b/src/super_context.ml @@ -247,8 +247,7 @@ let ocaml_flags t ~dir (x : Buildable.t) = ~default:(Env.ocaml_flags t ~dir) ~eval:(Expander.expand_and_eval_set expander) -let c_flags t ~dir ~(lib : Library.t) ccg = - let expander = Env.expander t ~dir in +let c_flags t ~dir ~expander ~(lib : Library.t) ccg = let eval = Expander.expand_and_eval_set expander in let flags = lib.c_flags in let default = Env.c_flags t ~dir in @@ -261,9 +260,7 @@ let c_flags t ~dir ~(lib : Library.t) ccg = eval flags ~standard:(Build.return ccg) end - -let cxx_flags_gather t ~dir ~(lib : Library.t) ccg = - let expander = Env.expander t ~dir in +let cxx_flags_gather t ~dir ~expander ~(lib : Library.t) ccg = let eval = Expander.expand_and_eval_set expander in let flags = lib.cxx_flags in let default = Env.cxx_flags t ~dir in diff --git a/src/super_context.mli b/src/super_context.mli index 280c7b3e0bc..4b8f5dff3a2 100644 --- a/src/super_context.mli +++ b/src/super_context.mli @@ -56,6 +56,7 @@ val ocaml_flags val c_flags : t -> dir:Path.t + -> expander:Expander.t -> lib:Library.t -> string list -> (unit, string list) Build.t @@ -63,6 +64,7 @@ val c_flags val cxx_flags_gather : t -> dir:Path.t + -> expander:Expander.t -> lib:Library.t -> string list -> (unit, string list) Build.t diff --git a/test/blackbox-tests/test-cases/env-cflags/dune-project b/test/blackbox-tests/test-cases/env-cflags/dune-project index de4fc209200..43a1282a9fa 100644 --- a/test/blackbox-tests/test-cases/env-cflags/dune-project +++ b/test/blackbox-tests/test-cases/env-cflags/dune-project @@ -1 +1 @@ -(lang dune 1.0) +(lang dune 1.7) From e264566b4a1ca44f5c6a5132470ee7a6bb75c50f Mon Sep 17 00:00:00 2001 From: Greta Yorsh Date: Fri, 21 Dec 2018 15:19:35 +0000 Subject: [PATCH 05/13] rename cxx_flags in super_context Signed-off-by: Greta Yorsh --- src/lib_rules.ml | 4 ++-- src/super_context.ml | 12 ++++++------ src/super_context.mli | 4 ++-- 3 files changed, 10 insertions(+), 10 deletions(-) diff --git a/src/lib_rules.ml b/src/lib_rules.ml index 6ccbe59fce0..5d10a584ed5 100644 --- a/src/lib_rules.ml +++ b/src/lib_rules.ml @@ -188,7 +188,7 @@ module Gen (P : Install_rules.Params) = struct else [A "-o"; Target dst] in - let cxx_flags = SC.cxx_flags_gather sctx ~dir ~expander ~lib (Context.cc_g ctx) in + let cxx_flags = SC.cxx_flags sctx ~dir ~expander ~lib (Context.cc_g ctx) in SC.add_rule sctx ~loc ~dir (cxx_flags >>> @@ -198,7 +198,7 @@ module Gen (P : Install_rules.Params) = struct ~dir:(Path.parent_exn src) (SC.resolve_program ~loc:None ~dir sctx ctx.c_compiler) ([ S [A "-I"; Path ctx.stdlib_dir] - ; As (SC.cxx_flags sctx) + ; As (SC.cxx_flags_orig sctx) ; includes ; Dyn (fun cxx_flags -> As cxx_flags) ] @ output_param @ diff --git a/src/super_context.ml b/src/super_context.ml index ab0538787af..88c4452dcbc 100644 --- a/src/super_context.ml +++ b/src/super_context.ml @@ -16,7 +16,7 @@ type t = ; packages : Package.t Package.Name.Map.t ; file_tree : File_tree.t ; artifacts : Artifacts.t - ; cxx_flags : string list + ; cxx_flags_orig : string list ; expander : Expander.t ; chdir : (Action.t, Action.t) Build.t ; host : t option @@ -37,7 +37,7 @@ let packages t = t.packages let libs_by_package t = t.libs_by_package let artifacts t = t.artifacts let file_tree t = t.file_tree -let cxx_flags t = t.cxx_flags +let cxx_flags_orig t = t.cxx_flags_orig let build_dir t = t.context.build_dir let profile t = t.context.profile let build_system t = t.build_system @@ -260,7 +260,7 @@ let c_flags t ~dir ~expander ~(lib : Library.t) ccg = eval flags ~standard:(Build.return ccg) end -let cxx_flags_gather t ~dir ~expander ~(lib : Library.t) ccg = +let cxx_flags t ~dir ~expander ~(lib : Library.t) ccg = let eval = Expander.expand_and_eval_set expander in let flags = lib.cxx_flags in let default = Env.cxx_flags t ~dir in @@ -347,7 +347,7 @@ let create let artifacts = Artifacts.create context ~public_libs ~build_system in - let cxx_flags = + let cxx_flags_orig = List.filter context.ocamlc_cflags ~f:(fun s -> not (String.is_prefix s ~prefix:"-std=")) in @@ -382,7 +382,7 @@ let create ~context ~artifacts ~artifacts_host - ~cxx_flags + ~cxx_flags:cxx_flags_orig in let dir_status_db = Dir_status.DB.make file_tree ~stanzas_per_dir in { context @@ -397,7 +397,7 @@ let create ; packages ; file_tree ; artifacts - ; cxx_flags + ; cxx_flags_orig ; chdir = Build.arr (fun (action : Action.t) -> match action with | Chdir _ -> action diff --git a/src/super_context.mli b/src/super_context.mli index 4b8f5dff3a2..b558ad421ea 100644 --- a/src/super_context.mli +++ b/src/super_context.mli @@ -29,7 +29,7 @@ val packages : t -> Package.t Package.Name.Map.t val libs_by_package : t -> (Package.t * Lib.Set.t) Package.Name.Map.t val file_tree : t -> File_tree.t val artifacts : t -> Artifacts.t -val cxx_flags : t -> string list +val cxx_flags_orig : t -> string list val build_dir : t -> Path.t val profile : t -> string val host : t -> t @@ -61,7 +61,7 @@ val c_flags -> string list -> (unit, string list) Build.t -val cxx_flags_gather +val cxx_flags : t -> dir:Path.t -> expander:Expander.t From a16b9db8f69aad1975e0d06ea49eb72f9a2ff07c Mon Sep 17 00:00:00 2001 From: Greta Yorsh Date: Fri, 21 Dec 2018 15:25:00 +0000 Subject: [PATCH 06/13] remove cxx_flags_orig from super_context Signed-off-by: Greta Yorsh --- src/expander.ml | 4 ++-- src/expander.mli | 1 - src/lib_rules.ml | 1 - src/pform.ml | 4 +++- src/pform.mli | 2 +- src/super_context.ml | 8 -------- src/super_context.mli | 1 - 7 files changed, 6 insertions(+), 15 deletions(-) diff --git a/src/expander.ml b/src/expander.ml index f52a47cafd2..4e7c33b72bc 100644 --- a/src/expander.ml +++ b/src/expander.ml @@ -92,7 +92,7 @@ let expand_var_exn t var syn = (String_with_vars.Var.describe var)) let make ~scope ~(context : Context.t) ~artifacts - ~artifacts_host ~cxx_flags = + ~artifacts_host = let expand_var ({ bindings; ocaml_config; env = _; scope ; hidden_env = _ ; dir = _ ; artifacts = _; expand_var = _ @@ -109,7 +109,7 @@ let make ~scope ~(context : Context.t) ~artifacts in let ocaml_config = lazy (make_ocaml_config context.ocaml_config) in let dir = context.build_dir in - let bindings = Pform.Map.create ~context ~cxx_flags in + let bindings = Pform.Map.create ~context in let env = context.env in { dir ; hidden_env = Env.Var.Set.empty diff --git a/src/expander.mli b/src/expander.mli index 86c6627f331..b6752a0ec01 100644 --- a/src/expander.mli +++ b/src/expander.mli @@ -20,7 +20,6 @@ val make -> context:Context.t -> artifacts:Artifacts.t -> artifacts_host:Artifacts.t - -> cxx_flags:string list -> t val set_env : t -> var:string -> value:string -> t diff --git a/src/lib_rules.ml b/src/lib_rules.ml index 5d10a584ed5..eaaa70a2980 100644 --- a/src/lib_rules.ml +++ b/src/lib_rules.ml @@ -198,7 +198,6 @@ module Gen (P : Install_rules.Params) = struct ~dir:(Path.parent_exn src) (SC.resolve_program ~loc:None ~dir sctx ctx.c_compiler) ([ S [A "-I"; Path ctx.stdlib_dir] - ; As (SC.cxx_flags_orig sctx) ; includes ; Dyn (fun cxx_flags -> As cxx_flags) ] @ output_param @ diff --git a/src/pform.ml b/src/pform.ml index cb94efc1f58..8ba9b4dc8ce 100644 --- a/src/pform.ml +++ b/src/pform.ml @@ -154,7 +154,7 @@ module Map = struct ; "env", since ~version:(1, 4) Macro.Env ] - let create ~(context : Context.t) ~cxx_flags = + let create ~(context : Context.t) = let ocamlopt = match context.ocamlopt with | None -> Path.relative context.ocaml_bin "ocamlopt" @@ -168,6 +168,8 @@ module Map = struct | Some p -> path p in let cflags = context.ocamlc_cflags in + let cxx_flags = List.filter context.ocamlc_cflags + ~f:(fun s -> not (String.is_prefix s ~prefix:"-std=")) in let strings s = values (Value.L.strings s) in let lowercased = [ "cpp" , strings (context.c_compiler :: cflags @ ["-E"]) diff --git a/src/pform.mli b/src/pform.mli index 32b00ce8ac4..e8c57908bcb 100644 --- a/src/pform.mli +++ b/src/pform.mli @@ -38,7 +38,7 @@ end module Map : sig type t - val create : context:Context.t -> cxx_flags:string list -> t + val create : context:Context.t -> t val superpose : t -> t -> t diff --git a/src/super_context.ml b/src/super_context.ml index 88c4452dcbc..b12eef9820e 100644 --- a/src/super_context.ml +++ b/src/super_context.ml @@ -16,7 +16,6 @@ type t = ; packages : Package.t Package.Name.Map.t ; file_tree : File_tree.t ; artifacts : Artifacts.t - ; cxx_flags_orig : string list ; expander : Expander.t ; chdir : (Action.t, Action.t) Build.t ; host : t option @@ -37,7 +36,6 @@ let packages t = t.packages let libs_by_package t = t.libs_by_package let artifacts t = t.artifacts let file_tree t = t.file_tree -let cxx_flags_orig t = t.cxx_flags_orig let build_dir t = t.context.build_dir let profile t = t.context.profile let build_system t = t.build_system @@ -347,10 +345,6 @@ let create let artifacts = Artifacts.create context ~public_libs ~build_system in - let cxx_flags_orig = - List.filter context.ocamlc_cflags - ~f:(fun s -> not (String.is_prefix s ~prefix:"-std=")) - in let default_env = lazy ( let make ~inherit_from ~config = Env_node.make @@ -382,7 +376,6 @@ let create ~context ~artifacts ~artifacts_host - ~cxx_flags:cxx_flags_orig in let dir_status_db = Dir_status.DB.make file_tree ~stanzas_per_dir in { context @@ -397,7 +390,6 @@ let create ; packages ; file_tree ; artifacts - ; cxx_flags_orig ; chdir = Build.arr (fun (action : Action.t) -> match action with | Chdir _ -> action diff --git a/src/super_context.mli b/src/super_context.mli index b558ad421ea..7d419a0635a 100644 --- a/src/super_context.mli +++ b/src/super_context.mli @@ -29,7 +29,6 @@ val packages : t -> Package.t Package.Name.Map.t val libs_by_package : t -> (Package.t * Lib.Set.t) Package.Name.Map.t val file_tree : t -> File_tree.t val artifacts : t -> Artifacts.t -val cxx_flags_orig : t -> string list val build_dir : t -> Path.t val profile : t -> string val host : t -> t From 131a73da5601869a978435844cc4f28d65abfed0 Mon Sep 17 00:00:00 2001 From: Greta Yorsh Date: Fri, 11 Jan 2019 08:13:53 +0000 Subject: [PATCH 07/13] Remove ccg argument from c_flag and cxx_flags of supercontext. and fix a typo. Signed-off-by: Greta Yorsh --- src/lib_rules.ml | 4 ++-- src/super_context.ml | 8 +++++--- src/super_context.mli | 2 -- 3 files changed, 7 insertions(+), 7 deletions(-) diff --git a/src/lib_rules.ml b/src/lib_rules.ml index eaaa70a2980..903f6933625 100644 --- a/src/lib_rules.ml +++ b/src/lib_rules.ml @@ -163,7 +163,7 @@ module Gen (P : Install_rules.Params) = struct Module_compilation.build_modules cctx ~js_of_ocaml ~dynlink ~dep_graphs let build_c_file (lib : Library.t) ~dir ~expander ~includes (loc, src, dst) = - let c_flags = SC.c_flags sctx ~dir ~expander ~lib (Context.cc_g ctx) in + let c_flags = SC.c_flags sctx ~dir ~expander ~lib in SC.add_rule sctx ~loc ~dir (c_flags >>> @@ -188,7 +188,7 @@ module Gen (P : Install_rules.Params) = struct else [A "-o"; Target dst] in - let cxx_flags = SC.cxx_flags sctx ~dir ~expander ~lib (Context.cc_g ctx) in + let cxx_flags = SC.cxx_flags sctx ~dir ~expander ~lib in SC.add_rule sctx ~loc ~dir (cxx_flags >>> diff --git a/src/super_context.ml b/src/super_context.ml index b12eef9820e..38a95e8ec6f 100644 --- a/src/super_context.ml +++ b/src/super_context.ml @@ -245,7 +245,8 @@ let ocaml_flags t ~dir (x : Buildable.t) = ~default:(Env.ocaml_flags t ~dir) ~eval:(Expander.expand_and_eval_set expander) -let c_flags t ~dir ~expander ~(lib : Library.t) ccg = +let c_flags t ~dir ~expander ~(lib : Library.t) = + let ccg = Context.cc_g t.context in let eval = Expander.expand_and_eval_set expander in let flags = lib.c_flags in let default = Env.c_flags t ~dir in @@ -258,11 +259,12 @@ let c_flags t ~dir ~expander ~(lib : Library.t) ccg = eval flags ~standard:(Build.return ccg) end -let cxx_flags t ~dir ~expander ~(lib : Library.t) ccg = +let cxx_flags t ~dir ~expander ~(lib : Library.t) = + let ccg = Context.cc_g t.context in let eval = Expander.expand_and_eval_set expander in let flags = lib.cxx_flags in let default = Env.cxx_flags t ~dir in - Build.memoize "c flags" + Build.memoize "cxx flags" begin if Ordered_set_lang.Unexpanded.has_special_forms flags then let c = eval flags ~standard:default in diff --git a/src/super_context.mli b/src/super_context.mli index 7d419a0635a..d7d9d06c5ba 100644 --- a/src/super_context.mli +++ b/src/super_context.mli @@ -57,7 +57,6 @@ val c_flags -> dir:Path.t -> expander:Expander.t -> lib:Library.t - -> string list -> (unit, string list) Build.t val cxx_flags @@ -65,7 +64,6 @@ val cxx_flags -> dir:Path.t -> expander:Expander.t -> lib:Library.t - -> string list -> (unit, string list) Build.t (** Binaries that are symlinked in the associated .bin directory of [dir]. This From 0cd36d37944969432fee34cadbf7151636da6c5b Mon Sep 17 00:00:00 2001 From: Greta Yorsh Date: Fri, 11 Jan 2019 10:22:28 +0000 Subject: [PATCH 08/13] Add test for run action with env flags (fails) Signed-off-by: Greta Yorsh --- .../test-cases/env-cflags/run.t | 21 ++++++++++++++++ .../test-cases/env-cflags/run/bar.cpp | 11 ++++++++ .../test-cases/env-cflags/run/dune | 25 +++++++++++++++++++ .../test-cases/env-cflags/run/foo.c | 11 ++++++++ 4 files changed, 68 insertions(+) create mode 100644 test/blackbox-tests/test-cases/env-cflags/run/bar.cpp create mode 100644 test/blackbox-tests/test-cases/env-cflags/run/dune create mode 100644 test/blackbox-tests/test-cases/env-cflags/run/foo.c diff --git a/test/blackbox-tests/test-cases/env-cflags/run.t b/test/blackbox-tests/test-cases/env-cflags/run.t index 8783c53d9cf..3651c81b20c 100644 --- a/test/blackbox-tests/test-cases/env-cflags/run.t +++ b/test/blackbox-tests/test-cases/env-cflags/run.t @@ -24,3 +24,24 @@ (c_flags ("in bin")) (cxx_flags ("in bin")) ) + + $ dune printenv --profile default run + ( + (flags (-w -40)) + (ocamlc_flags (-g)) + (ocamlopt_flags (-g)) + (c_flags (-DTEST_C)) + (cxx_flags (-DTEST_CPP)) + ) + $ dune build --profile default run/foo.exe + $ dune build --profile default @runfoo + foo alias run/runfoo (exit 1) + (cd _build/default/run && ./foo.exe) + DTEST_C defined. + [1] + $ dune build --profile default run/bar.exe + $ dune build --profile default @runbar + bar alias run/runbar (exit 1) + (cd _build/default/run && ./bar.exe) + DTEST_CPP defined. + [1] diff --git a/test/blackbox-tests/test-cases/env-cflags/run/bar.cpp b/test/blackbox-tests/test-cases/env-cflags/run/bar.cpp new file mode 100644 index 00000000000..6edf721922f --- /dev/null +++ b/test/blackbox-tests/test-cases/env-cflags/run/bar.cpp @@ -0,0 +1,11 @@ +#include + +int main(int argc, char ** argv){ +#ifdef TEST + printf("DTEST_CPP defined.\n"); + return 0; +#else + printf("DTEST_CPP not defined.\n"); + return 1; +#endif +} diff --git a/test/blackbox-tests/test-cases/env-cflags/run/dune b/test/blackbox-tests/test-cases/env-cflags/run/dune new file mode 100644 index 00000000000..825ff8470b5 --- /dev/null +++ b/test/blackbox-tests/test-cases/env-cflags/run/dune @@ -0,0 +1,25 @@ +(env + (default + (c_flags "-DTEST_C") + (cxx_flags "-DTEST_CPP"))) + +(rule + (targets foo.exe) + (deps foo.c) + (action (run %{cc} -o %{targets} %{deps}))) + +(alias + (name runfoo) + (action + (run ./foo.exe))) + + +(rule + (targets bar.exe) + (deps bar.cpp) + (action (run %{cxx} -o %{targets} %{deps}))) + +(alias + (name runbar) + (action + (run ./bar.exe))) diff --git a/test/blackbox-tests/test-cases/env-cflags/run/foo.c b/test/blackbox-tests/test-cases/env-cflags/run/foo.c new file mode 100644 index 00000000000..3c85278571b --- /dev/null +++ b/test/blackbox-tests/test-cases/env-cflags/run/foo.c @@ -0,0 +1,11 @@ +#include + +int main(int argc, char ** argv){ +#ifdef TEST + printf("DTEST_C defined.\n"); + return 0; +#else + printf("DTEST_C not defined.\n"); + return 1; +#endif +} From 82008bc1ba30a832cdf8154c9c2076d9a9dc9566 Mon Sep 17 00:00:00 2001 From: Greta Yorsh Date: Fri, 11 Jan 2019 13:58:50 +0000 Subject: [PATCH 09/13] Fix cxx_flags default Signed-off-by: Greta Yorsh --- src/env_node.ml | 12 ++++++------ src/env_node.mli | 2 ++ src/super_context.ml | 10 +++++++++- 3 files changed, 17 insertions(+), 7 deletions(-) diff --git a/src/env_node.ml b/src/env_node.ml index 0adf767f6b5..af64a2bd6c9 100644 --- a/src/env_node.ml +++ b/src/env_node.ml @@ -114,14 +114,14 @@ let rec ocaml_flags t ~profile ~expander = t.ocaml_flags <- Some flags; flags -let rec c_flags t ~profile ~expander = +let rec c_flags t ~profile ~expander ~default_context_flags = match t.c_flags with | Some x -> x | None -> let default = match t.inherit_from with - | None -> Build.return [] - | Some (lazy t) -> c_flags t ~profile ~expander + | None -> Build.return default_context_flags + | Some (lazy t) -> c_flags t ~profile ~expander ~default_context_flags in let flags = match find_config t ~profile with @@ -139,14 +139,14 @@ let rec c_flags t ~profile ~expander = flags -let rec cxx_flags t ~profile ~expander = +let rec cxx_flags t ~profile ~expander ~default_context_flags = match t.cxx_flags with | Some x -> x | None -> let default = match t.inherit_from with - | None -> Build.return [] - | Some (lazy t) -> cxx_flags t ~profile ~expander + | None -> Build.return default_context_flags + | Some (lazy t) -> cxx_flags t ~profile ~expander ~default_context_flags in let flags = match find_config t ~profile with diff --git a/src/env_node.mli b/src/env_node.mli index 44f9b09d43b..74b9c6aa5e0 100644 --- a/src/env_node.mli +++ b/src/env_node.mli @@ -23,12 +23,14 @@ val c_flags : t -> profile:string -> expander:Expander.t + -> default_context_flags:string list -> (unit, string list) Build.t val cxx_flags : t -> profile:string -> expander:Expander.t + -> default_context_flags:string list -> (unit, string list) Build.t val local_binaries diff --git a/src/super_context.ml b/src/super_context.ml index 38a95e8ec6f..612a69247d3 100644 --- a/src/super_context.ml +++ b/src/super_context.ml @@ -153,12 +153,20 @@ end = struct ~profile:(profile t) ~expander:(expander t ~dir) let c_flags t ~dir = + let ctx = t.context in + let default_context_flags = ctx.ocamlc_cflags in Env_node.c_flags (get t ~dir) ~profile:(profile t) ~expander:(expander t ~dir) + ~default_context_flags let cxx_flags t ~dir = + let ctx = t.context in + let default_context_flags = + List.filter ctx.ocamlc_cflags + ~f:(fun s -> not (String.is_prefix s ~prefix:"-std=")) in Env_node.cxx_flags (get t ~dir) ~profile:(profile t) ~expander:(expander t ~dir) + ~default_context_flags end let expander = Env.expander @@ -260,7 +268,7 @@ let c_flags t ~dir ~expander ~(lib : Library.t) = end let cxx_flags t ~dir ~expander ~(lib : Library.t) = - let ccg = Context.cc_g t.context in + let ccg = Context.cc_g t.context in let eval = Expander.expand_and_eval_set expander in let flags = lib.cxx_flags in let default = Env.cxx_flags t ~dir in From 67f9820a19c265bd931c67f92530626a0d2c5482 Mon Sep 17 00:00:00 2001 From: Greta Yorsh Date: Fri, 18 Jan 2019 14:59:44 +0000 Subject: [PATCH 10/13] fix test Signed-off-by: Greta Yorsh --- test/blackbox-tests/test-cases/env-cflags/run.t | 8 ++------ test/blackbox-tests/test-cases/env-cflags/run/dune | 10 ---------- 2 files changed, 2 insertions(+), 16 deletions(-) diff --git a/test/blackbox-tests/test-cases/env-cflags/run.t b/test/blackbox-tests/test-cases/env-cflags/run.t index 3651c81b20c..810f842fe1e 100644 --- a/test/blackbox-tests/test-cases/env-cflags/run.t +++ b/test/blackbox-tests/test-cases/env-cflags/run.t @@ -33,15 +33,11 @@ (c_flags (-DTEST_C)) (cxx_flags (-DTEST_CPP)) ) - $ dune build --profile default run/foo.exe - $ dune build --profile default @runfoo - foo alias run/runfoo (exit 1) + $ dune exec --profile default ./run/foo.exe (cd _build/default/run && ./foo.exe) DTEST_C defined. [1] - $ dune build --profile default run/bar.exe - $ dune build --profile default @runbar - bar alias run/runbar (exit 1) + $ dune exec --profile default ./run/bar.exe (cd _build/default/run && ./bar.exe) DTEST_CPP defined. [1] diff --git a/test/blackbox-tests/test-cases/env-cflags/run/dune b/test/blackbox-tests/test-cases/env-cflags/run/dune index 825ff8470b5..3adaa19c387 100644 --- a/test/blackbox-tests/test-cases/env-cflags/run/dune +++ b/test/blackbox-tests/test-cases/env-cflags/run/dune @@ -8,18 +8,8 @@ (deps foo.c) (action (run %{cc} -o %{targets} %{deps}))) -(alias - (name runfoo) - (action - (run ./foo.exe))) - - (rule (targets bar.exe) (deps bar.cpp) (action (run %{cxx} -o %{targets} %{deps}))) -(alias - (name runbar) - (action - (run ./bar.exe))) From 9df8f000314e5e4a00ff614d21c9962fa44795af Mon Sep 17 00:00:00 2001 From: Greta Yorsh Date: Mon, 21 Jan 2019 09:19:40 +0000 Subject: [PATCH 11/13] Updated testsuite expected outputs Signed-off-by: Greta Yorsh --- .../test-cases/env-cflags/run.t | 45 +++++-------------- test/blackbox-tests/test-cases/env/bin/dune | 4 +- test/blackbox-tests/test-cases/env/dune | 4 +- .../test-cases/env/dune-project | 2 +- test/blackbox-tests/test-cases/env/run.t | 12 ++--- test/blackbox-tests/test-cases/env/src/dune | 4 +- .../env/vendor/with-env-customization/dune | 4 +- .../with-env-customization/dune-project | 2 +- .../workspaces/workspace-env/dune-workspace | 8 ++-- 9 files changed, 33 insertions(+), 52 deletions(-) diff --git a/test/blackbox-tests/test-cases/env-cflags/run.t b/test/blackbox-tests/test-cases/env-cflags/run.t index 810f842fe1e..b2a3f5a75b9 100644 --- a/test/blackbox-tests/test-cases/env-cflags/run.t +++ b/test/blackbox-tests/test-cases/env-cflags/run.t @@ -1,43 +1,18 @@ - $ dune printenv --profile default . - ( - (flags (-w -40)) - (ocamlc_flags (-g)) - (ocamlopt_flags (-g)) - (c_flags (":standard + in .")) - (cxx_flags (":standard + in .")) - ) + $ export STANDARD_C_FLAGS=`ocamlc -config | grep ocamlc_cflags | sed 's/ocamlc_cflags: //'` + $ export STANDARD_CXX_FLAGS=`ocamlc -config | grep ocamlc_cflags | sed 's/ocamlc_cflags: //' | sed 's/-std=[^ ]* //' | sed 's/-std=[^$]*//'` + $ dune printenv --profile default . | tr '\n' ' ' | sed 's/ \+/ /g' | sed "s/$STANDARD_C_FLAGS/STANDARD_C_FLAGS/" | sed "s/$STANDARD_CXX_FLAGS/STANDARD_CXX_FLAGS/" + ( (flags (-w -40)) (ocamlc_flags (-g)) (ocamlopt_flags (-g)) (c_flags (STANDARD_C_FLAGS ":standard + in .")) (cxx_flags (STANDARD_CXX_FLAGS ":standard + in .")) ) - $ dune printenv --profile default src - ( - (flags (-w -40)) - (ocamlc_flags (-g)) - (ocamlopt_flags (-g)) - (c_flags (":standard + in ." ":standard + in src")) - (cxx_flags (":standard + in ." ":standard + in src")) - ) + $ dune printenv --profile default src | tr '\n' ' ' | sed 's/ \+/ /g' | sed "s/$STANDARD_C_FLAGS/STANDARD_C_FLAGS/" | sed "s/$STANDARD_CXX_FLAGS/STANDARD_CXX_FLAGS/" + ( (flags (-w -40)) (ocamlc_flags (-g)) (ocamlopt_flags (-g)) (c_flags (STANDARD_C_FLAGS ":standard + in ." ":standard + in src")) (cxx_flags (STANDARD_CXX_FLAGS ":standard + in ." ":standard + in src")) ) - $ dune printenv --profile default bin - ( - (flags (-w -40)) - (ocamlc_flags (-g)) - (ocamlopt_flags (-g)) - (c_flags ("in bin")) - (cxx_flags ("in bin")) - ) - - $ dune printenv --profile default run - ( - (flags (-w -40)) - (ocamlc_flags (-g)) - (ocamlopt_flags (-g)) - (c_flags (-DTEST_C)) - (cxx_flags (-DTEST_CPP)) - ) + $ dune printenv --profile default bin | tr '\n' ' ' | sed 's/ \+/ /g' | sed "s/$STANDARD_C_FLAGS/STANDARD_C_FLAGS/" | sed "s/$STANDARD_CXX_FLAGS/STANDARD_CXX_FLAGS/" + ( (flags (-w -40)) (ocamlc_flags (-g)) (ocamlopt_flags (-g)) (c_flags ("in bin")) (cxx_flags ("in bin")) ) + $ dune printenv --profile default run | tr '\n' ' ' | sed 's/ \+/ /g' | sed "s/$STANDARD_C_FLAGS/STANDARD_C_FLAGS/" | sed "s/$STANDARD_CXX_FLAGS/STANDARD_CXX_FLAGS/" + ( (flags (-w -40)) (ocamlc_flags (-g)) (ocamlopt_flags (-g)) (c_flags (-DTEST_C)) (cxx_flags (-DTEST_CPP)) ) $ dune exec --profile default ./run/foo.exe - (cd _build/default/run && ./foo.exe) DTEST_C defined. [1] $ dune exec --profile default ./run/bar.exe - (cd _build/default/run && ./bar.exe) DTEST_CPP defined. [1] diff --git a/test/blackbox-tests/test-cases/env/bin/dune b/test/blackbox-tests/test-cases/env/bin/dune index 1a4673f807d..e11548ed03a 100644 --- a/test/blackbox-tests/test-cases/env/bin/dune +++ b/test/blackbox-tests/test-cases/env/bin/dune @@ -1,3 +1,5 @@ (env (default - (flags "in bin"))) + (flags "in bin") + (c_flags ()) + (cxx_flags ()))) diff --git a/test/blackbox-tests/test-cases/env/dune b/test/blackbox-tests/test-cases/env/dune index 6ecfff65f30..d7888e8c60a 100644 --- a/test/blackbox-tests/test-cases/env/dune +++ b/test/blackbox-tests/test-cases/env/dune @@ -1,3 +1,5 @@ (env (default - (flags :standard ":standard + in ."))) + (flags :standard ":standard + in .") + (c_flags ()) + (cxx_flags ()))) diff --git a/test/blackbox-tests/test-cases/env/dune-project b/test/blackbox-tests/test-cases/env/dune-project index de4fc209200..43a1282a9fa 100644 --- a/test/blackbox-tests/test-cases/env/dune-project +++ b/test/blackbox-tests/test-cases/env/dune-project @@ -1 +1 @@ -(lang dune 1.0) +(lang dune 1.7) diff --git a/test/blackbox-tests/test-cases/env/run.t b/test/blackbox-tests/test-cases/env/run.t index 0b911c0494e..5f2c7e116ad 100644 --- a/test/blackbox-tests/test-cases/env/run.t +++ b/test/blackbox-tests/test-cases/env/run.t @@ -34,14 +34,10 @@ Vendored project without env customization, the global default should apply: - $ dune printenv --profile default vendor/without-env-customization - ( - (flags (-w -40)) - (ocamlc_flags (-g)) - (ocamlopt_flags (-g)) - (c_flags ()) - (cxx_flags ()) - ) + $ export STANDARD_C_FLAGS=`ocamlc -config | grep ocamlc_cflags | sed 's/ocamlc_cflags: //'` + $ export STANDARD_CXX_FLAGS=`ocamlc -config | grep ocamlc_cflags | sed 's/ocamlc_cflags: //' | sed 's/-std=[^ ]* //' | sed 's/-std=[^$]*//'` + $ dune printenv --profile default vendor/without-env-customization | tr '\n' ' ' | sed 's/ \+/ /g' | sed "s/$STANDARD_C_FLAGS/STANDARD_C_FLAGS/" | sed "s/$STANDARD_CXX_FLAGS/STANDARD_CXX_FLAGS/" + ( (flags (-w -40)) (ocamlc_flags (-g)) (ocamlopt_flags (-g)) (c_flags (STANDARD_C_FLAGS)) (cxx_flags (STANDARD_CXX_FLAGS)) ) Vendored project with env customization, the global default + customization of vendored project should apply: diff --git a/test/blackbox-tests/test-cases/env/src/dune b/test/blackbox-tests/test-cases/env/src/dune index 2d6ea231567..4d9d778c2ae 100644 --- a/test/blackbox-tests/test-cases/env/src/dune +++ b/test/blackbox-tests/test-cases/env/src/dune @@ -1,3 +1,5 @@ (env (default - (flags :standard ":standard + in src"))) + (flags :standard ":standard + in src") + (c_flags ()) + (cxx_flags ()))) diff --git a/test/blackbox-tests/test-cases/env/vendor/with-env-customization/dune b/test/blackbox-tests/test-cases/env/vendor/with-env-customization/dune index b0a7746c82a..c547cd97aea 100644 --- a/test/blackbox-tests/test-cases/env/vendor/with-env-customization/dune +++ b/test/blackbox-tests/test-cases/env/vendor/with-env-customization/dune @@ -1,3 +1,5 @@ (env (default - (flags :standard ":standard + in vendor/with-env-customization"))) + (flags :standard ":standard + in vendor/with-env-customization") + (c_flags ()) + (cxx_flags ()))) diff --git a/test/blackbox-tests/test-cases/env/vendor/with-env-customization/dune-project b/test/blackbox-tests/test-cases/env/vendor/with-env-customization/dune-project index de4fc209200..43a1282a9fa 100644 --- a/test/blackbox-tests/test-cases/env/vendor/with-env-customization/dune-project +++ b/test/blackbox-tests/test-cases/env/vendor/with-env-customization/dune-project @@ -1 +1 @@ -(lang dune 1.0) +(lang dune 1.7) diff --git a/test/blackbox-tests/test-cases/workspaces/workspace-env/dune-workspace b/test/blackbox-tests/test-cases/workspaces/workspace-env/dune-workspace index 4042a1a4371..b85e7cb7b79 100644 --- a/test/blackbox-tests/test-cases/workspaces/workspace-env/dune-workspace +++ b/test/blackbox-tests/test-cases/workspaces/workspace-env/dune-workspace @@ -1,11 +1,13 @@ -(lang dune 1.1) +(lang dune 1.7) (env (default - (ocamlc_flags (:standard -verbose)))) + (ocamlc_flags (:standard -verbose)) + (c_flags ()) + (cxx_flags ()))) (context (default (env (default - (flags (:standard -machin)))))) \ No newline at end of file + (flags (:standard -machin)))))) From a98b83023ae24c0730201d8836b0581d4b798bdd Mon Sep 17 00:00:00 2001 From: Greta Yorsh Date: Fri, 15 Feb 2019 16:07:51 +0000 Subject: [PATCH 12/13] Fix test script that depend on printenv Signed-off-by: Greta Yorsh --- .../test-cases/env-cflags/printenv.sh | 7 +++++++ test/blackbox-tests/test-cases/env-cflags/run.t | 14 ++++++-------- test/blackbox-tests/test-cases/env/printenv.sh | 7 +++++++ test/blackbox-tests/test-cases/env/run.t | 4 +--- 4 files changed, 21 insertions(+), 11 deletions(-) create mode 100755 test/blackbox-tests/test-cases/env-cflags/printenv.sh create mode 100755 test/blackbox-tests/test-cases/env/printenv.sh diff --git a/test/blackbox-tests/test-cases/env-cflags/printenv.sh b/test/blackbox-tests/test-cases/env-cflags/printenv.sh new file mode 100755 index 00000000000..32c1d009280 --- /dev/null +++ b/test/blackbox-tests/test-cases/env-cflags/printenv.sh @@ -0,0 +1,7 @@ +#!/bin/bash + +# Manipulate output of "dune printenv" to make it independent of the local configuration. + +export STANDARD_C_FLAGS=`ocamlc -config | grep ocamlc_cflags | sed 's/ocamlc_cflags: //'` +export STANDARD_CXX_FLAGS=`ocamlc -config | grep ocamlc_cflags | sed 's/ocamlc_cflags: //' | sed 's/-std=[^ ]* //' | sed 's/-std=[^$]*//'` +dune printenv $@ | tr '\n' ' ' | sed 's/ \+/ /g' | sed "s/$STANDARD_C_FLAGS/STANDARD_C_FLAGS/" | sed "s/$STANDARD_CXX_FLAGS/STANDARD_CXX_FLAGS/" diff --git a/test/blackbox-tests/test-cases/env-cflags/run.t b/test/blackbox-tests/test-cases/env-cflags/run.t index b2a3f5a75b9..6a9e667eea1 100644 --- a/test/blackbox-tests/test-cases/env-cflags/run.t +++ b/test/blackbox-tests/test-cases/env-cflags/run.t @@ -1,18 +1,16 @@ - $ export STANDARD_C_FLAGS=`ocamlc -config | grep ocamlc_cflags | sed 's/ocamlc_cflags: //'` - $ export STANDARD_CXX_FLAGS=`ocamlc -config | grep ocamlc_cflags | sed 's/ocamlc_cflags: //' | sed 's/-std=[^ ]* //' | sed 's/-std=[^$]*//'` - $ dune printenv --profile default . | tr '\n' ' ' | sed 's/ \+/ /g' | sed "s/$STANDARD_C_FLAGS/STANDARD_C_FLAGS/" | sed "s/$STANDARD_CXX_FLAGS/STANDARD_CXX_FLAGS/" + $ ./printenv.sh --profile default . ( (flags (-w -40)) (ocamlc_flags (-g)) (ocamlopt_flags (-g)) (c_flags (STANDARD_C_FLAGS ":standard + in .")) (cxx_flags (STANDARD_CXX_FLAGS ":standard + in .")) ) - $ dune printenv --profile default src | tr '\n' ' ' | sed 's/ \+/ /g' | sed "s/$STANDARD_C_FLAGS/STANDARD_C_FLAGS/" | sed "s/$STANDARD_CXX_FLAGS/STANDARD_CXX_FLAGS/" + $ ./printenv.sh --profile default src ( (flags (-w -40)) (ocamlc_flags (-g)) (ocamlopt_flags (-g)) (c_flags (STANDARD_C_FLAGS ":standard + in ." ":standard + in src")) (cxx_flags (STANDARD_CXX_FLAGS ":standard + in ." ":standard + in src")) ) - $ dune printenv --profile default bin | tr '\n' ' ' | sed 's/ \+/ /g' | sed "s/$STANDARD_C_FLAGS/STANDARD_C_FLAGS/" | sed "s/$STANDARD_CXX_FLAGS/STANDARD_CXX_FLAGS/" + $ ./printenv.sh --profile default bin | tr '\n' ' ' | sed 's/ \+/ /g' | sed "s/$STANDARD_C_FLAGS/STANDARD_C_FLAGS/" | sed "s/$STANDARD_CXX_FLAGS/STANDARD_CXX_FLAGS/" ( (flags (-w -40)) (ocamlc_flags (-g)) (ocamlopt_flags (-g)) (c_flags ("in bin")) (cxx_flags ("in bin")) ) - $ dune printenv --profile default run | tr '\n' ' ' | sed 's/ \+/ /g' | sed "s/$STANDARD_C_FLAGS/STANDARD_C_FLAGS/" | sed "s/$STANDARD_CXX_FLAGS/STANDARD_CXX_FLAGS/" + $ ./printenv.sh --profile default run | tr '\n' ' ' | sed 's/ \+/ /g' | sed "s/$STANDARD_C_FLAGS/STANDARD_C_FLAGS/" | sed "s/$STANDARD_CXX_FLAGS/STANDARD_CXX_FLAGS/" ( (flags (-w -40)) (ocamlc_flags (-g)) (ocamlopt_flags (-g)) (c_flags (-DTEST_C)) (cxx_flags (-DTEST_CPP)) ) $ dune exec --profile default ./run/foo.exe DTEST_C defined. - [1] + $ dune exec --profile default ./run/bar.exe DTEST_CPP defined. - [1] + diff --git a/test/blackbox-tests/test-cases/env/printenv.sh b/test/blackbox-tests/test-cases/env/printenv.sh new file mode 100755 index 00000000000..32c1d009280 --- /dev/null +++ b/test/blackbox-tests/test-cases/env/printenv.sh @@ -0,0 +1,7 @@ +#!/bin/bash + +# Manipulate output of "dune printenv" to make it independent of the local configuration. + +export STANDARD_C_FLAGS=`ocamlc -config | grep ocamlc_cflags | sed 's/ocamlc_cflags: //'` +export STANDARD_CXX_FLAGS=`ocamlc -config | grep ocamlc_cflags | sed 's/ocamlc_cflags: //' | sed 's/-std=[^ ]* //' | sed 's/-std=[^$]*//'` +dune printenv $@ | tr '\n' ' ' | sed 's/ \+/ /g' | sed "s/$STANDARD_C_FLAGS/STANDARD_C_FLAGS/" | sed "s/$STANDARD_CXX_FLAGS/STANDARD_CXX_FLAGS/" diff --git a/test/blackbox-tests/test-cases/env/run.t b/test/blackbox-tests/test-cases/env/run.t index 5f2c7e116ad..fb4ea7929e0 100644 --- a/test/blackbox-tests/test-cases/env/run.t +++ b/test/blackbox-tests/test-cases/env/run.t @@ -34,9 +34,7 @@ Vendored project without env customization, the global default should apply: - $ export STANDARD_C_FLAGS=`ocamlc -config | grep ocamlc_cflags | sed 's/ocamlc_cflags: //'` - $ export STANDARD_CXX_FLAGS=`ocamlc -config | grep ocamlc_cflags | sed 's/ocamlc_cflags: //' | sed 's/-std=[^ ]* //' | sed 's/-std=[^$]*//'` - $ dune printenv --profile default vendor/without-env-customization | tr '\n' ' ' | sed 's/ \+/ /g' | sed "s/$STANDARD_C_FLAGS/STANDARD_C_FLAGS/" | sed "s/$STANDARD_CXX_FLAGS/STANDARD_CXX_FLAGS/" + $ ./printenv.sh --profile default vendor/without-env-customization ( (flags (-w -40)) (ocamlc_flags (-g)) (ocamlopt_flags (-g)) (c_flags (STANDARD_C_FLAGS)) (cxx_flags (STANDARD_CXX_FLAGS)) ) Vendored project with env customization, the global default + From 675a0cdae0f122ec437cd3cb22b887ff7b1789c4 Mon Sep 17 00:00:00 2001 From: Greta Yorsh Date: Fri, 15 Feb 2019 15:28:46 +0000 Subject: [PATCH 13/13] NOT WORKING: cc and cxx variables should depend on c_flags and cxx_flags Signed-off-by: Greta Yorsh --- src/super_context.ml | 12 ++++++++++-- 1 file changed, 10 insertions(+), 2 deletions(-) diff --git a/src/super_context.ml b/src/super_context.ml index 612a69247d3..09f0b447569 100644 --- a/src/super_context.ml +++ b/src/super_context.ml @@ -169,7 +169,15 @@ end = struct ~default_context_flags end -let expander = Env.expander +let expander t ~dir= + let strings s = Pform.Var.Values (Value.L.strings s) in + let bindings = + Pform.Map.of_list_exn + [ + "cc" , strings (t.context.c_compiler :: (Env.c_flags t ~dir)) + ; "cxx", strings (t.context.c_compiler :: (Env.cxx_flags t ~dir)) + ] in + Expander.add_bindings (Env.expander t ~dir) ~bindings let add_rule t ?sandbox ?mode ?locks ?loc ~dir build = let build = Build.O.(>>>) build t.chdir in @@ -245,7 +253,7 @@ let partial_expand sctx ~dep_kind ~targets_written_by_user ~map_exe let ocaml_flags t ~dir (x : Buildable.t) = - let expander = Env.expander t ~dir in + let expander = expander t ~dir in Ocaml_flags.make ~flags:x.flags ~ocamlc_flags:x.ocamlc_flags