diff --git a/src/dune_rules/cxx_flags.ml b/src/dune_rules/cxx_flags.ml index d4daffd73eaf..33c57d8e22d9 100644 --- a/src/dune_rules/cxx_flags.ml +++ b/src/dune_rules/cxx_flags.ml @@ -1,24 +1,25 @@ open Import -type phase = - | Compile - | Link - type ccomp_type = | Gcc | Msvc | Clang | Other of string -let base_cxx_flags ~for_ cc = - match cc, for_ with - | Gcc, Compile -> [ "-x"; "c++" ] - | Gcc, Link -> [ "-lstdc++"; "-shared-libgcc" ] - | Clang, Compile -> [ "-x"; "c++" ] - | Clang, Link -> [ "-lc++" ] - | Msvc, Compile -> [ "/TP" ] - | Msvc, Link -> [] - | Other _, (Link | Compile) -> [] +let base_cxx_compile_flags ocaml_config = function + | Gcc | Clang -> + "-x" + :: "c++" + :: (if Ocaml_config.version ocaml_config >= (5, 0, 0) then [ "-std=c++11" ] else []) + | Msvc -> [ "/TP" ] + | Other _ -> [] +;; + +let base_cxx_link_flags = function + | Gcc -> [ "-lstdc++"; "-shared-libgcc" ] + | Clang -> [ "-lc++" ] + | Msvc -> [] + | Other _ -> [] ;; let fdiagnostics_color = function @@ -59,8 +60,14 @@ let ccomp_type (ctx : Build_context.t) = ccomp_type ;; -let get_flags ~for_ ctx = +let get_compile_flags ocaml_version ctx = + let open Action_builder.O in + let+ ccomp_type = ccomp_type ctx in + base_cxx_compile_flags ocaml_version ccomp_type +;; + +let get_link_flags ctx = let open Action_builder.O in let+ ccomp_type = ccomp_type ctx in - base_cxx_flags ~for_ ccomp_type + base_cxx_link_flags ccomp_type ;; diff --git a/src/dune_rules/cxx_flags.mli b/src/dune_rules/cxx_flags.mli index eed02da3c9fb..e43bfefe6be0 100644 --- a/src/dune_rules/cxx_flags.mli +++ b/src/dune_rules/cxx_flags.mli @@ -3,10 +3,6 @@ open Import -type phase = - | Compile - | Link - (** The detected compiler *) type ccomp_type = | Gcc @@ -21,9 +17,13 @@ val preprocessed_filename : string (** [ccomp_type ctx] returns the C/C++ compiler type. *) val ccomp_type : Build_context.t -> ccomp_type Action_builder.t -(** [get_flags for_:phase ctx] returns the necessary flags to turn this compiler - into a c++ compiler for some of the most common compilers *) -val get_flags : for_:phase -> Build_context.t -> string list Action_builder.t +(** [get_compile_flags ctx] returns the necessary compile-time flags to turn + this compiler into a c++ compiler for some of the most common compilers *) +val get_compile_flags : Ocaml_config.t -> Build_context.t -> string list Action_builder.t + +(** [get_link_flags ctx] returns the necessary link-time flags to turn + this compiler into a c++ compiler for some of the most common compilers *) +val get_link_flags : Build_context.t -> string list Action_builder.t (** [fdiagnostics_color cc] returns the flags activating color diagnostics for the C/C++ compiler, if supported. *) diff --git a/src/dune_rules/foreign_rules.ml b/src/dune_rules/foreign_rules.ml index 86e9929558ef..bdb379b346f8 100644 --- a/src/dune_rules/foreign_rules.ml +++ b/src/dune_rules/foreign_rules.ml @@ -28,7 +28,7 @@ let default_context_flags (ctx : Build_context.t) ocaml_config ~project = in let cxx = let+ fdiagnostics_color = fdiagnostics_color - and+ db_flags = Cxx_flags.get_flags ~for_:Compile ctx in + and+ db_flags = Cxx_flags.get_compile_flags ocaml_config ctx in List.concat [ db_flags; cxxflags; fdiagnostics_color ] in c, cxx diff --git a/src/dune_rules/lib_rules.ml b/src/dune_rules/lib_rules.ml index 5db0c2b71545..a1bc0a3d581a 100644 --- a/src/dune_rules/lib_rules.ml +++ b/src/dune_rules/lib_rules.ml @@ -67,7 +67,7 @@ let build_lib let+ project = Dune_load.find_project ~dir in match Dune_project.use_standard_c_and_cxx_flags project with | Some true when Buildable.has_foreign_cxx lib.buildable -> - Cxx_flags.get_flags ~for_:Link (Context.build_context ctx) + Cxx_flags.get_link_flags (Context.build_context ctx) | _ -> Action_builder.return [] in let cclibs = Expander.expand_and_eval_set expander lib.c_library_flags ~standard in @@ -263,7 +263,7 @@ let foreign_rules (library : Foreign.Library.t) ~sctx ~expander ~dir ~dir_conten match Dune_project.use_standard_c_and_cxx_flags project with | Some true when Foreign.Sources.has_cxx_sources foreign_sources -> let ctx = Super_context.context sctx in - Cxx_flags.get_flags ~for_:Link (Context.build_context ctx) + Cxx_flags.get_link_flags (Context.build_context ctx) | _ -> Action_builder.return [] in let c_library_flags = @@ -317,7 +317,7 @@ let build_stubs lib ~cctx ~dir ~expander ~requires ~dir_contents ~vlib_stubs_o_f let+ project = Dune_load.find_project ~dir in match Dune_project.use_standard_c_and_cxx_flags project with | Some true when Foreign.Sources.has_cxx_sources foreign_sources -> - Cxx_flags.get_flags ~for_:Link (Context.build_context ctx) + Cxx_flags.get_link_flags (Context.build_context ctx) | _ -> Action_builder.return [] in let c_library_flags = diff --git a/src/dune_rules/ocaml_flags_db.ml b/src/dune_rules/ocaml_flags_db.ml index 071a6170794c..c64661d1e85c 100644 --- a/src/dune_rules/ocaml_flags_db.ml +++ b/src/dune_rules/ocaml_flags_db.ml @@ -47,7 +47,7 @@ let link_env = ~name:"link-env" ~root:(fun ctx _ -> let default_cxx_link_flags = - Cxx_flags.get_flags ~for_:Link (Build_context.create ~name:ctx) + Cxx_flags.get_link_flags (Build_context.create ~name:ctx) in Link_flags.default ~default_cxx_link_flags |> Memo.return) ~f:(fun ~parent expander (env : Dune_env.config) ->