Make opaque information available to compilation context

Subsequently, use it as a flag when calculating rules and includes Signed-off-by: Rudi Grinberg <rudi.grinberg@gmail.com>
ocaml · Aug 1, 2018 · 4ad8f57 · 4ad8f57
1 parent a03d9de
commit 4ad8f57
Show file tree

Hide file tree

Showing 16 changed files with 63 additions and 37 deletions.
diff --git a/src/compilation_context.ml b/src/compilation_context.ml
@@ -5,7 +5,7 @@ module SC = Super_context
 module Includes = struct
   type t = string list Arg_spec.t Cm_kind.Dict.t
 
-  let make sctx ~requires : _ Cm_kind.Dict.t =
+  let make sctx ~opaque ~requires : _ Cm_kind.Dict.t =
     match requires with
     | Error exn -> Cm_kind.Dict.make_all (Arg_spec.Dyn (fun _ -> raise exn))
     | Ok libs ->
@@ -18,15 +18,18 @@ module Includes = struct
                        (SC.Libs.file_deps sctx libs ~ext:".cmi")
                    ]
       in
-      let cmi_and_cmx_includes =
-        Arg_spec.S [ iflags
-                   ; Hidden_deps
-                       (SC.Libs.file_deps sctx libs ~ext:".cmi-and-.cmx")
-                   ]
+      let cmx_includes =
+        if opaque then
+          cmi_includes
+        else
+          Arg_spec.S [ iflags
+                    ; Hidden_deps
+                        (SC.Libs.file_deps sctx libs ~ext:".cmi-and-.cmx")
+                    ]
       in
       { cmi = cmi_includes
       ; cmo = cmi_includes
-      ; cmx = cmi_and_cmx_includes
+      ; cmx = cmx_includes
       }
 
   let empty =
@@ -47,6 +50,7 @@ type t =
   ; includes             : Includes.t
   ; preprocessing        : Preprocessing.t
   ; no_keep_locs         : bool
+  ; opaque               : bool
   }
 
 let super_context        t = t.super_context
@@ -62,12 +66,14 @@ let requires             t = t.requires
 let includes             t = t.includes
 let preprocessing        t = t.preprocessing
 let no_keep_locs         t = t.no_keep_locs
+let opaque               t = t.opaque
 
 let context              t = Super_context.context t.super_context
 
 let create ~super_context ~scope ~dir ?(dir_kind=File_tree.Dune_file.Kind.Dune)
       ?(obj_dir=dir) ~modules ?alias_module ?lib_interface_module ~flags
-      ~requires ?(preprocessing=Preprocessing.dummy) ?(no_keep_locs=false) () =
+      ~requires ?(preprocessing=Preprocessing.dummy) ?(no_keep_locs=false)
+      ~opaque () =
   { super_context
   ; scope
   ; dir
@@ -78,9 +84,10 @@ let create ~super_context ~scope ~dir ?(dir_kind=File_tree.Dune_file.Kind.Dune)
   ; lib_interface_module
   ; flags
   ; requires
-  ; includes = Includes.make super_context ~requires
+  ; includes = Includes.make super_context ~requires ~opaque
   ; preprocessing
   ; no_keep_locs
+  ; opaque
   }
 
 let for_alias_module t =

diff --git a/src/compilation_context.mli b/src/compilation_context.mli
@@ -25,6 +25,7 @@ val create
   -> requires              : Lib.t list Or_exn.t
   -> ?preprocessing        : Preprocessing.t
   -> ?no_keep_locs         : bool
+  -> opaque                : bool
   -> unit
   -> t
 
@@ -45,3 +46,4 @@ val requires             : t -> Lib.t list Or_exn.t
 val includes             : t -> string list Arg_spec.t Cm_kind.Dict.t
 val preprocessing        : t -> Preprocessing.t
 val no_keep_locs         : t -> bool
+val opaque               : t -> bool
diff --git a/src/gen_rules.ml b/src/gen_rules.ml
@@ -203,6 +203,7 @@ module Gen(P : Install_rules.Params) = struct
         ~requires
         ~preprocessing:pp
         ~no_keep_locs:lib.no_keep_locs
