Merge pull request #2092 from trefis/revert-1737

Fix MPR#7852 by reverting #1737

Changes

@@ -144,9 +144,6 @@ Working version
   (Arthur Charguéraud and Armaël Guéneau, with help and advice
    from Gabriel Scherer, Frédéric Bour, Xavier Clerc and Leo White)
 
-- GPR#1737: Update locations during destructive substitutions.
-  (Thomas Refis, review by Gabriel Radanne)
-
 - GPR#1748: do not error when instantiating polymorphic fields in patterns.
   (Thomas Refis, review by Gabriel Scherer)
 

testsuite/tests/typing-sigsubst/mpr7852.mli

@@ -0,0 +1,12 @@
+module M : sig
+  type t
+  val foo : t -> int
+  val bar : t -> int
+end
+
+module N : sig
+  type outer
+  type t
+  val foo : t -> outer
+  val bar : t -> outer
+end with type outer := int

testsuite/tests/typing-sigsubst/test_locations.compilers.reference

@@ -46,8 +46,7 @@ Error: Signature mismatch:
          val create : elt -> t
        is not included in
          val create : unit -> t
-       File "test_loc_type_subst.ml", line 1, characters 11-47:
-         Expected declaration
+       File "test_functor.ml", line 5, characters 2-23: Expected declaration
        File "test_functor.ml", line 5, characters 2-23: Actual declaration
 File "test_loc_modtype_type_subst.ml", line 3, characters 15-42:
 Error: Signature mismatch:
@@ -63,6 +62,5 @@ Error: Signature mismatch:
          val create : elt -> t
        is not included in
          val create : unit -> t
-       File "test_loc_modtype_type_subst.ml", line 1, characters 16-52:
-         Expected declaration
+       File "test_functor.ml", line 5, characters 2-23: Expected declaration
        File "test_functor.ml", line 5, characters 2-23: Actual declaration

testsuite/tests/typing-sigsubst/test_locations.ml

@@ -1,7 +1,7 @@
 (* TEST
 files = "test_functor.ml test_loc_modtype_type_eq.ml \
          test_loc_modtype_type_subst.ml test_loc_type_eq.ml \
-         test_loc_type_subst.ml"
+         test_loc_type_subst.ml mpr7852.mli"
 * setup-ocamlc.byte-build-env
 ** ocamlc.byte
 module = "test_functor.ml"
@@ -18,4 +18,9 @@ ocamlc_byte_exit_status = "2"
 module = "test_loc_modtype_type_subst.ml"
 ocamlc_byte_exit_status = "2"
 ** check-ocamlc.byte-output
+** ocamlc.byte
+flags = "-w +32"
+module = "mpr7852.mli"
+ocamlc_byte_exit_status = "0"
+** check-ocamlc.byte-output
 *)

typing/subst.ml

@@ -29,15 +29,13 @@ type t =
     modules: Path.t Path.Map.t;
     modtypes: module_type Ident.Map.t;
     for_saving: bool;
-    loc: Location.t option;
   }
 
 let identity =
   { types = Path.Map.empty;
     modules = Path.Map.empty;
     modtypes = Ident.Map.empty;
     for_saving = false;
-    loc = None;
   }
 
 let add_type_path id p s = { s with types = Path.Map.add id (Path p) s.types }
@@ -53,13 +51,8 @@ let add_modtype id ty s = { s with modtypes = Ident.Map.add id ty s.modtypes }
 
 let for_saving s = { s with for_saving = true }
 
-let change_locs s loc = { s with loc = Some loc }
-
 let loc s x =
-  match s.loc with
-  | Some l -> l
-  | None ->
-    if s.for_saving && not !Clflags.keep_locs then Location.none else x
+  if s.for_saving && not !Clflags.keep_locs then Location.none else x
 
 let remove_loc =
   let open Ast_mapper in
@@ -502,11 +495,6 @@ let merge_tbls f m1 m2 =
 let merge_path_maps f m1 m2 =
   Path.Map.fold (fun k d accu -> Path.Map.add k (f d) accu) m1 m2
 
-let keep_latest_loc l1 l2 =
-  match l2 with
-  | None -> l1
-  | Some _ -> l2
-
 let type_replacement s = function
   | Path p -> Path (type_path s p)
   | Type_function { params; body } ->
@@ -522,5 +510,4 @@ let compose s1 s2 =
     modules = merge_path_maps (module_path s2) s1.modules s2.modules;
     modtypes = merge_tbls (modtype s2) s1.modtypes s2.modtypes;
     for_saving = s1.for_saving || s2.for_saving;
-    loc = keep_latest_loc s1.loc s2.loc;
   }

typing/subst.mli

@@ -42,7 +42,6 @@ val add_module_path: Path.t -> Path.t -> t -> t
 val add_modtype: Ident.t -> module_type -> t -> t
 val for_saving: t -> t
 val reset_for_saving: unit -> unit
-val change_locs: t -> Location.t -> t
 
 val module_path: t -> Path.t -> Path.t
 val type_path: t -> Path.t -> Path.t

typing/typemod.ml

@@ -589,15 +589,13 @@ let merge_constraint initial_env remove_aliases loc sg constr =
                              With_cannot_remove_constrained_type));
             fun s path -> Subst.add_type_function path ~params ~body s
        in
-       let sub = Subst.change_locs Subst.identity loc in
-       let sub = List.fold_left how_to_extend_subst sub !real_ids in
+       let sub = List.fold_left how_to_extend_subst Subst.identity !real_ids in
        Subst.signature sub sg
     | (_, _, Twith_modsubst (real_path, _)) ->
-       let sub = Subst.change_locs Subst.identity loc in
        let sub =
          List.fold_left
            (fun s path -> Subst.add_module_path path real_path s)
-           sub
+           Subst.identity
            !real_ids
        in
        Subst.signature sub sg