diff --git a/changes/defer-dependency-value-copies.polish.md b/changes/defer-dependency-value-copies.polish.md
new file mode 100644
index 0000000000..411055da1a
--- /dev/null
+++ b/changes/defer-dependency-value-copies.polish.md
@@ -0,0 +1 @@
+- Build: copy the values of a dependency's interface only when a module reads them, after the first use of the same interface in a build, instead of copying all of them when the module first uses the dependency.
diff --git a/compiler/ml/env.ml b/compiler/ml/env.ml
index 3d01162f0f..7200990206 100644
--- a/compiler/ml/env.ml
+++ b/compiler/ml/env.ml
@@ -159,6 +159,31 @@ type summary =
   | Env_constraints of summary * type_declaration Path_map.t
   | Env_copy_types of summary * string list
 
+(* A value of a module that is built when it is first read. See
+   [components_of_module_maker]. *)
+module Comp_cell : sig
+  type 'a t
+
+  val ready : 'a -> 'a t
+  val pending : (unit -> 'a) -> 'a t
+  val force : 'a t -> 'a
+end = struct
+  type 'a t = {mutable state: 'a state}
+  and 'a state = Ready of 'a | Pending of (unit -> 'a)
+
+  let ready x = {state = Ready x}
+  let pending f = {state = Pending f}
+
+  (* If [f] raises, the cell stays pending and the exception is passed on. *)
+  let force c =
+    match c.state with
+    | Ready x -> x
+    | Pending f ->
+      let x = f () in
+      c.state <- Ready x;
+      x
+end
+
 module Tycomp_tbl = struct
   (** This module is used to store components of types (i.e. labels
         and constructors).  We keep a representation of each nested
@@ -248,37 +273,65 @@ module Id_tbl = struct
         (** Symbolic representation of the last (innermost) open, if any. *)
   }
 
-  and 'a opened = {
-    root: Path.t;
-        (** The path of the opened module, to be prefixed in front of
-          its local names to produce a valid path in the current
-          environment. *)
-    components: (string, 'a * int) Tbl.t;
-        (** Components from the opened module. *)
-    using: (string -> ('a * 'a) option -> unit) option;
-        (** A callback to be applied when a component is used from this
-          "open".  This is used to detect unused "opens".  The
-          arguments are used to detect shadowing. *)
-    next: 'a t;  (** The table before opening the module. *)
-  }
+  and 'a opened =
+    | Opened : {
+        root: Path.t;
+            (** The path of the opened module, to be prefixed in front of
+              its local names to produce a valid path in the current
+              environment. *)
+        components: (string, 'b * int) Tbl.t;
+            (** Components from the opened module. *)
+        force: 'b -> 'a;  (** Gives the binding a component stands for. *)
+        overrides: (string, 'a * int) Tbl.t;
+            (** Components replaced by [update], which take precedence over
+              [components]. *)
+        using: (string -> ('a * 'a) option -> unit) option;
+            (** A callback to be applied when a component is used from this
+              "open".  This is used to detect unused "opens".  The
+              arguments are used to detect shadowing. *)
+        next: 'a t;  (** The table before opening the module. *)
+      }
+        -> 'a opened
 
   let empty = {current = Ident.empty; opened = None}
 
   let add id x tbl = {tbl with current = Ident.add id x tbl.current}
 
-  let add_open slot wrap root components next =
+  let add_open slot wrap root ~force components next =
     let using =
       match slot with
       | None -> None
       | Some f -> Some (fun s x -> f s (wrap x))
     in
-    {current = Ident.empty; opened = Some {using; root; components; next}}
+    {
+      current = Ident.empty;
+      opened =
+        Some
+          (Opened {using; root; components; force; overrides = Tbl.empty; next});
+    }
+
+  (* The binding named [name] in an open, with its position. *)
+  let find_opened (type a) name (Opened o : a opened) : a * int =
+    match Tbl.find_str name o.overrides with
+    | found -> found
+    | exception Not_found ->
+      let desc, pos = Tbl.find_str name o.components in
+      (o.force desc, pos)
+
+  (* Every binding of an open, as [find_opened] gives it. *)
+  let fold_opened (type a) f (Opened o : a opened) acc =
+    Tbl.fold
+      (fun name (desc, pos) acc ->
+        match Tbl.find_str name o.overrides with
+        | found -> f name found acc
+        | exception Not_found -> f name (o.force desc, pos) acc)
+      o.components acc
 
   let rec find_same id tbl =
     try Ident.find_same id tbl.current
     with Not_found as exn -> (
       match tbl.opened with
-      | Some {next; _} -> find_same id next
+      | Some (Opened {next}) -> find_same id next
       | None -> raise exn)
 
   let rec find_name mark name tbl =
@@ -287,9 +340,9 @@ module Id_tbl = struct
       (Pident id, desc)
     with Not_found as exn -> (
       match tbl.opened with
-      | Some {using; root; next; components} -> (
+      | Some (Opened {using; root; next} as opened) -> (
         try
-          let descr, pos = Tbl.find_str name components in
+          let descr, pos = find_opened name opened in
           let res = (Pdot (root, name, pos), descr) in
           (if mark then
              match using with
@@ -310,15 +363,14 @@ module Id_tbl = struct
       {tbl with current = Ident.add id new_desc tbl.current}
     with Not_found -> (
       match tbl.opened with
-      | Some {root; using; next; components} -> (
-        try
-          let desc, pos = Tbl.find_str name components in
-          let new_desc = f desc in
-          let components = Tbl.add name (new_desc, pos) components in
-          {tbl with opened = Some {root; using; next; components}}
-        with Not_found ->
-          let next = update name f next in
-          {tbl with opened = Some {root; using; next; components}})
+      | Some (Opened o as opened) -> (
+        match find_opened name opened with
+        | desc, pos ->
+          let overrides = Tbl.add name (f desc, pos) o.overrides in
+          {tbl with opened = Some (Opened {o with overrides})}
+        | exception Not_found ->
+          let next = update name f o.next in
+          {tbl with opened = Some (Opened {o with next})})
       | None -> tbl)
 
   let rec find_all name tbl =
@@ -328,11 +380,10 @@ module Id_tbl = struct
     @
     match tbl.opened with
     | None -> []
-    | Some {root; using = _; next; components} -> (
-      try
-        let desc, pos = Tbl.find_str name components in
-        (Pdot (root, name, pos), desc) :: find_all name next
-      with Not_found -> find_all name next)
+    | Some (Opened {root; next} as opened) -> (
+      match find_opened name opened with
+      | desc, pos -> (Pdot (root, name, pos), desc) :: find_all name next
+      | exception Not_found -> find_all name next)
 
   let rec fold_name f tbl acc =
     let acc =
@@ -341,22 +392,23 @@ module Id_tbl = struct
         tbl.current acc
     in
     match tbl.opened with
-    | Some {root; using = _; next; components} ->
+    | Some (Opened {root; next} as opened) ->
       acc
-      |> Tbl.fold
-           (fun name (desc, pos) -> f name (Pdot (root, name, pos), desc))
-           components
+      |> fold_opened
+           (fun name (desc, pos) acc ->
+             f name (Pdot (root, name, pos), desc) acc)
+           opened
       |> fold_name f next
     | None -> acc
 
   let rec iter f tbl =
     Ident.iter (fun id desc -> f id (Pident id, desc)) tbl.current;
     match tbl.opened with
-    | Some {root; using = _; next; components} ->
-      Tbl.iter
-        (fun s (x, pos) ->
+    | Some (Opened {root; next} as opened) ->
+      fold_opened
+        (fun s (x, pos) () ->
           f (Ident.hide (Ident.create s) (* ??? *)) (Pdot (root, s, pos), x))
-        components;
+        opened ();
       iter f next
     | None -> ()
 end
@@ -385,10 +437,17 @@ type t = {
 and module_components = {
   deprecated: string option;
   loc: Location.t;
-  comps:
-    ( t * Subst.t * Path.t * Types.module_type,
-      module_components_repr option )
-    Env_lazy.t;
+  comps: (components_maker_arg, module_components_repr option) Env_lazy.t;
+}
+
+and components_maker_arg = {
+  maker_env: t;
+  maker_sub: Subst.t;
+  maker_path: Path.t;
+  maker_mty: Types.module_type;
+  maker_origin: Digest.t option;
+      (** The CRC of the .cmi whose signature [maker_mty] is part of, as read
+          from the file. [None] for any other module type. *)
 }
 
 and module_components_repr =
@@ -398,7 +457,7 @@ and module_components_repr =
 and 'a comp_tbl = (string, 'a * int) Tbl.t
 
 and structure_components = {
-  mutable comp_values: value_description comp_tbl;
+  mutable comp_values: value_description Comp_cell.t comp_tbl;
   mutable comp_constrs: (string, constructor_description list) Tbl.t;
   mutable comp_labels: (string, label_description list) Tbl.t;
   mutable comp_types: (type_declaration * type_descriptions) comp_tbl;
@@ -495,8 +554,9 @@ let without_cmis f x =
 
 let components_of_module' =
   ref
-    (fun ~deprecated:_ ~loc:_ _env _sub _path _mty -> assert false
-      : deprecated:string option ->
+    (fun ?origin:_ ~deprecated:_ ~loc:_ _env _sub _path _mty -> assert false
+      : ?origin:Digest.t ->
+        deprecated:string option ->
         loc:Location.t ->
         t ->
         Subst.t ->
@@ -505,8 +565,8 @@ let components_of_module' =
         module_components)
 let components_of_module_maker' =
   ref
-    (fun (_env, _sub, _path, _mty) -> assert false
-      : t * Subst.t * Path.t * module_type -> module_components_repr option)
+    (fun _ -> assert false
+      : components_maker_arg -> module_components_repr option)
 let components_of_functor_appl' =
   ref
     (fun _f _env _p1 _p2 -> assert false
@@ -750,7 +810,8 @@ let acknowledge_pers_struct check modname {Persistent_signature.filename; cmi} =
       None flags
   in
   let comps =
-    !components_of_module' ~deprecated ~loc:Location.none empty Subst.identity
+    !components_of_module' ?origin:(own_crc cmi) ~deprecated ~loc:Location.none
+      empty Subst.identity
       (Pident (Ident.create_persistent name))
       (Mty_signature sign)
   in
@@ -879,22 +940,25 @@ let rec find_module_descr path env =
     | Functor_comps f -> !components_of_functor_appl' f env p1 p2
     | Structure_comps _ -> raise Not_found)
 
-let find proj1 proj2 path env =
+let find proj1 proj2 force path env =
   match path with
   | Pident id -> Id_tbl.find_same id (proj1 env)
   | Pdot (p, s, _pos) -> (
     match get_components (find_module_descr p env) with
     | Structure_comps c ->
       let data, _pos = Tbl.find_str s (proj2 c) in
-      data
+      force data
     | Functor_comps _ -> raise Not_found)
   | Papply _ -> raise Not_found
 
-let find_value = find (fun env -> env.values) (fun sc -> sc.comp_values)
+let find_value =
+  find (fun env -> env.values) (fun sc -> sc.comp_values) Comp_cell.force
 
-and find_type_full = find (fun env -> env.types) (fun sc -> sc.comp_types)
+and find_type_full =
+  find (fun env -> env.types) (fun sc -> sc.comp_types) Fun.id
 
-and find_modtype = find (fun env -> env.modtypes) (fun sc -> sc.comp_modtypes)
+and find_modtype =
+  find (fun env -> env.modtypes) (fun sc -> sc.comp_modtypes) Fun.id
 
 let type_of_cstr path = function
   | {cstr_inlined = Some d; _} ->
@@ -1165,7 +1229,7 @@ and lookup_module ~load ?loc lid env : Path.t =
       p
     | Functor_comps _ -> raise Not_found)
 
-let lookup proj1 proj2 ?loc lid env =
+let lookup proj1 proj2 force ?loc lid env =
   match lid with
   | Lident s -> Id_tbl.find_name s (proj1 env)
   | Ldot (l, s) -> (
@@ -1173,7 +1237,7 @@ let lookup proj1 proj2 ?loc lid env =
     match get_components desc with
     | Structure_comps c ->
       let data, pos = Tbl.find_str s (proj2 c) in
-      (Pdot (p, s, pos), data)
+      (Pdot (p, s, pos), force data)
     | Functor_comps _ -> raise Not_found)
 
 let lookup_all_simple proj1 proj2 shadow ?loc lid env =
@@ -1204,7 +1268,8 @@ let cstr_shadow cstr1 cstr2 =
 
 let lbl_shadow _lbl1 _lbl2 = false
 
-let lookup_value = lookup (fun env -> env.values) (fun sc -> sc.comp_values)
+let lookup_value =
+  lookup (fun env -> env.values) (fun sc -> sc.comp_values) Comp_cell.force
 let lookup_all_constructors =
   lookup_all_simple
     (fun env -> env.constrs)
@@ -1215,9 +1280,9 @@ let lookup_all_labels =
     (fun env -> env.labels)
     (fun sc -> sc.comp_labels)
     lbl_shadow
-let lookup_type = lookup (fun env -> env.types) (fun sc -> sc.comp_types)
+let lookup_type = lookup (fun env -> env.types) (fun sc -> sc.comp_types) Fun.id
 let lookup_modtype =
-  lookup (fun env -> env.modtypes) (fun sc -> sc.comp_modtypes)
+  lookup (fun env -> env.modtypes) (fun sc -> sc.comp_modtypes) Fun.id
 
 let copy_types l env =
   let f desc =
@@ -1362,21 +1427,23 @@ let rec scrape_alias_for_visit env mty =
     with Not_found -> false)
   | _ -> true
 
-let iter_env proj1 proj2 f env () =
+let iter_env proj1 proj2 force f env () =
   Id_tbl.iter (fun id x -> f (Pident id) x) (proj1 env);
   let rec iter_components path path' mcomps =
     let cont () =
       let visit =
         match Env_lazy.get_arg mcomps.comps with
         | None -> true
-        | Some (env, _sub, _path, mty) -> scrape_alias_for_visit env mty
+        | Some {maker_env; maker_mty} ->
+          scrape_alias_for_visit maker_env maker_mty
       in
       if not visit then ()
       else
         match get_components mcomps with
         | Structure_comps comps ->
           Tbl.iter
-            (fun s (d, n) -> f (Pdot (path, s, n)) (Pdot (path', s, n), d))
+            (fun s (d, n) ->
+              f (Pdot (path, s, n)) (Pdot (path', s, n), force d))
             (proj2 comps);
           Tbl.iter
             (fun s (c, n) ->
@@ -1405,7 +1472,8 @@ let run_iter_cont l =
   iter_env_cont () := [];
   cont
 
-let iter_types f = iter_env (fun env -> env.types) (fun sc -> sc.comp_types) f
+let iter_types f =
+  iter_env (fun env -> env.types) (fun sc -> sc.comp_types) Fun.id f
 
 let same_types env1 env2 =
   env1.types == env2.types && env1.components == env2.components
@@ -1417,14 +1485,13 @@ let used_persistent () =
     (persistent_structures ());
   !r
 
-let find_all_comps proj s (p, mcomps) =
+let find_all_comps proj force s (p, mcomps) =
   match get_components mcomps with
   | Functor_comps _ -> []
   | Structure_comps comps -> (
-    try
-      let c, n = Tbl.find_str s (proj comps) in
-      [(Pdot (p, s, n), c)]
-    with Not_found -> [])
+    match Tbl.find_str s (proj comps) with
+    | c, n -> [(Pdot (p, s, n), force c)]
+    | exception Not_found -> [])
 
 let rec find_shadowed_comps path env =
   match path with
@@ -1432,17 +1499,17 @@ let rec find_shadowed_comps path env =
   | Pdot (p, s, _) ->
     let l = find_shadowed_comps p env in
     let l' =
-      List.map (find_all_comps (fun comps -> comps.comp_components) s) l
+      List.map (find_all_comps (fun comps -> comps.comp_components) Fun.id s) l
     in
     List.flatten l'
   | Papply _ -> []
 
-let find_shadowed proj1 proj2 path env =
+let find_shadowed proj1 proj2 force path env =
   match path with
   | Pident id -> Id_tbl.find_all (Ident.name id) (proj1 env)
   | Pdot (p, s, _) ->
     let l = find_shadowed_comps p env in
-    let l' = List.map (find_all_comps proj2 s) l in
+    let l' = List.map (find_all_comps proj2 force s) l in
     List.flatten l'
   | Papply _ -> []
 
@@ -1451,7 +1518,7 @@ let find_shadowed_types path env =
     (find_shadowed
        (fun env -> env.types)
        (fun comps -> comps.comp_types)
-       path env)
+       Fun.id path env)
 
 (* GADT instance tracking *)
 
@@ -1574,10 +1641,102 @@ let add_to_tbl id decl tbl =
   let decls = try Tbl.find_str id tbl with Not_found -> [] in
   Tbl.add id (decl :: decls) tbl
 
-let rec components_of_module ~deprecated ~loc env sub path mty =
-  {deprecated; loc; comps = Env_lazy.create (env, sub, path, mty)}
+(* Deferred components of persistent structures.
+
+   Building the components of a module copies every value of its signature
+   with the module's path substitution, although a dependent usually reads
+   only a few of them. In the signature of a .cmi file as it was read (whose
+   CRC is [maker_origin]), the values are therefore copied when they are first
+   read instead, once the process has built the same
+   components eagerly once and knows how many type ids each item takes (the
+   copies take no stamps). The type ids an item would have taken when the
+   components are built are reserved for it, so every later type id is the
+   same as if it had been copied at once, and the copy is made with exactly
+   those ids when it is read. If a deferred copy ever takes a different number
+   of ids, it is thrown away and made again with fresh ones.
+
+   The items of a .cmi signature are not changed before they are copied: the
+   type checker only sees copies of them. The other items (types with their
+   constructors and labels, extension constructors, module types, submodules)
+   are still built at once. *)
+
+let component_counts : (Digest.t * string, int array) Hashtbl.t =
+  Hashtbl.create 64
+let component_counts_lock = Mutex.create ()
+
+let with_component_counts_lock f =
+  Mutex.lock component_counts_lock;
+  Fun.protect ~finally:(fun () -> Mutex.unlock component_counts_lock) f
+
+let find_component_counts key =
+  with_component_counts_lock (fun () -> Hashtbl.find_opt component_counts key)
+
+let record_component_counts key counts =
+  with_component_counts_lock (fun () ->
+      if Hashtbl.length component_counts >= 65536 then
+        Hashtbl.reset component_counts;
+      Hashtbl.replace component_counts key counts)
+
+(* How many items were deferred, and how many deferred copies were made again
+   with fresh ids, on this domain. Domain-local so that the counts cost no
+   shared writes; only tests read them. *)
+type deferred_component_stats = {mutable deferred: int; mutable fallbacks: int}
+
+let deferred_component_stats_key =
+  Domain.DLS.new_key (fun () -> {deferred = 0; fallbacks = 0})
+
+let deferred_component_stats () =
+  let stats = Domain.DLS.get deferred_component_stats_key in
+  (stats.deferred, stats.fallbacks)
+
+let forget_component_counts () =
+  with_component_counts_lock (fun () -> Hashtbl.reset component_counts)
+
+(* Run [compute] with the [count] type ids from [base], which were reserved
+   for it. *)
+let with_reserved_type_ids ~base ~count compute =
+  let state = Compiler_request_state.current () in
+  let saved = state.type_node_id in
+  let stamp0 = Ident.current_time () in
+  state.type_node_id <- base;
+  match compute () with
+  | result ->
+    let type_end = state.type_node_id in
+    state.type_node_id <- saved;
+    if type_end = base + count && Ident.current_time () = stamp0 then result
+    else
+      (* Some of the ids may also belong to later type nodes: copy again with
+         fresh ones. *)
+      let stats = Domain.DLS.get deferred_component_stats_key in
+      stats.fallbacks <- stats.fallbacks + 1;
+      compute ()
+  | exception exn ->
+    state.type_node_id <- saved;
+    raise exn
 
-and components_of_module_maker (env, sub, path, mty) =
+let rec components_of_module ?origin ~deprecated ~loc env sub path mty =
+  {
+    deprecated;
+    loc;
+    comps =
+      Env_lazy.create
+        {
+          maker_env = env;
+          maker_sub = sub;
+          maker_path = path;
+          maker_mty = mty;
+          maker_origin = origin;
+        };
+  }
+
+and components_of_module_maker
+    {
+      maker_env = env;
+      maker_sub = sub;
+      maker_path = path;
+      maker_mty = mty;
+      maker_origin;
+    } =
   match scrape_alias env mty with
   | Mty_signature sg ->
     let c =
@@ -1591,14 +1750,67 @@ and components_of_module_maker (env, sub, path, mty) =
         comp_components = Tbl.empty;
       }
     in
+    (* [origin] is set when [sg] is part of a .cmi signature as it was read. *)
+    let origin =
+      match mty with
+      | Mty_signature _ -> maker_origin
+      | Mty_ident _ | Mty_alias _ | Mty_functor _ -> None
+    in
+    let key = Option.map (fun crc -> (crc, Path.name path)) origin in
+    let state = Compiler_request_state.current () in
+    let item_count = List.length sg in
+    let counts =
+      match Option.bind key find_component_counts with
+      | Some counts
+        when Array.length counts = item_count
+             && List.for_all2
+                  (fun item count ->
+                    match item with
+                    | Sig_value _ -> count >= 0
+                    | Sig_type _ | Sig_typext _ | Sig_module _ | Sig_modtype _
+                      ->
+                      true)
+                  sg (Array.to_list counts) ->
+        (* The counts fit this signature: one for every value. *)
+        Some counts
+      | Some _ | None -> None
+    in
+    (* The type ids each value takes, when the counts of these
+       components are not known yet. *)
+    let recorded =
+      match (key, counts) with
+      | Some _, None -> Some (Array.make item_count (-1))
+      | _ -> None
+    in
+    let stamps_taken = ref false in
+    let deferred = ref 0 in
+    let make_cell index compute =
+      match (counts, recorded) with
+      | Some counts, _ ->
+        let base = state.type_node_id and count = counts.(index) in
+        state.type_node_id <- base + count;
+        incr deferred;
+        Comp_cell.pending (fun () ->
+            with_reserved_type_ids ~base ~count compute)
+      | None, Some recorded ->
+        let type0 = state.type_node_id and stamp0 = Ident.current_time () in
+        let result = compute () in
+        recorded.(index) <- state.type_node_id - type0;
+        if Ident.current_time () <> stamp0 then stamps_taken := true;
+        Comp_cell.ready result
+      | None, None -> Comp_cell.ready (compute ())
+    in
     let pl, sub = prefix_idents path sub sg in
     let env = ref env in
     let pos = ref 0 in
+    let index = ref 0 in
     List.iter2
       (fun item path ->
-        match item with
+        (match item with
         | Sig_value (id, decl) -> (
-          let decl' = Subst.value_description sub decl in
+          let decl' =
+            make_cell !index (fun () -> Subst.value_description sub decl)
+          in
           c.comp_values <- Tbl.add (Ident.name id) (decl', !pos) c.comp_values;
           match decl.val_kind with
           | Val_prim _ -> ()
@@ -1635,8 +1847,8 @@ and components_of_module_maker (env, sub, path, mty) =
             Builtin_attributes.deprecated_of_attrs md.md_attributes
           in
           let comps =
-            components_of_module ~deprecated ~loc:md.md_loc !env sub path
-              md.md_type
+            components_of_module ?origin ~deprecated ~loc:md.md_loc !env sub
+              path md.md_type
           in
           c.comp_components <-
             Tbl.add (Ident.name id) (comps, !pos) c.comp_components;
@@ -1646,8 +1858,16 @@ and components_of_module_maker (env, sub, path, mty) =
           let decl' = Subst.modtype_declaration sub decl in
           c.comp_modtypes <-
             Tbl.add (Ident.name id) (decl', nopos) c.comp_modtypes;
-          env := store_modtype id decl !env)
+          env := store_modtype id decl !env);
+        incr index)
       sg pl;
+    (if !deferred > 0 then
+       let stats = Domain.DLS.get deferred_component_stats_key in
+       stats.deferred <- stats.deferred + !deferred);
+    (match (key, recorded) with
+    | Some key, Some recorded when not !stamps_taken ->
+      record_component_counts key recorded
+    | _ -> ());
     Some (Structure_comps c)
   | Mty_functor (param, _ty_arg, ty_res) ->
     Some
@@ -1900,23 +2120,27 @@ let rec add_signature sg env =
 let add_components slot root env0 comps =
   let add_l w comps env0 = Tycomp_tbl.add_open slot w comps env0 in
 
-  let add w comps env0 = Id_tbl.add_open slot w root comps env0 in
+  let add w force comps env0 = Id_tbl.add_open slot w root ~force comps env0 in
 
   let constrs =
     add_l (fun x -> `Constructor x) comps.comp_constrs env0.constrs
   in
   let labels = add_l (fun x -> `Label x) comps.comp_labels env0.labels in
 
-  let values = add (fun x -> `Value x) comps.comp_values env0.values in
-  let types = add (fun x -> `Type x) comps.comp_types env0.types in
+  let values =
+    add (fun x -> `Value x) Comp_cell.force comps.comp_values env0.values
+  in
+  let types = add (fun x -> `Type x) Fun.id comps.comp_types env0.types in
   let modtypes =
-    add (fun x -> `Module_type x) comps.comp_modtypes env0.modtypes
+    add (fun x -> `Module_type x) Fun.id comps.comp_modtypes env0.modtypes
   in
   let components =
-    add (fun x -> `Component x) comps.comp_components env0.components
+    add (fun x -> `Component x) Fun.id comps.comp_components env0.components
   in
 
-  let modules = add (fun x -> `Module x) comps.comp_modules env0.modules in
+  let modules =
+    add (fun x -> `Module x) Fun.id comps.comp_modules env0.modules
+  in
 
   {
     env0 with
@@ -2040,7 +2264,7 @@ let save_signature ?check_exists ~deprecated sg modname filename =
 
 (* Folding on environments *)
 
-let find_all proj1 proj2 f lid env acc =
+let find_all proj1 proj2 force f lid env acc =
   match lid with
   | None ->
     Id_tbl.fold_name
@@ -2051,7 +2275,7 @@ let find_all proj1 proj2 f lid env acc =
     match get_components desc with
     | Structure_comps c ->
       Tbl.fold
-        (fun s (data, pos) acc -> f s (Pdot (p, s, pos)) data acc)
+        (fun s (data, pos) acc -> f s (Pdot (p, s, pos)) (force data) acc)
         (proj2 c) acc
     | Functor_comps _ -> acc)
 
@@ -2101,7 +2325,7 @@ let fold_modules f lid env acc =
     | Functor_comps _ -> acc)
 
 let fold_values f =
-  find_all (fun env -> env.values) (fun sc -> sc.comp_values) f
+  find_all (fun env -> env.values) (fun sc -> sc.comp_values) Comp_cell.force f
 
 and fold_constructors f =
   find_all_simple_list (fun env -> env.constrs) (fun sc -> sc.comp_constrs) f
@@ -2109,10 +2333,11 @@ and fold_constructors f =
 and fold_labels f =
   find_all_simple_list (fun env -> env.labels) (fun sc -> sc.comp_labels) f
 
-and fold_types f = find_all (fun env -> env.types) (fun sc -> sc.comp_types) f
+and fold_types f =
+  find_all (fun env -> env.types) (fun sc -> sc.comp_types) Fun.id f
 
 and fold_modtypes f =
-  find_all (fun env -> env.modtypes) (fun sc -> sc.comp_modtypes) f
+  find_all (fun env -> env.modtypes) (fun sc -> sc.comp_modtypes) Fun.id f
 
 (* Make the initial environment *)
 (* The initial environment contains mutable type graphs. Each compiler domain
diff --git a/compiler/ml/env.mli b/compiler/ml/env.mli
index d7a0fb5a32..02dc61d1c1 100644
--- a/compiler/ml/env.mli
+++ b/compiler/ml/env.mli
@@ -186,6 +186,16 @@ val deferred_signature_copy_stats : unit -> int * int
    them and were made again with fresh ones (expected: none), in the process
    so far. *)
 
+val deferred_component_stats : unit -> int * int
+(* For tests: how many values of compilation units' components were
+   left to be copied when first read, and how many of those copies did not take
+   the type ids reserved for them and were made again with fresh ones
+   (expected: none), on the calling domain so far. *)
+
+val forget_component_counts : unit -> unit
+(* For tests: build the components of every compilation unit at once again
+   (and learn their counts), as when the process has not built them before. *)
+
 val save_signature :
   ?check_exists:unit ->
   deprecated:string option ->
diff --git a/tests/ounit_tests/ounit_deferred_components_tests.ml b/tests/ounit_tests/ounit_deferred_components_tests.ml
new file mode 100644
index 0000000000..e394cf9f01
--- /dev/null
+++ b/tests/ounit_tests/ounit_deferred_components_tests.ml
@@ -0,0 +1,661 @@
+(* The values of a compilation unit's components are copied when
+   they are first read, once the process knows how many type ids each of them
+   takes; the ids are reserved when the components are built. These tests check
+   that reading them later, in another order or never, gives exactly the type
+   ids, stamps and graphs of components built at once, both directly through
+   [Env] on every runtime interface and through whole compiler requests that
+   use dependencies through functors, aliases, includes, module type of,
+   recursive modules, shadowing, first-class modules and error messages. *)
+
+open OUnit
+
+let ( >:: ), ( >::: ) = OUnit.(( >:: ), ( >::: ))
+
+let runtime_dir () = Filename.concat (Runtime_package.get_path ()) "lib/ocaml"
+
+let probe () =
+  (Ident.binding_time (Ident.create "probe"), (Btype.newgenvar ()).Types.id)
+
+let in_fresh_request dirs action =
+  Compiler_request_state.with_fresh (fun () ->
+      Request_local.with_fresh (fun () ->
+          Ident.with_fresh (fun () ->
+              Config.set_load_path dirs;
+              action ())))
+
+(* What reading one item of a signature gives. *)
+type read =
+  | Value of Path.t * Types.value_description
+  | Type of
+      Path.t
+      * Types.type_declaration
+      * Env.type_descriptions
+      * Types.constructor_description list list
+      * Types.label_description list list
+  | Module of string * read list
+  | Missing of string
+
+(* Read the items of [sg], the signature of module [lid], from the last to
+   the first, and the submodules declared with a signature recursively. *)
+let rec read_signature env lid sg =
+  List.fold_left
+    (fun acc item -> read_item env lid item :: acc)
+    [] (List.rev sg)
+  |> List.rev
+
+and read_item env lid item =
+  let field name = Longident.Ldot (lid, name) in
+  match item with
+  | Types.Sig_value (id, _) -> (
+    match Env.lookup_value (field (Ident.name id)) env with
+    | path, decl -> Value (path, decl)
+    | exception Not_found -> Missing (Ident.name id))
+  | Sig_type (id, decl, _) -> (
+    match Env.lookup_type (field (Ident.name id)) env with
+    | path ->
+      let constructors =
+        match decl.type_kind with
+        | Type_variant (cds, _) ->
+          List.map
+            (fun (cd : Types.constructor_declaration) ->
+              List.map fst
+                (Env.lookup_all_constructors (field (Ident.name cd.cd_id)) env))
+            cds
+        | Type_record _ | Type_abstract | Type_open -> []
+      in
+      let labels =
+        match decl.type_kind with
+        | Type_record (lds, _) ->
+          List.map
+            (fun (ld : Types.label_declaration) ->
+              List.map fst
+                (Env.lookup_all_labels (field (Ident.name ld.ld_id)) env))
+            lds
+        | Type_variant _ | Type_abstract | Type_open -> []
+      in
+      Type
+        ( path,
+          Env.find_type path env,
+          Env.find_type_descrs path env,
+          constructors,
+          labels )
+    | exception Not_found -> Missing (Ident.name id))
+  | Sig_module (id, {md_type = Mty_signature sg}, _) ->
+    Module (Ident.name id, read_signature env (field (Ident.name id)) sg)
+  | Sig_module (id, _, _) | Sig_modtype (id, _) | Sig_typext (id, _, _) ->
+    Missing (Ident.name id)
+
+let runtime_units dir =
+  Sys.readdir dir |> Array.to_list
+  |> List.filter (fun file -> Filename.check_suffix file ".cmi")
+  |> List.map (fun file ->
+      let cmi = Cmi_format.read_cmi (Filename.concat dir file) in
+      (cmi.cmi_name, cmi.cmi_sign))
+  |> List.sort (fun (a, _) (b, _) -> String.compare a b)
+
+(* Build the components of every unit, creating an identifier and a type node
+   after each, then read every item of every unit from the last unit to the
+   first. The result is marshalled: equal strings mean equal stamps, type ids
+   and sharing. *)
+let read_all_units dir units =
+  in_fresh_request [dir] (fun () ->
+      let env = Env.empty in
+      let built =
+        List.map
+          (fun (name, _) ->
+            (match
+               Env.lookup_value
+                 (Longident.Ldot (Lident name, "not a component"))
+                 env
+             with
+            | _ -> assert_failure "no such value"
+            | exception Not_found -> ());
+            probe ())
+          units
+      in
+      let read =
+        List.fold_left
+          (fun acc (name, sg) ->
+            (name, read_signature env (Longident.Lident name) sg) :: acc)
+          [] (List.rev units)
+      in
+      Marshal.to_string (built, read, probe ()) [])
+
+let deferred_matches_eager_tests _ =
+  let dir = runtime_dir () in
+  let units = runtime_units dir in
+  assert_bool "runtime interfaces found" (List.length units > 50);
+  Env.forget_component_counts ();
+  let deferred_before, fallbacks_before = Env.deferred_component_stats () in
+  let eager = read_all_units dir units in
+  let deferred_eager, _ = Env.deferred_component_stats () in
+  assert_equal ~printer:string_of_int ~msg:"nothing deferred before the counts"
+    deferred_before deferred_eager;
+  let deferred = read_all_units dir units in
+  let deferred_after, fallbacks_after = Env.deferred_component_stats () in
+  assert_bool "values were deferred" (deferred_after > deferred_eager);
+  assert_equal ~printer:string_of_int
+    ~msg:"every deferred copy took exactly its reserved type ids"
+    fallbacks_before fallbacks_after;
+  assert_bool
+    "deferred copies give the same stamps, type ids and graphs as eager ones"
+    (String.equal eager deferred)
+
+(* Components whose values are never read still take their type ids. *)
+let unread_components_tests _ =
+  let dir = runtime_dir () in
+  let names = ["Stdlib_Array"; "Stdlib_List"; "Stdlib_Option"; "Stdlib"] in
+  let build_only () =
+    in_fresh_request [dir] (fun () ->
+        List.map
+          (fun name ->
+            (match
+               Env.lookup_value
+                 (Longident.Ldot (Lident name, "not a component"))
+                 Env.empty
+             with
+            | _ -> assert_failure "no such value"
+            | exception Not_found -> ());
+            probe ())
+          names)
+  in
+  Env.forget_component_counts ();
+  let eager = build_only () in
+  assert_equal eager (build_only ())
+
+(* A compilation unit [Forged] whose .cmi claims the CRC of different
+   contents. *)
+let value name val_type =
+  Types.Sig_value
+    ( Ident.create name,
+      {
+        val_type;
+        val_kind = Val_reg;
+        val_loc = Location.none;
+        val_attributes = [];
+      } )
+
+let forged_crc = Digest.string "ounit_deferred_components_tests forged crc"
+
+let with_forged_unit sign action =
+  let cmi =
+    {
+      Cmi_format.cmi_name = "Forged";
+      cmi_sign = sign;
+      cmi_crcs = [("Forged", Some forged_crc)];
+      cmi_flags = [];
+    }
+  in
+  let saved_load = !Env.Persistent_signature.load in
+  (Env.Persistent_signature.load :=
+     fun ~unit_name ->
+       if unit_name = "Forged" then
+         Some {Env.Persistent_signature.filename = "Forged.cmi"; cmi}
+       else saved_load ~unit_name);
+  Fun.protect
+    ~finally:(fun () -> Env.Persistent_signature.load := saved_load)
+    (fun () -> in_fresh_request [] action)
+
+let forged = Longident.Lident "Forged"
+
+let build_forged () =
+  match
+    Env.lookup_value (Longident.Ldot (forged, "not a component")) Env.empty
+  with
+  | _ -> assert_failure "no such value"
+  | exception Not_found -> ()
+
+let read_forged name =
+  snd (Env.lookup_value (Longident.Ldot (forged, name)) Env.empty)
+
+(* Learn that the value [x] of [Forged] takes one type id. *)
+let learn_forged_counts () =
+  with_forged_unit
+    [value "x" (Predef.type_int ())]
+    (fun () -> ignore (read_forged "x"))
+
+(* The counts learnt from the first contents are wrong for the second: the
+   deferred copy takes more type ids than were reserved, and is made again with
+   fresh ones. *)
+let count_mismatch_fallback_tests _ =
+  learn_forged_counts ();
+  let deferred_before, fallbacks_before = Env.deferred_component_stats () in
+  let probe_id, copy_id =
+    with_forged_unit
+      [
+        value "x"
+          (Btype.newgenty (Ttuple [Predef.type_int (); Predef.type_int ()]));
+      ]
+      (fun () ->
+        build_forged ();
+        let _, probe_id = probe () in
+        (probe_id, (read_forged "x").val_type.id))
+  in
+  let deferred_after, fallbacks_after = Env.deferred_component_stats () in
+  assert_equal ~printer:string_of_int ~msg:"the copy was deferred"
+    (deferred_before + 1) deferred_after;
+  assert_equal ~printer:string_of_int ~msg:"the copy fell back"
+    (fallbacks_before + 1) fallbacks_after;
+  assert_bool "the fallback copy has fresh type ids" (copy_id > probe_id)
+
+(* Counts learnt from contents with a module type where the second contents
+   have a value (same CRC, same number of items) do not fit them: the
+   components are built at once instead of reserving from a missing count, and
+   every value gets its own type ids. *)
+let counts_without_value_slot_tests _ =
+  let module_type name =
+    Types.Sig_modtype
+      ( Ident.create name,
+        {mtd_type = None; mtd_attributes = []; mtd_loc = Location.none} )
+  in
+  with_forged_unit
+    [value "x" (Predef.type_int ()); module_type "M"]
+    (fun () -> ignore (read_forged "x"));
+  let deferred_before, _ = Env.deferred_component_stats () in
+  let x_id, y_id, probe_id =
+    with_forged_unit
+      [value "x" (Predef.type_int ()); value "y" (Predef.type_int ())]
+      (fun () ->
+        build_forged ();
+        let _, probe_id = probe () in
+        ((read_forged "x").val_type.id, (read_forged "y").val_type.id, probe_id))
+  in
+  let deferred_after, _ = Env.deferred_component_stats () in
+  assert_equal ~printer:string_of_int ~msg:"nothing was deferred"
+    deferred_before deferred_after;
+  assert_bool "every value has its own type ids, taken when built"
+    (x_id <> y_id && x_id < probe_id && y_id < probe_id)
+
+(* A deferred copy that raises puts the type id and stamp counters back and
+   stays to be made: reading it again raises again. *)
+let raising_copy_tests _ =
+  learn_forged_counts ();
+  (* A variant type whose row ends in a tuple: copying it fails. *)
+  let broken =
+    Btype.newgenty
+      (Tvariant
+         {
+           row_fields = [];
+           row_more = Btype.newgenty (Ttuple []);
+           row_closed = true;
+           row_fixed = false;
+           row_name = None;
+         })
+  in
+  with_forged_unit
+    [value "x" broken]
+    (fun () ->
+      build_forged ();
+      let stamp, id = probe () in
+      let read_raises () =
+        match read_forged "x" with
+        | _ -> assert_failure "the copy should have raised"
+        | exception Assert_failure _ -> ()
+      in
+      read_raises ();
+      assert_equal ~msg:"counters put back after the failed copy"
+        (stamp + 1, id + 1)
+        (probe ());
+      read_raises ();
+      assert_equal ~msg:"counters put back after the second failed copy"
+        (stamp + 2, id + 2)
+        (probe ()))
+
+(* [Env.copy_types] replaces values bound by an open: the replaced ones are
+   copies, the others stay as they were, and every way of reading the open
+   sees the replacements. *)
+let copy_types_in_open_tests _ =
+  let dir = runtime_dir () in
+  in_fresh_request [dir] (fun () ->
+      let env =
+        match
+          Env.open_signature Asttypes.Fresh
+            (Path.Pident (Ident.create_persistent "Stdlib_Array"))
+            Env.empty
+        with
+        | Some env -> env
+        | None -> assert_failure "Stdlib_Array opens"
+      in
+      let value env name = snd (Env.lookup_value (Longident.Lident name) env) in
+      let names = ["length"; "map"; "reduce"] in
+      let before = List.map (value env) names in
+      let other_before = value env "concat" in
+      let copied = Env.copy_types names env in
+      let copied_twice = Env.copy_types ["map"] copied in
+      List.iter2
+        (fun name (decl : Types.value_description) ->
+          let decl' = value copied name in
+          assert_bool (name ^ " is a copy") (decl'.val_type != decl.val_type);
+          assert_bool
+            (name ^ " is the same type")
+            (Ctype.equal Env.empty true [decl.val_type] [decl'.val_type]))
+        names before;
+      assert_bool "values not named are not copied"
+        (value copied "concat" == other_before);
+      assert_bool "the original environment is unchanged"
+        (value env "length" == List.hd before);
+      assert_bool "a second copy copies the first one"
+        ((value copied_twice "map").val_type != (value copied "map").val_type);
+      assert_bool "the second copy keeps the other copies"
+        (value copied_twice "length" == value copied "length");
+      let folded =
+        Env.fold_values
+          (fun name _ decl acc -> if name = "length" then decl :: acc else acc)
+          None copied []
+      in
+      assert_bool "folding sees the copy"
+        (List.exists (fun decl -> decl == value copied "length") folded);
+      assert_bool "folding does not see the original"
+        (not (List.exists (fun decl -> decl == List.hd before) folded)))
+
+(* Whole compiler requests *)
+
+let rec ensure_dir path =
+  if not (Sys.file_exists path) then (
+    ensure_dir (Filename.dirname path);
+    try Unix.mkdir path 0o755 with Unix.Unix_error (Unix.EEXIST, _, _) -> ())
+
+let write_file path contents =
+  ensure_dir (Filename.dirname path);
+  let channel = open_out_bin path in
+  Fun.protect
+    ~finally:(fun () -> close_out_noerr channel)
+    (fun () -> output_string channel contents)
+
+let read_file path =
+  let channel = open_in_bin path in
+  Fun.protect
+    ~finally:(fun () -> close_in_noerr channel)
+    (fun () -> really_input_string channel (in_channel_length channel))
+
+let rec remove_tree path =
+  match (Unix.lstat path).st_kind with
+  | Unix.S_DIR ->
+    Array.iter
+      (fun name -> remove_tree (Filename.concat path name))
+      (Sys.readdir path);
+    Unix.rmdir path
+  | _ -> Sys.remove path
+  | exception Unix.Unix_error (Unix.ENOENT, _, _) -> ()
+
+let with_temp_dir action =
+  let path = Filename.temp_file "deferred-components-" "" in
+  Sys.remove path;
+  Unix.mkdir path 0o755;
+  let path = Unix.realpath path in
+  Fun.protect ~finally:(fun () -> remove_tree path) (fun () -> action path)
+
+let dep_source =
+  {|type color = Red | Green | Blue(int)
+type point = {x: int, y: int, label?: string}
+type rec tree = Leaf | Node(tree, int, tree)
+type box<'a> = {items: array<'a>, count: int}
+type poly = [#a | #b(int)]
+type inline = Inline({name: string, age: int})
+exception Failed(string)
+type ext = ..
+type ext += Extended(int)
+let origin = {x: 0, y: 0}
+let make = items => {items, count: Array.length(items)}
+let colorName = c =>
+  switch c {
+  | Red => "red"
+  | Green => "green"
+  | Blue(n) => Int.toString(n)
+  }
+module type Show = {
+  type t
+  let show: t => string
+}
+module IntShow: Show with type t = int = {
+  type t = int
+  let show = n => Int.toString(n)
+}
+module MakeShow = (S: Show) => {
+  let showAll = xs => Array.map(xs, S.show)
+}
+module Nested = {
+  type inner = {value: int}
+  let unused = 1
+  module Deep = {
+    let deep = 42
+    type d = D(inner)
+  }
+}
+module Alias = Nested
+module rec Even: {
+  let even: int => bool
+} = {
+  let even = n => n == 0 || Odd.odd(n - 1)
+}
+and Odd: {
+  let odd: int => bool
+} = {
+  let odd = n => n != 0 && Even.even(n - 1)
+}
+let shadowed = 1
+let shadowed = "now a string"
+module type OfNested = module type of Nested
+let packed: module(Show with type t = int) = module(IntShow)
+|}
+
+let main_source =
+  {|open Dep
+let c = Blue(3)
+let p = {x: 1, y: 2}
+let q = {...origin, label: "q"}
+let n = colorName(c)
+let tr = Node(Leaf, 1, Leaf)
+let w = make([1, 2])
+let v: poly = #b(1)
+let i = Inline({name: "a", age: 1})
+let e = Extended(2)
+module S = MakeShow(IntShow)
+let shown = S.showAll([1, 2])
+module A = Dep.Alias
+let deep = A.Deep.deep
+let d = A.Deep.D({value: 3})
+include Dep.Nested.Deep
+module M: OfNested = Dep.Nested
+let even = Even.even(4)
+let s: string = shadowed
+module P = unpack(packed)
+let shownP = P.show(3)
+let first = (module(IntShow): module(Show with type t = int))
+let raised = try throw(Failed("x")) catch {
+  | Failed(s) => s
+  }
+let arr = Array.map([1, 2], x => x + 1)
+let opt = Option.map(Some(1), x => x)
+let red = Dep.Red
+|}
+
+(* Each of these fails with a message that prints types of dependencies. *)
+let error_sources =
+  [
+    ("ErrRecord.res", {|let p: Dep.point = {x: 1, y: "2"}|});
+    ("ErrConstructor.res", {|let c: Dep.tree = Dep.Blue(1)|});
+    ("ErrInline.res", {|let i = Dep.Inline({name: 1, age: 1})|});
+    ("ErrLabel.res", {|let p: Dep.point = {x: 1, z: 2}|});
+    ("ErrFunctor.res", {|module S = Dep.MakeShow(Dep.Nested)|});
+    ("ErrAlias.res", {|let i: int = Dep.Alias.Deep.D({value: 1})|});
+    ("ErrStdlib.res", {|let x: int = Array.map([1], x => x)|});
+    ("ErrPacked.res", {|let x: string = Dep.packed|});
+    ("ErrInclude.res", {|include Dep.Nested
+let y: string = unused|});
+  ]
+
+let request root input =
+  let argv =
+    [
+      "-nostdlib";
+      "-I";
+      runtime_dir ();
+      "-I";
+      root;
+      "-bs-project-root";
+      root;
+      "-bs-package-name";
+      "deferred-components-test";
+      "-bs-package-output";
+      "commonjs:.:.js";
+      "-bs-no-version-header";
+    ]
+  in
+  Rescript_compiler_driver.run_request ~run_external:None ~cwd:root ~argv ~input
+
+let outputs root base =
+  List.filter_map
+    (fun ext ->
+      let path = Filename.concat root (base ^ ext) in
+      if Sys.file_exists path then Some (ext, read_file path) else None)
+    [".js"; ".cmi"; ".cmj"; ".cmt"]
+
+(* What compiling [input] gives: exit code, diagnostics and every output. *)
+let compile root input =
+  let base = Filename.remove_extension input in
+  List.iter
+    (fun (ext, _) -> Sys.remove (Filename.concat root (base ^ ext)))
+    (outputs root base);
+  let result = request root input in
+  (result.Rescript_compiler_driver.exit_code, result.stderr, outputs root base)
+
+let setup root =
+  write_file (Filename.concat root "Dep.res") dep_source;
+  write_file (Filename.concat root "Main.res") main_source;
+  List.iter
+    (fun (name, source) -> write_file (Filename.concat root name) source)
+    error_sources;
+  let code, stderr, _ = compile root "Dep.res" in
+  if code <> 0 then assert_failure ("Dep.res: " ^ stderr)
+
+let requests_tests _ =
+  with_temp_dir (fun root ->
+      setup root;
+      let inputs = "Main.res" :: List.map fst error_sources in
+      (* Each input is compiled once with no counts known (everything is
+         built at once), then again with the counts that request learnt. *)
+      let eager, deferred =
+        List.split
+          (List.map
+             (fun input ->
+               Env.forget_component_counts ();
+               let eager = compile root input in
+               let deferred_before, fallbacks_before =
+                 Env.deferred_component_stats ()
+               in
+               let deferred = compile root input in
+               let deferred_after, fallbacks_after =
+                 Env.deferred_component_stats ()
+               in
+               assert_bool
+                 (input ^ ": values were deferred")
+                 (deferred_after > deferred_before);
+               assert_equal ~printer:string_of_int
+                 ~msg:
+                   (input
+                  ^ ": every deferred copy took exactly its reserved type ids")
+                 fallbacks_before fallbacks_after;
+               (eager, deferred))
+             inputs)
+      in
+      List.iter2
+        (fun input ((code, stderr, files) as eager) ->
+          let main = input = "Main.res" in
+          assert_bool
+            (input ^ " exit code: " ^ stderr)
+            (if main then code = 0 else code <> 0);
+          if not main then
+            assert_bool
+              (input ^ " reports an error: " ^ stderr)
+              (String.length stderr > 0);
+          if main then
+            assert_equal ~printer:string_of_int ~msg:"Main outputs" 4
+              (List.length files);
+          ignore eager)
+        inputs eager;
+      List.iter2
+        (fun input (eager, deferred) ->
+          let code, stderr, files = deferred in
+          let eager_code, eager_stderr, eager_files = eager in
+          assert_equal ~printer:string_of_int ~msg:(input ^ " exit code")
+            eager_code code;
+          assert_equal ~printer:Fun.id ~msg:(input ^ " diagnostics")
+            eager_stderr stderr;
+          assert_equal
+            ~printer:(fun files ->
+              String.concat ", "
+                (List.map
+                   (fun (ext, contents) ->
+                     ext ^ " " ^ Digest.to_hex (Digest.string contents))
+                   files))
+            ~msg:(input ^ " outputs") eager_files files)
+        inputs
+        (List.combine eager deferred))
+
+(* Requests on several domains at once, each building and reading the
+   deferred components of its own environment, give the outputs of the
+   eager request. *)
+let concurrent_requests_tests _ =
+  with_temp_dir (fun root ->
+      let dirs =
+        List.init 5 (fun index ->
+            let dir = Filename.concat root (string_of_int index) in
+            ensure_dir dir;
+            setup dir;
+            dir)
+      in
+      let portable (code, stderr, files) =
+        (* The .cmt files record their own directory. *)
+        (code, String.length stderr, List.remove_assoc ".cmt" files)
+      in
+      Env.forget_component_counts ();
+      let eager = portable (compile (List.hd dirs) "Main.res") in
+      let domains =
+        List.map
+          (fun dir ->
+            Domain.spawn (fun () ->
+                let results =
+                  List.init 3 (fun _ -> portable (compile dir "Main.res"))
+                in
+                let deferred, fallbacks = Env.deferred_component_stats () in
+                assert_bool "the domain deferred values" (deferred > 0);
+                assert_equal ~printer:string_of_int
+                  ~msg:"no deferred copy on the domain fell back" 0 fallbacks;
+                results))
+          (List.tl dirs)
+      in
+      (* Join every domain before reporting a failure. *)
+      let results =
+        List.map
+          (fun domain ->
+            match Domain.join domain with
+            | results -> Ok results
+            | exception error -> Error error)
+          domains
+      in
+      List.iter
+        (function
+          | Ok results ->
+            List.iter
+              (fun result ->
+                assert_bool "a concurrent request gives the eager outputs"
+                  (result = eager))
+              results
+          | Error error -> raise error)
+        results)
+
+let suites =
+  __FILE__
+  >::: [
+         "deferred_components_match_eager_ones" >:: deferred_matches_eager_tests;
+         "unread_components_reserve_type_ids" >:: unread_components_tests;
+         "count_mismatch_falls_back_to_fresh_ids"
+         >:: count_mismatch_fallback_tests;
+         "counts_without_value_slot_build_at_once"
+         >:: counts_without_value_slot_tests;
+         "raising_copy_restores_counters" >:: raising_copy_tests;
+         "copy_types_in_open" >:: copy_types_in_open_tests;
+         "requests_match_eager_requests" >:: requests_tests;
+         "concurrent_requests_match_eager_request" >:: concurrent_requests_tests;
+       ]
diff --git a/tests/ounit_tests/ounit_tests_main.ml b/tests/ounit_tests/ounit_tests_main.ml
index 3348a045e8..8b75214e12 100644
--- a/tests/ounit_tests/ounit_tests_main.ml
+++ b/tests/ounit_tests/ounit_tests_main.ml
@@ -39,6 +39,7 @@ let suites =
       Ounit_find_in_path_tests.suites;
       Ounit_build_file_store_tests.suites;
       Ounit_deferred_signature_tests.suites;
+      Ounit_deferred_components_tests.suites;
     ]
 
 let _ = OUnit.run_test_tt_main suites