+        ~opaque:(Lib.Compile.opaque compile_info)
     in
 
     let dep_graphs = Ocamldep.rules cctx in
@@ -509,6 +510,7 @@ module Gen(P : Install_rules.Params) = struct
         ~flags
         ~requires
         ~preprocessing:pp
+        ~opaque:(Lib.Compile.opaque compile_info)
     in
 
     Exe.build_and_link_many cctx
@@ -532,6 +534,7 @@ module Gen(P : Install_rules.Params) = struct
         exes.buildable.libraries
         ~pps:(Jbuild.Preprocess_map.pps exes.buildable.preprocess)
         ~allow_overlaps:exes.buildable.allow_overlapping_dependencies
+        ~opaque:(ctx.profile = "dev")
     in
     SC.Libs.gen_select_rules sctx compile_info ~dir;
     SC.Libs.with_lib_deps sctx compile_info ~dir

diff --git a/src/inline_tests.ml b/src/inline_tests.ml
@@ -233,6 +233,7 @@ include Sub_system.Register_end_point(
           ~scope
           ~dir:inline_test_dir
           ~modules
+          ~opaque:true
           ~requires:runner_libs
           ~flags:(Ocaml_flags.of_list ["-w"; "-24"]);
       in

diff --git a/src/lib.ml b/src/lib.ml
@@ -63,6 +63,7 @@ module Info = struct
     ; pps              : (Loc.t * Jbuild.Pp.t) list
     ; optional         : bool
     ; virtual_deps     : (Loc.t * string) list
+    ; opaque           : bool
     ; dune_version : Syntax.Version.t option
     ; sub_systems      : Jbuild.Sub_system_info.t Sub_system_name.Map.t
     }
@@ -72,7 +73,7 @@ module Info = struct
       ~init:(Deps.to_lib_deps t.requires)
       ~f:(fun acc s -> Jbuild.Lib_dep.Direct s :: acc)
 
-  let of_library_stanza ~dir (conf : Jbuild.Library.t) =
+  let of_library_stanza ~dir ~opaque (conf : Jbuild.Library.t) =
     let archive_file ext = Path.relative dir (conf.name ^ ext) in
     let archive_files ~f_ext =
       Mode.Dict.of_func (fun ~mode -> [archive_file (f_ext mode)])
@@ -116,6 +117,7 @@ module Info = struct
     ; pps = Jbuild.Preprocess_map.pps conf.buildable.preprocess
     ; sub_systems = conf.sub_systems
     ; dune_version = Some conf.dune_version
+    ; opaque
     }
 
   let of_findlib_package pkg =
@@ -142,6 +144,7 @@ module Info = struct
     ; virtual_deps     = []
     ; optional         = false
     ; status           = Installed
+    ; opaque           = false
     ; (* We don't know how these are named for external libraries *)
       foreign_archives = Mode.Dict.make_both []
     ; sub_systems      = sub_systems
@@ -909,6 +912,7 @@ module Compile = struct
     ; pps               : t list Or_exn.t
     ; resolved_selects  : Resolved_select.t list
     ; optional          : bool
+    ; opaque            : bool
     ; user_written_deps : Jbuild.Lib_deps.t
     ; sub_systems       : Sub_system0.Instance.t Lazy.t Sub_system_name.Map.t
     }
@@ -921,6 +925,7 @@ module Compile = struct
     ; optional          = t.info.optional
     ; user_written_deps = t.user_written_deps
     ; sub_systems       = t.sub_systems
+    ; opaque            = t.info.opaque
     }
 
   let direct_requires   t = t.direct_requires
@@ -929,6 +934,7 @@ module Compile = struct
   let pps               t = t.pps
   let optional          t = t.optional
   let user_written_deps t = t.user_written_deps
