From 9140969aff20bcb9e6145ebce64b5ea08f565ab3 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Thu, 17 Dec 2020 16:08:37 -0800 Subject: [PATCH] Use module information for native_archives Signed-off-by: Rudi Grinberg --- src/dune_rules/compilation_context.ml | 4 +- src/dune_rules/compilation_context.mli | 4 - src/dune_rules/dir_contents.ml | 2 +- src/dune_rules/dune_file.ml | 40 +++- src/dune_rules/dune_package.ml | 17 +- src/dune_rules/dune_package.mli | 2 - src/dune_rules/findlib/findlib.ml | 15 +- src/dune_rules/install_rules.ml | 23 +- src/dune_rules/lib.ml | 30 ++- src/dune_rules/lib.mli | 1 + src/dune_rules/lib_info.ml | 67 ++++-- src/dune_rules/lib_info.mli | 24 ++- src/dune_rules/lib_rules.ml | 32 ++- src/dune_rules/modules.ml | 29 +++ src/dune_rules/modules.mli | 5 + src/dune_rules/scope.ml | 33 +-- src/dune_rules/scope.mli | 1 + src/dune_rules/super_context.ml | 42 ++-- src/dune_rules/super_context.mli | 4 + .../test-cases/github3766.t/run.t | 204 ++++++++---------- .../test-cases/github3766.t/test.ml | 3 +- 21 files changed, 348 insertions(+), 234 deletions(-) diff --git a/src/dune_rules/compilation_context.ml b/src/dune_rules/compilation_context.ml index 161d10eb5ab..69358e5e2a2 100644 --- a/src/dune_rules/compilation_context.ml +++ b/src/dune_rules/compilation_context.ml @@ -3,8 +3,6 @@ open! Stdune open Import module SC = Super_context -let modules_of_lib = Fdecl.create Dyn.Encoder.opaque - module Includes = struct type t = Command.Args.dynamic Command.Args.t Cm_kind.Dict.t @@ -234,5 +232,5 @@ let without_bin_annot t = { t with bin_annot = false } let root_module_entries t : Module_name.t list Or_exn.t = let open Result.O in let* requires = t.requires_compile in - let local_lib = Fdecl.get modules_of_lib t.super_context in + let local_lib = Fdecl.get Super_context.modules_of_lib t.super_context in Result.List.concat_map requires ~f:(Lib.entry_module_names ~local_lib) diff --git a/src/dune_rules/compilation_context.mli b/src/dune_rules/compilation_context.mli index 6128d6ce03b..8ea2e8c1026 100644 --- a/src/dune_rules/compilation_context.mli +++ b/src/dune_rules/compilation_context.mli @@ -21,10 +21,6 @@ type opaque = | Inherit_from_settings (** Determined from the version of OCaml and the profile *) -val modules_of_lib : - (* to avoid a cycle with [Dir_contents] *) - (Super_context.t -> dir:Path.Build.t -> name:Lib_name.t -> Modules.t) Fdecl.t - (** Create a compilation context. *) val create : super_context:Super_context.t diff --git a/src/dune_rules/dir_contents.ml b/src/dune_rules/dir_contents.ml index ae004d8ab43..91bf66046b5 100644 --- a/src/dune_rules/dir_contents.ml +++ b/src/dune_rules/dir_contents.ml @@ -341,7 +341,7 @@ end = struct let ml_sources = ocaml t in Ml_sources.modules ml_sources ~for_:(Library name) in - Fdecl.set Compilation_context.modules_of_lib f + Fdecl.set Super_context.modules_of_lib f let gen_rules sctx ~dir = match Memo.exec memo0 (sctx, dir) with diff --git a/src/dune_rules/dune_file.ml b/src/dune_rules/dune_file.ml index 52afd195d57..be094d663c9 100644 --- a/src/dune_rules/dune_file.ml +++ b/src/dune_rules/dune_file.ml @@ -771,8 +771,9 @@ module Library = struct List.map (foreign_archives t) ~f:(fun archive -> Foreign.Archive.dll_file ~archive ~dir ~ext_dll) - let archive t ~dir ~ext = - Path.Build.relative dir (Lib_name.Local.to_string (snd t.name) ^ ext) + let archive_basename t ~ext = Lib_name.Local.to_string (snd t.name) ^ ext + + let archive t ~dir ~ext = Path.Build.relative dir (archive_basename t ~ext) let best_name t = match t.visibility with @@ -834,10 +835,27 @@ module Library = struct let virtual_library = is_virtual conf in let foreign_archives = foreign_lib_files conf ~dir ~ext_lib in let native_archives = - if modes.native then - [ archive ext_lib ] + let archive = archive ext_lib in + if virtual_library || not modes.native then + Lib_info.Files [] + else if Option.is_some conf.implements then + Lib_info.Files [ archive ] + else if + Lib_config.linker_can_create_empty_archives lib_config + && Ocaml_version.ocamlopt_always_calls_library_linker + lib_config.ocaml_version + then + Lib_info.Files [ archive ] + else if + match conf.wrapped with + | This (Simple false) + | From _ -> + true + | _ -> false + then + Lib_info.Needs_module_info archive else - [] + Lib_info.Files [ archive ] in let foreign_dll_files = foreign_dll_files conf ~dir ~ext_dll in let exit_module = Option.bind conf.stdlib ~f:(fun x -> x.exit_module) in @@ -916,12 +934,12 @@ module Library = struct let special_builtin_support = conf.special_builtin_support in let instrumentation_backend = conf.instrumentation_backend in let entry_modules = Lib_info.Source.Local in - Lib_info.create ~loc ~name ~kind ~status ~src_dir ~orig_src_dir ~obj_dir - ~version ~synopsis ~main_module_name ~sub_systems ~requires - ~foreign_objects ~plugins ~archives ~ppx_runtime_deps ~foreign_archives - ~native_archives ~foreign_dll_files ~jsoo_runtime ~jsoo_archive - ~preprocess ~enabled ~virtual_deps ~dune_version ~virtual_ ~entry_modules - ~implements ~default_implementation ~modes ~wrapped + Lib_info.create ~loc ~path_kind:Local ~name ~kind ~status ~src_dir + ~orig_src_dir ~obj_dir ~version ~synopsis ~main_module_name ~sub_systems + ~requires ~foreign_objects ~plugins ~archives ~ppx_runtime_deps + ~foreign_archives ~native_archives ~foreign_dll_files ~jsoo_runtime + ~jsoo_archive ~preprocess ~enabled ~virtual_deps ~dune_version ~virtual_ + ~entry_modules ~implements ~default_implementation ~modes ~wrapped ~special_builtin_support ~exit_module ~instrumentation_backend end diff --git a/src/dune_rules/dune_package.ml b/src/dune_rules/dune_package.ml index e346d2ff357..3442063055f 100644 --- a/src/dune_rules/dune_package.ml +++ b/src/dune_rules/dune_package.ml @@ -66,6 +66,12 @@ module Lib = struct let jsoo_runtime = Lib_info.jsoo_runtime info in let virtual_ = Option.is_some (Lib_info.virtual_ info) in let instrumentation_backend = Lib_info.instrumentation_backend info in + let native_archives = + match Lib_info.native_archives info with + | Lib_info.Files f -> f + | Needs_module_info _ -> + Code_error.raise "caller must set native archives to known value" [] + in record_fields @@ [ field "name" Lib_name.encode name ; field "kind" Lib_kind.encode kind @@ -76,7 +82,7 @@ module Lib = struct ; mode_paths "plugins" plugins ; paths "foreign_objects" foreign_objects ; paths "foreign_archives" (Lib_info.foreign_archives info) - ; paths "native_archives" (Lib_info.native_archives info) + ; paths "native_archives" native_archives ; paths "jsoo_runtime" jsoo_runtime ; Lib_dep.L.field_encode requires ~name:"requires" ; libs "ppx_runtime_deps" ppx_runtime_deps @@ -186,10 +192,11 @@ module Lib = struct Some (Lib_info.Inherited.This (Modules.wrapped modules)) in let entry_modules = Lib_info.Source.External (Ok entry_modules) in - Lib_info.create ~loc ~name ~kind ~status ~src_dir ~orig_src_dir - ~obj_dir ~version ~synopsis ~main_module_name ~sub_systems ~requires - ~foreign_objects ~plugins ~archives ~ppx_runtime_deps - ~foreign_archives ~native_archives ~foreign_dll_files:[] + Lib_info.create ~path_kind:External ~loc ~name ~kind ~status ~src_dir + ~orig_src_dir ~obj_dir ~version ~synopsis ~main_module_name + ~sub_systems ~requires ~foreign_objects ~plugins ~archives + ~ppx_runtime_deps ~foreign_archives + ~native_archives:(Files native_archives) ~foreign_dll_files:[] ~jsoo_runtime ~jsoo_archive ~preprocess ~enabled ~virtual_deps ~dune_version ~virtual_ ~entry_modules ~implements ~default_implementation ~modes ~wrapped ~special_builtin_support diff --git a/src/dune_rules/dune_package.mli b/src/dune_rules/dune_package.mli index 85b1e26d962..78eec40dbbc 100644 --- a/src/dune_rules/dune_package.mli +++ b/src/dune_rules/dune_package.mli @@ -78,8 +78,6 @@ module Or_meta : sig | Use_meta | Dune_package of t - val encode : dune_version:Dune_lang.Syntax.Version.t -> t -> Dune_lang.t list - val pp : dune_version:Dune_lang.Syntax.Version.t -> Format.formatter -> t -> unit diff --git a/src/dune_rules/findlib/findlib.ml b/src/dune_rules/findlib/findlib.ml index fe08dfe03ee..4ff10877fcf 100644 --- a/src/dune_rules/findlib/findlib.ml +++ b/src/dune_rules/findlib/findlib.ml @@ -410,13 +410,14 @@ end = struct | Ok s -> Ok (Some s) | Error e -> Error (User_error.E e) )) ) ) in - Lib_info.create ~loc ~name:t.name ~kind ~status ~src_dir ~orig_src_dir - ~obj_dir ~version ~synopsis ~main_module_name ~sub_systems ~requires - ~foreign_objects ~plugins ~archives ~ppx_runtime_deps - ~foreign_archives ~native_archives ~foreign_dll_files:[] ~jsoo_runtime - ~jsoo_archive ~preprocess ~enabled ~virtual_deps ~dune_version - ~virtual_ ~implements ~default_implementation ~modes ~wrapped - ~special_builtin_support ~exit_module:None + Lib_info.create ~path_kind:External ~loc ~name:t.name ~kind ~status + ~src_dir ~orig_src_dir ~obj_dir ~version ~synopsis ~main_module_name + ~sub_systems ~requires ~foreign_objects ~plugins ~archives + ~ppx_runtime_deps ~foreign_archives + ~native_archives:(Files native_archives) ~foreign_dll_files:[] + ~jsoo_runtime ~jsoo_archive ~preprocess ~enabled ~virtual_deps + ~dune_version ~virtual_ ~implements ~default_implementation ~modes + ~wrapped ~special_builtin_support ~exit_module:None ~instrumentation_backend:None ~entry_modules in Dune_package.Lib.of_findlib info diff --git a/src/dune_rules/install_rules.ml b/src/dune_rules/install_rules.ml index b3f104ee10e..fa5dca039ed 100644 --- a/src/dune_rules/install_rules.ml +++ b/src/dune_rules/install_rules.ml @@ -53,11 +53,10 @@ end = struct else [] - let lib_files ~modes ~dir_contents ~dir ~lib_config lib = + let lib_files ~dir_contents ~dir ~lib_config lib = let virtual_library = Option.is_some (Lib_info.virtual_ lib) in let { Lib_config.ext_obj; _ } = lib_config in let archives = Lib_info.archives lib in - let { Mode.Dict.byte = _; native } = modes in List.concat [ archives.byte ; archives.native @@ -68,18 +67,12 @@ end = struct Foreign.Sources.object_files files ~dir ~ext_obj else Lib_info.foreign_archives lib ) - ; if_ - (native && not virtual_library) - ((* TODO remove the if check once Lib_info.native_archives always - returns the correct value for libs without modules *) - let modules = - Dir_contents.ocaml dir_contents - |> Ml_sources.modules ~for_:(Library (Lib_info.name lib)) - in - if Lib_info.has_native_archive lib_config modules then - Lib_info.native_archives lib - else - []) + ; (let modules = + Dir_contents.ocaml dir_contents + |> Ml_sources.modules ~for_:(Library (Lib_info.name lib)) + |> Option.some + in + Lib_info.eval_native_archives_exn lib ~modules) ; Lib_info.jsoo_runtime lib ; (Lib_info.plugins lib).native ] @@ -183,7 +176,7 @@ end = struct other_cm_files) in let lib_files, dll_files = - let lib_files = lib_files ~modes ~dir ~dir_contents ~lib_config info in + let lib_files = lib_files ~dir ~dir_contents ~lib_config info in let dll_files = dll_files ~modes ~dynlink:lib.dynlink ~ctx info in (lib_files, dll_files) in diff --git a/src/dune_rules/lib.ml b/src/dune_rules/lib.ml index 091f5857677..62a3fd48671 100644 --- a/src/dune_rules/lib.ml +++ b/src/dune_rules/lib.ml @@ -256,6 +256,7 @@ module T = struct {[ This kind of expression is not allowed as right-hand side of `let rec' }] *) mutable sub_systems : Sub_system0.Instance.t Lazy.t Sub_system_name.Map.t + ; modules : Modules.t Lazy.t option } let compare (x : t) (y : t) = Id.compare x.unique_id y.unique_id @@ -323,6 +324,7 @@ type db = ; all : Lib_name.t list Lazy.t ; lib_config : Lib_config.t ; instrument_with : Lib_name.t list + ; modules_of_lib : (dir:Path.Build.t -> name:Lib_name.t -> Modules.t) Fdecl.t ; projects_by_package : Dune_project.t Package.Name.Map.t } @@ -407,7 +409,7 @@ module Link_params = struct not appear on the command line *) } - let get t (mode : Link_mode.t) = + let get (t : lib) (mode : Link_mode.t) = let lib_files = Lib_info.foreign_archives t.info and dll_files = Lib_info.foreign_dll_files t.info in (* OCaml library archives [*.cma] and [*.cmxa] are directly listed in the @@ -420,7 +422,12 @@ module Link_params = struct match mode with | Byte -> dll_files | Byte_with_stubs_statically_linked_in -> lib_files - | Native -> List.rev_append (Lib_info.native_archives t.info) lib_files + | Native -> + let native_archives = + let modules = Option.map t.modules ~f:Lazy.force in + Lib_info.eval_native_archives_exn t.info ~modules + in + List.rev_append native_archives lib_files in let include_dirs = let files = @@ -1143,6 +1150,11 @@ end = struct let* package = Lib_info.package info in Package.Name.Map.find db.projects_by_package package in + let modules = + match Path.as_in_build_dir (Lib_info.src_dir info) with + | None -> None + | Some dir -> Some (lazy (Fdecl.get db.modules_of_lib ~dir ~name)) + in let t = { info ; name @@ -1158,6 +1170,7 @@ end = struct ; lib_config = db.lib_config ; re_exports ; project + ; modules } in t.sub_systems <- @@ -1727,7 +1740,8 @@ module DB = struct (* CR-soon amokhov: this whole module should be rewritten using the memoization framework instead of using mutable state. *) - let create ~parent ~resolve ~projects_by_package ~all ~lib_config () = + let create ~parent ~resolve ~projects_by_package ~all ~modules_of_lib + ~lib_config () = { parent ; resolve ; table = Table.create (module Lib_name) 1024 @@ -1735,10 +1749,19 @@ module DB = struct ; lib_config ; instrument_with = lib_config.Lib_config.instrument_with ; projects_by_package + ; modules_of_lib } let create_from_findlib ~lib_config ~projects_by_package findlib = create () ~parent:None ~lib_config ~projects_by_package + ~modules_of_lib: + (let t = Fdecl.create Dyn.Encoder.opaque in + Fdecl.set t (fun ~dir ~name -> + Code_error.raise "external libraries need no modules" + [ ("dir", Path.Build.to_dyn dir) + ; ("name", Lib_name.to_dyn name) + ]); + t) ~resolve:(fun name -> match Findlib.find findlib name with | Ok (Library pkg) -> Found (Dune_package.Lib.info pkg) @@ -1950,6 +1973,7 @@ let to_dune_lib ({ info; _ } as lib) ~modules ~foreign_objects ~dir = let info = Lib_info.for_dune_package info ~name ~ppx_runtime_deps ~requires ~foreign_objects ~obj_dir ~implements ~default_implementation ~sub_systems + ~modules in Dune_package.Lib.of_dune_lib ~info ~modules ~main_module_name diff --git a/src/dune_rules/lib.mli b/src/dune_rules/lib.mli index 7d13a942a2b..f87a955ff1a 100644 --- a/src/dune_rules/lib.mli +++ b/src/dune_rules/lib.mli @@ -186,6 +186,7 @@ module DB : sig -> resolve:(Lib_name.t -> Resolve_result.t) -> projects_by_package:Dune_project.t Package.Name.Map.t -> all:(unit -> Lib_name.t list) + -> modules_of_lib:(dir:Path.Build.t -> name:Lib_name.t -> Modules.t) Fdecl.t -> lib_config:Lib_config.t -> unit -> t diff --git a/src/dune_rules/lib_info.ml b/src/dune_rules/lib_info.ml index a244aaa6a3d..66a048ebf4c 100644 --- a/src/dune_rules/lib_info.ml +++ b/src/dune_rules/lib_info.ml @@ -19,6 +19,10 @@ module Main_module_name = struct let to_dyn x = Inherited.to_dyn (Dyn.Encoder.option Module_name.to_dyn) x end +type _ path = + | Local : Path.Build.t path + | External : Path.t path + module Special_builtin_support = struct let api_version_field supported_api_versions = let open Dune_lang.Decoder in @@ -241,6 +245,16 @@ module Enabled_status = struct constr "Disabled_because_of_enabled_if" [] end +type 'path native_archives = + | Needs_module_info of 'path + | Files of 'path list + +let dyn_of_native_archives path = + let open Dyn.Encoder in + function + | Needs_module_info f -> constr "Needs_module_info" [ path f ] + | Files files -> constr "Files" [ (list path) files ] + (** {1 Lib_info_invariants} Many of the fields here are optional and are "entangled" in the sense that @@ -262,7 +276,7 @@ type 'path t = ; plugins : 'path list Mode.Dict.t ; foreign_objects : 'path list Source.t ; foreign_archives : 'path list - ; native_archives : 'path list + ; native_archives : 'path native_archives ; foreign_dll_files : 'path list ; jsoo_runtime : 'path list ; jsoo_archive : 'path option @@ -283,6 +297,7 @@ type 'path t = ; special_builtin_support : Special_builtin_support.t option ; exit_module : Module_name.t option ; instrumentation_backend : (Loc.t * Lib_name.t) option + ; path_kind : 'path path } let name t = t.name @@ -353,8 +368,19 @@ let best_src_dir t = Option.value ~default:t.src_dir t.orig_src_dir let set_version t version = { t with version } +let eval_native_archives_exn (type path) (t : path t) ~modules = + match (t.native_archives, modules) with + | Files f, _ -> f + | Needs_module_info _, None -> + Code_error.raise "missing module information" [] + | Needs_module_info f, Some modules -> + if Modules.is_unwrapped modules && Modules.has_impl modules then + [ f ] + else + [] + let for_dune_package t ~name ~ppx_runtime_deps ~requires ~foreign_objects - ~obj_dir ~implements ~default_implementation ~sub_systems = + ~obj_dir ~implements ~default_implementation ~sub_systems ~modules = let foreign_objects = Source.External foreign_objects in let orig_src_dir = match !Clflags.store_orig_src_dir with @@ -370,6 +396,9 @@ let for_dune_package t ~name ~ppx_runtime_deps ~requires ~foreign_objects Path.source src_dir |> Path.to_absolute_filename |> Path.of_string ) ) in + let native_archives = + Files (eval_native_archives_exn t ~modules:(Some modules)) + in { t with ppx_runtime_deps ; name @@ -380,15 +409,16 @@ let for_dune_package t ~name ~ppx_runtime_deps ~requires ~foreign_objects ; default_implementation ; sub_systems ; orig_src_dir + ; native_archives } let user_written_deps t = List.fold_left (t.virtual_deps @ t.ppx_runtime_deps) ~init:t.requires ~f:(fun acc s -> Lib_dep.Direct s :: acc) -let create ~loc ~name ~kind ~status ~src_dir ~orig_src_dir ~obj_dir ~version - ~synopsis ~main_module_name ~sub_systems ~requires ~foreign_objects ~plugins - ~archives ~ppx_runtime_deps ~foreign_archives ~native_archives +let create ~loc ~path_kind ~name ~kind ~status ~src_dir ~orig_src_dir ~obj_dir + ~version ~synopsis ~main_module_name ~sub_systems ~requires ~foreign_objects + ~plugins ~archives ~ppx_runtime_deps ~foreign_archives ~native_archives ~foreign_dll_files ~jsoo_runtime ~jsoo_archive ~preprocess ~enabled ~virtual_deps ~dune_version ~virtual_ ~entry_modules ~implements ~default_implementation ~modes ~wrapped ~special_builtin_support @@ -427,16 +457,22 @@ let create ~loc ~name ~kind ~status ~src_dir ~orig_src_dir ~obj_dir ~version ; special_builtin_support ; exit_module ; instrumentation_backend + ; path_kind } type external_ = Path.t t type local = Path.Build.t t -let map t ~f_path ~f_obj_dir = +let map t ~path_kind ~f_path ~f_obj_dir = let f = f_path in let list = List.map ~f in let mode_list = Mode.Dict.map ~f:list in + let native_archives = + match t.native_archives with + | Needs_module_info t -> Needs_module_info (f t) + | Files t -> Files (List.map t ~f) + in { t with src_dir = f t.src_dir ; orig_src_dir = Option.map ~f t.orig_src_dir @@ -446,20 +482,24 @@ let map t ~f_path ~f_obj_dir = ; foreign_objects = Source.map ~f:(List.map ~f) t.foreign_objects ; foreign_archives = List.map ~f t.foreign_archives ; foreign_dll_files = List.map ~f t.foreign_dll_files - ; native_archives = List.map ~f t.native_archives + ; native_archives ; jsoo_runtime = List.map ~f t.jsoo_runtime ; jsoo_archive = Option.map ~f t.jsoo_archive + ; path_kind } -let map_path t ~f = map t ~f_path:f ~f_obj_dir:Fun.id +let map_path t ~f = map t ~path_kind:External ~f_path:f ~f_obj_dir:Fun.id -let of_local = map ~f_path:Path.build ~f_obj_dir:Obj_dir.of_local +let of_local = + map ~path_kind:External ~f_path:Path.build ~f_obj_dir:Obj_dir.of_local let as_local_exn = - map ~f_path:Path.as_in_build_dir_exn ~f_obj_dir:Obj_dir.as_local_exn + map ~path_kind:Local ~f_path:Path.as_in_build_dir_exn + ~f_obj_dir:Obj_dir.as_local_exn let to_dyn path { loc + ; path_kind = _ ; name ; kind ; status @@ -510,7 +550,7 @@ let to_dyn path ; ("plugins", Mode.Dict.to_dyn (list path) plugins) ; ("foreign_objects", Source.to_dyn (list path) foreign_objects) ; ("foreign_archives", list path foreign_archives) - ; ("native_archives", list path native_archives) + ; ("native_archives", dyn_of_native_archives path native_archives) ; ("foreign_dll_files", list path foreign_dll_files) ; ("jsoo_runtime", list path jsoo_runtime) ; ("jsoo_archive", option path jsoo_archive) @@ -544,9 +584,4 @@ let package t = | Public (_, p) -> Some (Package.name p) | Private (_, p) -> Option.map p ~f:Package.name -let has_native_archive lib_config modules = - Lib_config.linker_can_create_empty_archives lib_config - && Ocaml_version.ocamlopt_always_calls_library_linker lib_config.ocaml_version - || not (Modules.is_empty modules) - let entry_modules t = t.entry_modules diff --git a/src/dune_rules/lib_info.mli b/src/dune_rules/lib_info.mli index defdadb28ed..5ed584997f1 100644 --- a/src/dune_rules/lib_info.mli +++ b/src/dune_rules/lib_info.mli @@ -96,8 +96,16 @@ val archives : 'path t -> 'path list Mode.Dict.t (** All the [lib*.a] files for stubs *) val foreign_archives : 'path t -> 'path list +type 'path native_archives = + | Needs_module_info of 'path + | Files of 'path list + (** The [lib*.a] files for the OCaml code when compiling to native mode *) -val native_archives : 'path t -> 'path list +val native_archives : 'path t -> 'path native_archives + +(** [eval_native_archives] is like [native_archives] but it knows how to + evaluate [Needs_module_info] into the list of archives *) +val eval_native_archives_exn : 'path t -> modules:Modules.t option -> 'path list (** [dll*.so] files for stubs. These are read when linking a bytecode executable and are loaded dynamically at runtime by bytecode executables. *) @@ -186,12 +194,18 @@ val for_dune_package : -> implements:(Loc.t * Lib_name.t) option -> default_implementation:(Loc.t * Lib_name.t) option -> sub_systems:Sub_system_info.t Sub_system_name.Map.t + -> modules:Modules.t -> Path.t t -val map_path : 'a t -> f:('a -> 'a) -> 'a t +val map_path : Path.t t -> f:(Path.t -> Path.t) -> Path.t t + +type 'a path = + | Local : Path.Build.t path + | External : Path.t path val create : loc:Loc.t + -> path_kind:'a path -> name:Lib_name.t -> kind:Lib_kind.t -> status:Status.t @@ -208,7 +222,7 @@ val create : -> archives:'a list Mode.Dict.t -> ppx_runtime_deps:(Loc.t * Lib_name.t) list -> foreign_archives:'a list - -> native_archives:'a list + -> native_archives:'a native_archives -> foreign_dll_files:'a list -> jsoo_runtime:'a list -> jsoo_archive:'a option @@ -230,7 +244,3 @@ val create : val package : _ t -> Package.Name.t option val to_dyn : 'path Dyn.Encoder.t -> 'path t Dyn.Encoder.t - -(* XXX Temporary nastiness. [native_archives] returns an in incorrect result so - we need this for now *) -val has_native_archive : Lib_config.t -> Modules.t -> bool diff --git a/src/dune_rules/lib_rules.ml b/src/dune_rules/lib_rules.ml index 998ce79d21e..fb0a4923777 100644 --- a/src/dune_rules/lib_rules.ml +++ b/src/dune_rules/lib_rules.ml @@ -16,10 +16,9 @@ let msvc_hack_cclibs = Option.value ~default:lib (String.drop_prefix ~prefix:"-l" lib)) (* Build an OCaml library. *) -let build_lib (lib : Library.t) ~sctx ~modules ~expander ~flags ~dir ~mode - ~cm_files = +let build_lib (lib : Library.t) ~native_archives ~sctx ~expander ~flags ~dir + ~mode ~cm_files = let ctx = Super_context.context sctx in - let { Lib_config.ext_lib; _ } = ctx.lib_config in Result.iter (Context.compiler ctx mode) ~f:(fun compiler -> let target = Library.archive lib ~dir ~ext:(Mode.compiled_lib_ext mode) in let stubs_flags = @@ -76,11 +75,7 @@ let build_lib (lib : Library.t) ~sctx ~modules ~expander ~flags ~dir ~mode ; Hidden_targets ( match mode with | Byte -> [] - | Native -> - if Lib_info.has_native_archive ctx.lib_config modules then - [ Library.archive lib ~dir ~ext:ext_lib ] - else - [] ) + | Native -> native_archives ) ])) let gen_wrapped_compat_modules (lib : Library.t) cctx = @@ -229,7 +224,7 @@ let build_stubs lib ~cctx ~dir ~expander ~requires ~dir_contents ocamlmklib ~archive_name ~loc:lib.buildable.loc ~sctx ~expander ~dir ~o_files ~c_library_flags:lib.c_library_flags ~build_targets_together -let build_shared lib ~modules ~sctx ~dir ~flags = +let build_shared lib ~native_archives ~sctx ~dir ~flags = let ctx = Super_context.context sctx in Result.iter ctx.ocamlopt ~f:(fun ocamlopt -> let ext_lib = ctx.lib_config.ext_lib in @@ -266,12 +261,9 @@ let build_shared lib ~modules ~sctx ~dir ~flags = ] in let build = - if Lib_info.has_native_archive ctx.lib_config modules then - Build.with_no_targets - (Build.path (Path.build (Library.archive lib ~dir ~ext:ext_lib))) - >>> build - else - build + Build.with_no_targets + (Build.paths (List.map ~f:Path.build native_archives)) + >>> build in Super_context.add_rule sctx build ~dir) @@ -315,11 +307,17 @@ let setup_build_archives (lib : Dune_file.Library.t) ~cctx [Obj_dir]. That's fragile and will break if the layout of the object directory changes *) let dir = Obj_dir.dir obj_dir in + let native_archives = + let lib_config = ctx.lib_config in + let lib_info = Library.to_lib_info lib ~dir ~lib_config in + Lib_info.eval_native_archives_exn lib_info ~modules:(Some modules) + in (let cm_files = Cm_files.make ~obj_dir ~ext_obj ~modules ~top_sorted_modules in Mode.Dict.Set.iter modes ~f:(fun mode -> - build_lib lib ~dir ~modules ~sctx ~expander ~flags ~mode ~cm_files)); + build_lib lib ~native_archives ~dir ~sctx ~expander ~flags ~mode + ~cm_files)); (* Build *.cma.js *) if modes.byte then Super_context.add_rules sctx ~dir @@ -332,7 +330,7 @@ let setup_build_archives (lib : Dune_file.Library.t) ~cctx in Jsoo_rules.build_cm cctx ~js_of_ocaml ~src ~target); if Dynlink_supported.By_the_os.get natdynlink_supported && modes.native then - build_shared ~modules ~sctx lib ~dir ~flags + build_shared ~native_archives ~sctx lib ~dir ~flags let cctx (lib : Library.t) ~sctx ~source_modules ~dir ~expander ~scope ~compile_info = diff --git a/src/dune_rules/modules.ml b/src/dune_rules/modules.ml index b22cd4186d3..d3236d628de 100644 --- a/src/dune_rules/modules.ml +++ b/src/dune_rules/modules.ml @@ -69,6 +69,8 @@ module Stdlib = struct let* name = t.exit_module in Module_name.Map.find t.modules name + let exists t ~f = Module_name.Map.exists t.modules ~f + let fold t ~init ~f = Module_name.Map.fold t.modules ~f ~init let map t ~f = { t with modules = Module_name.Map.map t.modules ~f } @@ -328,6 +330,17 @@ module Wrapped = struct let init = Module_name.Map.fold modules ~f ~init in Module_name.Map.fold wrapped_compat ~f ~init + let exists + { modules + ; wrapped_compat + ; alias_module + ; main_module_name = _ + ; wrapped = _ + } ~f = + f alias_module + || Module_name.Map.exists modules ~f + || Module_name.Map.exists wrapped_compat ~f + let lib_interface t = Module_name.Map.find t.modules t.main_module_name let find t name = @@ -577,6 +590,18 @@ let rec impl_only = function | Wrapped w -> Wrapped.impl_only w | Impl { vlib; impl } -> impl_only impl @ impl_only vlib +let rec exists t ~f = + match t with + | Stdlib w -> Stdlib.exists w ~f + | Wrapped m -> Wrapped.exists m ~f + | Singleton m -> f m + | Unwrapped m -> Module_name.Map.exists m ~f + | Impl { vlib; impl } -> exists vlib ~f || exists impl ~f + +let has_impl = + let has = Module.has ~ml_kind:Impl in + exists ~f:has + let rec fold_no_vlib t ~init ~f = match t with | Stdlib w -> Stdlib.fold w ~init ~f @@ -766,6 +791,10 @@ let is_empty = function | Unwrapped w -> Module_name.Map.is_empty w | Wrapped w -> Wrapped.empty w +let is_unwrapped = function + | Unwrapped _ -> true + | _ -> false + let as_singleton = function | Singleton m -> Some m | _ -> None diff --git a/src/dune_rules/modules.mli b/src/dune_rules/modules.mli index 547633683bf..ee097fc716a 100644 --- a/src/dune_rules/modules.mli +++ b/src/dune_rules/modules.mli @@ -100,6 +100,11 @@ val relocate_alias_module : t -> src_dir:Path.t -> t val is_empty : t -> bool +val is_unwrapped : t -> bool + val as_singleton : t -> Module.t option val source_dirs : t -> Path.Set.t + +(** [has_impl t] is true if there's at least one implementation in [t]*) +val has_impl : t -> bool diff --git a/src/dune_rules/scope.ml b/src/dune_rules/scope.ml index 4afd4ea5df9..457e92723b0 100644 --- a/src/dune_rules/scope.ml +++ b/src/dune_rules/scope.ml @@ -52,7 +52,7 @@ module DB = struct | Deprecated_library_name of Dune_file.Deprecated_library_name.t end - let create_db_from_stanzas ~parent ~lib_config stanzas = + let create_db_from_stanzas ~parent ~lib_config ~modules_of_lib stanzas = let map : Found_or_redirect.t Lib_name.Map.t = List.concat_map stanzas ~f:(fun stanza -> match (stanza : Library_related_stanza.t) with @@ -102,7 +102,7 @@ module DB = struct | Some (Redirect lib) -> Lib.DB.Resolve_result.redirect None lib | Some (Found lib) -> Lib.DB.Resolve_result.found lib) ~all:(fun () -> Lib_name.Map.keys map) - ~lib_config + ~modules_of_lib ~lib_config (* This function is linear in the depth of [dir] in the worst case, so if it shows up in the profile we should memoize it. *) @@ -135,7 +135,8 @@ module DB = struct | Some (Name name) -> Lib.DB.Resolve_result.redirect None name (* Create a database from the public libraries defined in the stanzas *) - let public_libs t ~installed_libs ~lib_config ~projects_by_package stanzas = + let public_libs t ~installed_libs ~modules_of_lib ~lib_config + ~projects_by_package stanzas = let public_libs = List.filter_map stanzas ~f:(fun (stanza : Library_related_stanza.t) -> match stanza with @@ -175,12 +176,13 @@ module DB = struct ] ) in let resolve = resolve t public_libs in - Lib.DB.create ~parent:(Some installed_libs) ~resolve ~projects_by_package + Lib.DB.create ~parent:(Some installed_libs) ~resolve ~modules_of_lib + ~projects_by_package ~all:(fun () -> Lib_name.Map.keys public_libs) ~lib_config () - let scopes_by_dir context ~projects_by_package ~projects ~public_libs stanzas - coq_stanzas = + let scopes_by_dir context ~projects_by_package ~modules_of_lib ~projects + ~public_libs stanzas coq_stanzas = let projects_by_dir = List.map projects ~f:(fun (project : Dune_project.t) -> (Dune_project.root project, project)) @@ -216,7 +218,7 @@ module DB = struct let project = Option.value_exn project in let stanzas, coq_stanzas = Option.value stanzas ~default:([], []) in let db = - create_db_from_stanzas stanzas ~parent:public_libs + create_db_from_stanzas stanzas ~parent:public_libs ~modules_of_lib ~projects_by_package ~lib_config in let coq_db = Coq_lib.DB.create_from_coqlib_stanzas coq_stanzas in @@ -225,16 +227,17 @@ module DB = struct in Some { project; db; coq_db; root }) - let create ~projects_by_package ~context ~installed_libs ~projects stanzas - coq_stanzas = + let create ~projects_by_package ~context ~installed_libs ~modules_of_lib + ~projects stanzas coq_stanzas = let t = Fdecl.create Dyn.Encoder.opaque in let public_libs = let lib_config = Context.lib_config context in - public_libs t ~installed_libs ~lib_config ~projects_by_package stanzas + public_libs t ~installed_libs ~lib_config ~projects_by_package + ~modules_of_lib stanzas in let by_dir = - scopes_by_dir context ~projects ~projects_by_package ~public_libs stanzas - coq_stanzas + scopes_by_dir context ~projects ~projects_by_package ~public_libs + ~modules_of_lib stanzas coq_stanzas in let value = { by_dir } in Fdecl.set t value; @@ -247,7 +250,7 @@ module DB = struct find_by_dir t (Path.Build.drop_build_context_exn dir) let create_from_stanzas ~projects ~projects_by_package ~context - ~installed_libs stanzas = + ~installed_libs ~modules_of_lib stanzas = let stanzas, coq_stanzas = Dune_load.Dune_file.fold_stanzas stanzas ~init:([], []) ~f:(fun dune_file stanza (acc, coq_acc) -> @@ -267,6 +270,6 @@ module DB = struct (acc, (ctx_dir, coq_lib) :: coq_acc) | _ -> (acc, coq_acc)) in - create ~projects ~context ~installed_libs ~projects_by_package stanzas - coq_stanzas + create ~projects ~context ~installed_libs ~modules_of_lib + ~projects_by_package stanzas coq_stanzas end diff --git a/src/dune_rules/scope.mli b/src/dune_rules/scope.mli index a077d7d4b4e..7302986efe1 100644 --- a/src/dune_rules/scope.mli +++ b/src/dune_rules/scope.mli @@ -28,6 +28,7 @@ module DB : sig -> projects_by_package:Dune_project.t Package.Name.Map.t -> context:Context.t -> installed_libs:Lib.DB.t + -> modules_of_lib:(dir:Path.Build.t -> name:Lib_name.t -> Modules.t) Fdecl.t -> Dune_load.Dune_file.t list -> t * Lib.DB.t diff --git a/src/dune_rules/super_context.ml b/src/dune_rules/super_context.ml index 334c5aac5a3..9236722c353 100644 --- a/src/dune_rules/super_context.ml +++ b/src/dune_rules/super_context.ml @@ -502,15 +502,18 @@ let create_projects_by_package projects : Dune_project.t Package.Name.Map.t = (name, project))) |> Package.Name.Map.of_list_exn +let modules_of_lib = Fdecl.create Dyn.Encoder.opaque + let create ~(context : Context.t) ?host ~projects ~packages ~stanzas () = let lib_config = Context.lib_config context in let projects_by_package = create_projects_by_package projects in let installed_libs = Lib.DB.create_from_findlib context.findlib ~lib_config ~projects_by_package in + let modules_of_lib_for_scope = Fdecl.create Dyn.Encoder.opaque in let scopes, public_libs = Scope.DB.create_from_stanzas ~projects ~projects_by_package ~context - ~installed_libs stanzas + ~installed_libs ~modules_of_lib:modules_of_lib_for_scope stanzas in let stanzas = List.map stanzas ~f:(fun { Dune_load.Dune_file.dir; project; stanzas } -> @@ -649,22 +652,27 @@ let create ~(context : Context.t) ?host ~projects ~packages ~stanzas () = let lib_entries_by_package = create_lib_entries_by_package ~public_libs stanzas in - { context - ; root_expander - ; host - ; scopes - ; public_libs - ; installed_libs - ; stanzas - ; stanzas_per_dir - ; packages - ; artifacts - ; lib_entries_by_package - ; env_tree - ; default_env - ; dir_status_db - ; projects_by_key - } + let t = + { context + ; root_expander + ; host + ; scopes + ; public_libs + ; installed_libs + ; stanzas + ; stanzas_per_dir + ; packages + ; artifacts + ; lib_entries_by_package + ; env_tree + ; default_env + ; dir_status_db + ; projects_by_key + } + in + Fdecl.set modules_of_lib_for_scope (fun ~dir ~name -> + Fdecl.get modules_of_lib t ~dir ~name); + t let dir_status_db t = t.dir_status_db diff --git a/src/dune_rules/super_context.mli b/src/dune_rules/super_context.mli index 85caea0ec65..46d5cc29df7 100644 --- a/src/dune_rules/super_context.mli +++ b/src/dune_rules/super_context.mli @@ -9,6 +9,10 @@ open Import type t +val modules_of_lib : + (* to avoid a cycle with [Dir_contents] *) + (t -> dir:Path.Build.t -> name:Lib_name.t -> Modules.t) Fdecl.t + val to_dyn : t -> Dyn.t val create : diff --git a/test/blackbox-tests/test-cases/github3766.t/run.t b/test/blackbox-tests/test-cases/github3766.t/run.t index d5da4e3a4ce..b1ffcf7ead7 100644 --- a/test/blackbox-tests/test-cases/github3766.t/run.t +++ b/test/blackbox-tests/test-cases/github3766.t/run.t @@ -18,8 +18,16 @@ Our test checks each of the above with an internal and external library. -> creating dune -> creating stub.c -> creating foo.mli + % cat dune + + (library + (public_name foo) + (wrapped true) + (foreign_stubs (language c) (names stub)) + (modules ())) % dune build --root . @install % ls _build/install/default/lib/foo/*.a + _build/install/default/lib/foo/foo.a _build/install/default/lib/foo/libfoo_stubs.a # create a dummy executable to test @@ -28,21 +36,12 @@ Our test checks each of the above with an internal and external library. # make sure that this library is usable locally % dune exec ./exe/b.exe - File "exe/dune", line 3, characters 7-8: - 3 | (name b) - ^ - Error: No rule found for lib/foo.a - [1] + exe working # make sure that this library is usable externally % rm -rf lib % OCAMLPATH=_build/install/default/lib dune exec --build-dir=_b2 ./exe/b.exe - File "exe/dune", line 3, characters 7-8: - 3 | (name b) - ^ - Error: File unavailable: - $TESTCASE_ROOT/mli_only_wrapped_stubs/_build/install/default/lib/foo/foo.a - [1] + exe working # mli_only_wrapped_no_stubs @@ -50,10 +49,16 @@ Our test checks each of the above with an internal and external library. # build the library and see if .a is present -> creating dune -> creating foo.mli + % cat dune + + (library + (public_name foo) + (wrapped true) + + (modules ())) % dune build --root . @install % ls _build/install/default/lib/foo/*.a - ls: _build/install/default/lib/foo/*.a: No such file or directory - [1] + _build/install/default/lib/foo/foo.a # create a dummy executable to test -> creating dune @@ -61,21 +66,12 @@ Our test checks each of the above with an internal and external library. # make sure that this library is usable locally % dune exec ./exe/b.exe - File "exe/dune", line 3, characters 7-8: - 3 | (name b) - ^ - Error: No rule found for lib/foo.a - [1] + exe working # make sure that this library is usable externally % rm -rf lib % OCAMLPATH=_build/install/default/lib dune exec --build-dir=_b2 ./exe/b.exe - File "exe/dune", line 3, characters 7-8: - 3 | (name b) - ^ - Error: File unavailable: - $TESTCASE_ROOT/mli_only_wrapped_no_stubs/_build/install/default/lib/foo/foo.a - [1] + exe working # mli_only_unwrapped_stubs @@ -84,6 +80,13 @@ Our test checks each of the above with an internal and external library. -> creating dune -> creating stub.c -> creating foo.mli + % cat dune + + (library + (public_name foo) + (wrapped false) + (foreign_stubs (language c) (names stub)) + (modules ())) % dune build --root . @install % ls _build/install/default/lib/foo/*.a _build/install/default/lib/foo/libfoo_stubs.a @@ -94,21 +97,12 @@ Our test checks each of the above with an internal and external library. # make sure that this library is usable locally % dune exec ./exe/b.exe - File "exe/dune", line 3, characters 7-8: - 3 | (name b) - ^ - Error: No rule found for lib/foo.a - [1] + exe working # make sure that this library is usable externally % rm -rf lib % OCAMLPATH=_build/install/default/lib dune exec --build-dir=_b2 ./exe/b.exe - File "exe/dune", line 3, characters 7-8: - 3 | (name b) - ^ - Error: File unavailable: - $TESTCASE_ROOT/mli_only_unwrapped_stubs/_build/install/default/lib/foo/foo.a - [1] + exe working # mli_only_unwrapped_no_stubs @@ -116,6 +110,13 @@ Our test checks each of the above with an internal and external library. # build the library and see if .a is present -> creating dune -> creating foo.mli + % cat dune + + (library + (public_name foo) + (wrapped false) + + (modules ())) % dune build --root . @install % ls _build/install/default/lib/foo/*.a ls: _build/install/default/lib/foo/*.a: No such file or directory @@ -127,21 +128,12 @@ Our test checks each of the above with an internal and external library. # make sure that this library is usable locally % dune exec ./exe/b.exe - File "exe/dune", line 3, characters 7-8: - 3 | (name b) - ^ - Error: No rule found for lib/foo.a - [1] + exe working # make sure that this library is usable externally % rm -rf lib % OCAMLPATH=_build/install/default/lib dune exec --build-dir=_b2 ./exe/b.exe - File "exe/dune", line 3, characters 7-8: - 3 | (name b) - ^ - Error: File unavailable: - $TESTCASE_ROOT/mli_only_unwrapped_no_stubs/_build/install/default/lib/foo/foo.a - [1] + exe working # no_mli_wrapped_stubs @@ -149,8 +141,16 @@ Our test checks each of the above with an internal and external library. # build the library and see if .a is present -> creating dune -> creating stub.c + % cat dune + + (library + (public_name foo) + (wrapped true) + (foreign_stubs (language c) (names stub)) + (modules ())) % dune build --root . @install % ls _build/install/default/lib/foo/*.a + _build/install/default/lib/foo/foo.a _build/install/default/lib/foo/libfoo_stubs.a # create a dummy executable to test @@ -159,31 +159,28 @@ Our test checks each of the above with an internal and external library. # make sure that this library is usable locally % dune exec ./exe/b.exe - File "exe/dune", line 3, characters 7-8: - 3 | (name b) - ^ - Error: No rule found for lib/foo.a - [1] + exe working # make sure that this library is usable externally % rm -rf lib % OCAMLPATH=_build/install/default/lib dune exec --build-dir=_b2 ./exe/b.exe - File "exe/dune", line 3, characters 7-8: - 3 | (name b) - ^ - Error: File unavailable: - $TESTCASE_ROOT/no_mli_wrapped_stubs/_build/install/default/lib/foo/foo.a - [1] + exe working # no_mli_wrapped_no_stubs -> creating dune-project # build the library and see if .a is present -> creating dune + % cat dune + + (library + (public_name foo) + (wrapped true) + + (modules ())) % dune build --root . @install % ls _build/install/default/lib/foo/*.a - ls: _build/install/default/lib/foo/*.a: No such file or directory - [1] + _build/install/default/lib/foo/foo.a # create a dummy executable to test -> creating dune @@ -191,21 +188,12 @@ Our test checks each of the above with an internal and external library. # make sure that this library is usable locally % dune exec ./exe/b.exe - File "exe/dune", line 3, characters 7-8: - 3 | (name b) - ^ - Error: No rule found for lib/foo.a - [1] + exe working # make sure that this library is usable externally % rm -rf lib % OCAMLPATH=_build/install/default/lib dune exec --build-dir=_b2 ./exe/b.exe - File "exe/dune", line 3, characters 7-8: - 3 | (name b) - ^ - Error: File unavailable: - $TESTCASE_ROOT/no_mli_wrapped_no_stubs/_build/install/default/lib/foo/foo.a - [1] + exe working # no_mli_unwrapped_stubs @@ -213,6 +201,13 @@ Our test checks each of the above with an internal and external library. # build the library and see if .a is present -> creating dune -> creating stub.c + % cat dune + + (library + (public_name foo) + (wrapped false) + (foreign_stubs (language c) (names stub)) + (modules ())) % dune build --root . @install % ls _build/install/default/lib/foo/*.a _build/install/default/lib/foo/libfoo_stubs.a @@ -223,27 +218,25 @@ Our test checks each of the above with an internal and external library. # make sure that this library is usable locally % dune exec ./exe/b.exe - File "exe/dune", line 3, characters 7-8: - 3 | (name b) - ^ - Error: No rule found for lib/foo.a - [1] + exe working # make sure that this library is usable externally % rm -rf lib % OCAMLPATH=_build/install/default/lib dune exec --build-dir=_b2 ./exe/b.exe - File "exe/dune", line 3, characters 7-8: - 3 | (name b) - ^ - Error: File unavailable: - $TESTCASE_ROOT/no_mli_unwrapped_stubs/_build/install/default/lib/foo/foo.a - [1] + exe working # no_mli_unwrapped_no_stubs -> creating dune-project # build the library and see if .a is present -> creating dune + % cat dune + + (library + (public_name foo) + (wrapped false) + + (modules ())) % dune build --root . @install % ls _build/install/default/lib/foo/*.a ls: _build/install/default/lib/foo/*.a: No such file or directory @@ -255,36 +248,27 @@ Our test checks each of the above with an internal and external library. # make sure that this library is usable locally % dune exec ./exe/b.exe - File "exe/dune", line 3, characters 7-8: - 3 | (name b) - ^ - Error: No rule found for lib/foo.a - [1] + exe working # make sure that this library is usable externally % rm -rf lib % OCAMLPATH=_build/install/default/lib dune exec --build-dir=_b2 ./exe/b.exe - File "exe/dune", line 3, characters 7-8: - 3 | (name b) - ^ - Error: File unavailable: - $TESTCASE_ROOT/no_mli_unwrapped_no_stubs/_build/install/default/lib/foo/foo.a - [1] - - - mli_only_wrapped_stubs - external - fail - mli_only_wrapped_stubs - internal - fail - mli_only_wrapped_no_stubs - external - fail - mli_only_wrapped_no_stubs - internal - fail - mli_only_unwrapped_stubs - external - fail - mli_only_unwrapped_stubs - internal - fail - mli_only_unwrapped_no_stubs - external - fail - mli_only_unwrapped_no_stubs - internal - fail - no_mli_wrapped_stubs - external - fail - no_mli_wrapped_stubs - internal - fail - no_mli_wrapped_no_stubs - external - fail - no_mli_wrapped_no_stubs - internal - fail - no_mli_unwrapped_stubs - external - fail - no_mli_unwrapped_stubs - internal - fail - no_mli_unwrapped_no_stubs - external - fail - no_mli_unwrapped_no_stubs - internal - fail + exe working + + + mli_only_wrapped_stubs - external - pass + mli_only_wrapped_stubs - internal - pass + mli_only_wrapped_no_stubs - external - pass + mli_only_wrapped_no_stubs - internal - pass + mli_only_unwrapped_stubs - external - pass + mli_only_unwrapped_stubs - internal - pass + mli_only_unwrapped_no_stubs - external - pass + mli_only_unwrapped_no_stubs - internal - pass + no_mli_wrapped_stubs - external - pass + no_mli_wrapped_stubs - internal - pass + no_mli_wrapped_no_stubs - external - pass + no_mli_wrapped_no_stubs - internal - pass + no_mli_unwrapped_stubs - external - pass + no_mli_unwrapped_stubs - internal - pass + no_mli_unwrapped_no_stubs - external - pass + no_mli_unwrapped_no_stubs - internal - pass diff --git a/test/blackbox-tests/test-cases/github3766.t/test.ml b/test/blackbox-tests/test-cases/github3766.t/test.ml index 662148fa3f2..79cf76c0836 100644 --- a/test/blackbox-tests/test-cases/github3766.t/test.ml +++ b/test/blackbox-tests/test-cases/github3766.t/test.ml @@ -121,7 +121,8 @@ module Spec = struct |} t.wrapped stubs); if t.stubs then file "stub.c" "void foo() {}"; - if t.mli_only then file "foo.mli" "type x = unit"); + if t.mli_only then file "foo.mli" "type x = unit"; + cmd "cat dune"); cmd "dune build --root . @install"; cmd "ls _build/install/default/lib/foo/*.a");