+  let opaque            t = t.opaque
   let sub_systems t =
     Sub_system_name.Map.values t.sub_systems
     |> List.map ~f:(fun (lazy (Sub_system0.Instance.T ((module M), t))) ->
@@ -957,10 +963,10 @@ module DB = struct
     ; all    = Lazy.from_fun all
     }
 
-  let create_from_library_stanzas ?parent stanzas =
+  let create_from_library_stanzas ?parent ~opaque stanzas =
     let map =
       List.concat_map stanzas ~f:(fun (dir, (conf : Jbuild.Library.t)) ->
-        let info = Info.of_library_stanza ~dir conf in
+        let info = Info.of_library_stanza ~dir ~opaque conf in
         match conf.public with
         | None ->
           [(conf.name, Resolve_result.Found info)]
@@ -1055,7 +1061,7 @@ module DB = struct
       let t = Option.some_if (not allow_overlaps) t in
       Compile.for_lib t lib
 
-  let resolve_user_written_deps t ?(allow_overlaps=false) deps ~pps =
+  let resolve_user_written_deps t ?(allow_overlaps=false) ~opaque deps ~pps =
     let res, pps, resolved_selects =
       resolve_user_deps t (Info.Deps.of_lib_deps deps) ~pps
         ~stack:Dep_stack.empty ~allow_private_deps:true
@@ -1073,6 +1079,7 @@ module DB = struct
     ; optional          = false
     ; user_written_deps = deps
     ; sub_systems       = Sub_system_name.Map.empty
+    ; opaque
     }
 
   let resolve_pps t pps =

diff --git a/src/lib.mli b/src/lib.mli
@@ -105,11 +105,12 @@ module Info : sig
     ; pps              : (Loc.t * Jbuild.Pp.t) list
     ; optional         : bool
     ; virtual_deps     : (Loc.t * string) list
+    ; opaque           : bool
     ; dune_version : Syntax.Version.t option
     ; sub_systems      : Jbuild.Sub_system_info.t Sub_system_name.Map.t
     }
 
-  val of_library_stanza : dir:Path.t -> Jbuild.Library.t -> t
+  val of_library_stanza : dir:Path.t -> opaque:bool -> Jbuild.Library.t -> t
   val of_findlib_package : Findlib.Package.t -> t
 end
 
@@ -218,6 +219,8 @@ module Compile : sig
   val optional          : t -> bool
   val user_written_deps : t -> Jbuild.Lib_deps.t
 
+  val opaque : t -> bool
+
   (** Sub-systems used in this compilation context *)
   val sub_systems : t -> sub_system list
 end
@@ -257,6 +260,7 @@ module DB : sig
   (** Create a database from a list of library stanzas *)
   val create_from_library_stanzas
     :  ?parent:t
+    -> opaque:bool
     -> (Path.t * Jbuild.Library.t) list
     -> t
 
@@ -289,6 +293,7 @@ module DB : sig
   val resolve_user_written_deps
     :  t
     -> ?allow_overlaps:bool
+    -> opaque:bool
     -> Jbuild.Lib_dep.t list
     -> pps:(Loc.t * Jbuild.Pp.t) list
     -> Compile.t

diff --git a/src/module_compilation.ml b/src/module_compilation.ml
@@ -58,7 +58,7 @@ let build_cm cctx ?sandbox ?(dynlink=true) ~dep_graphs ~cm_kind (m : Module.t) =
         | Cmi | Cmo -> other_targets
       in
       let dep_graph = Ml_kind.Dict.get dep_graphs ml_kind in
-      let opaque = ctx.version >= (4, 03, 0) in
+      let opaque = CC.opaque cctx && ctx.version >= (4, 03, 0) in
       let other_cm_files =
         Build.dyn_paths
           (Ocamldep.Dep_graph.deps_of dep_graph m >>^ fun deps ->
@@ -111,10 +111,7 @@ let build_cm cctx ?sandbox ?(dynlink=true) ~dep_graphs ~cm_kind (m : Module.t) =
            ; no_keep_locs
            ; cmt_args
            ; A "-I"; Path obj_dir
-           ; (if opaque then
-                Cm_kind.Dict.get (CC.includes cctx) Cmi
-              else
-                Cm_kind.Dict.get (CC.includes cctx) cm_kind)
+           ; Cm_kind.Dict.get (CC.includes cctx) cm_kind
            ; As extra_args
            ; if dynlink || cm_kind <> Cmx then As [] else A "-nodynlink"
            ; A "-no-alias-deps"; opaque_arg

diff --git a/src/scope.ml b/src/scope.ml
@@ -50,7 +50,7 @@ module DB = struct
             (Project_name_map.keys t.by_name)
         ]
 
-  let create ~projects ~context ~installed_libs internal_libs =
+  let create ~projects ~context ~opaque ~installed_libs internal_libs =
     let projects_by_name =
       List.map projects ~f:(fun (project : Dune_project.t) ->
         (project.name, project))
@@ -119,7 +119,7 @@ module DB = struct
           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.DB.create_from_library_stanzas libs ~parent:public_libs ~opaque
           in
           let root = Path.append_local build_context_dir project.root in
           Some { project; db; root })

diff --git a/src/scope.mli b/src/scope.mli
@@ -24,6 +24,7 @@ module DB : sig
   val create
     :  projects:Dune_project.t list
     -> context:string
+    -> opaque:bool
     -> installed_libs:Lib.DB.t
     -> (Path.t * Jbuild.Library.t) list
     -> t * Lib.DB.t

diff --git a/src/super_context.ml b/src/super_context.ml
@@ -506,9 +506,11 @@ let create
         | Library lib -> Some (ctx_dir, lib)
         | _ -> None))
   in
+  let opaque = context.profile = "dev" in
   let scopes, public_libs =
     Scope.DB.create
       ~projects
+      ~opaque
       ~context:context.name
       ~installed_libs
       internal_libs

diff --git a/src/utop.ml b/src/utop.ml
@@ -73,6 +73,7 @@ let setup sctx ~dir ~(libs : Library.t list) ~scope =
         ~scope
         ~dir:utop_exe_dir
         ~modules
+        ~opaque:true
         ~requires
         ~flags:(Ocaml_flags.append_common
                   (Ocaml_flags.default ~profile:(Super_context.profile sctx))

diff --git a/test/blackbox-tests/test-cases/intf-only/run.t b/test/blackbox-tests/test-cases/intf-only/run.t
@@ -10,14 +10,14 @@ Successes:
         ocamlc .foo.objs/foo__Intf.{cmi,cmti}
         ocamlc .foo.objs/foo.{cmi,cmo,cmt}
         ocamlc test/.bar.objs/bar.{cmi,cmo,cmt}
-        ocamlc test/bar.cma
-      ocamlopt .foo.objs/foo.{cmx,o}
       ocamlopt test/.bar.objs/bar.{cmx,o}
       ocamlopt test/bar.{a,cmxa}
       ocamlopt test/bar.cmxs
-        ocamlc foo.cma
+      ocamlopt .foo.objs/foo.{cmx,o}
       ocamlopt foo.{a,cmxa}
       ocamlopt foo.cmxs
+        ocamlc foo.cma
+        ocamlc test/bar.cma
 
 Errors:
 

diff --git a/test/blackbox-tests/test-cases/menhir/run.t b/test/blackbox-tests/test-cases/menhir/run.t
@@ -12,12 +12,12 @@
       ocamldep src/.test.eobjs/test_menhir1.mli.d
         ocamlc src/.test.eobjs/test_menhir1.{cmi,cmti}
         ocamlc src/.test.eobjs/lexer1.{cmi,cmo,cmt}
+      ocamlopt src/.test.eobjs/lexer1.{cmx,o}
         ocamlc src/.test.eobjs/test_base.{cmi,cmti}
         ocamlc src/.test.eobjs/lexer2.{cmi,cmo,cmt}
-        ocamlc src/.test.eobjs/test.{cmi,cmo,cmt}
+      ocamlopt src/.test.eobjs/lexer2.{cmx,o}
       ocamlopt src/.test.eobjs/test_menhir1.{cmx,o}
-      ocamlopt src/.test.eobjs/lexer1.{cmx,o}
       ocamlopt src/.test.eobjs/test_base.{cmx,o}
-      ocamlopt src/.test.eobjs/lexer2.{cmx,o}
+        ocamlc src/.test.eobjs/test.{cmi,cmo,cmt}
       ocamlopt src/.test.eobjs/test.{cmx,o}
       ocamlopt src/test.exe
diff --git a/test/blackbox-tests/test-cases/package-dep/run.t b/test/blackbox-tests/test-cases/package-dep/run.t
@@ -3,11 +3,11 @@
       ocamldep .foo.objs/foo.ml.d
         ocamlc .foo.objs/foo.{cmi,cmo,cmt}
         ocamlc .bar.objs/bar.{cmi,cmo,cmt}
-        ocamlc bar.cma
-      ocamlopt .foo.objs/foo.{cmx,o}
       ocamlopt .bar.objs/bar.{cmx,o}
       ocamlopt bar.{a,cmxa}
       ocamlopt bar.cmxs
+        ocamlc bar.cma
+      ocamlopt .foo.objs/foo.{cmx,o}
       ocamlopt foo.{a,cmxa}
       ocamlopt foo.cmxs
         ocamlc foo.cma

diff --git a/test/blackbox-tests/test-cases/reporting-of-cycles/run.t b/test/blackbox-tests/test-cases/reporting-of-cycles/run.t
@@ -6,9 +6,9 @@ the second run of dune.
 
   $ dune build @package-cycle
   Dependency cycle between the following files:
-      _build/.aliases/default/.a-files-00000000000000000000000000000000
-  --> _build/.aliases/default/.b-files-00000000000000000000000000000000
+      _build/.aliases/default/.b-files-00000000000000000000000000000000
   --> _build/.aliases/default/.a-files-00000000000000000000000000000000
+  --> _build/.aliases/default/.b-files-00000000000000000000000000000000
   [1]
 
   $ dune build @simple-repro-case

diff --git a/test/blackbox-tests/test-cases/scope-bug/run.t b/test/blackbox-tests/test-cases/scope-bug/run.t
@@ -5,20 +5,20 @@
       ocamldep blib/sub/.sub.objs/sub.ml.d
         ocamlc blib/sub/.sub.objs/sub.{cmi,cmo,cmt}
         ocamlc blib/.blib.objs/blib.{cmi,cmo,cmt}
-        ocamlc blib/blib.cma
-        ocamlc alib/.alib.objs/alib__.{cmi,cmo,cmt}
-      ocamlopt alib/.alib.objs/alib__.{cmx,o}
-      ocamlopt blib/sub/.sub.objs/sub.{cmx,o}
       ocamlopt blib/.blib.objs/blib.{cmx,o}
       ocamlopt blib/blib.{a,cmxa}
       ocamlopt blib/blib.cmxs
+        ocamlc alib/.alib.objs/alib__.{cmi,cmo,cmt}
+      ocamlopt alib/.alib.objs/alib__.{cmx,o}
+      ocamlopt blib/sub/.sub.objs/sub.{cmx,o}
+      ocamlopt blib/sub/sub.{a,cmxa}
+      ocamlopt blib/sub/sub.cmxs
         ocamlc blib/sub/sub.cma
+        ocamlc blib/blib.cma
         ocamlc alib/.alib.objs/alib.{cmi,cmo,cmt}
       ocamlopt alib/.alib.objs/alib.{cmx,o}
         ocamlc alib/.alib.objs/alib__Main.{cmi,cmo,cmt}
       ocamlopt alib/.alib.objs/alib__Main.{cmx,o}
       ocamlopt alib/alib.{a,cmxa}
       ocamlopt alib/alib.cmxs
-      ocamlopt blib/sub/sub.{a,cmxa}
-      ocamlopt blib/sub/sub.cmxs
         ocamlc alib/alib.cma