From 3cea553e33fd93a561d21180ff47388ed031318e Mon Sep 17 00:00:00 2001
From: soubiran
Date: Wed, 23 Apr 2008 15:13:03 +0000
Subject: correction d'un bug sur la compostion des substitutions induites par
 les alias de module et l'application d'un foncteur.

git-svn-id: svn+ssh://scm.gforge.inria.fr/svn/coq/trunk@10838 85f007b7-540e-0410-9357-904b9bb8a0f7
---
 kernel/mod_typing.ml   |  8 +++++++-
 library/declaremods.ml | 19 +++++++++++++++----
 2 files changed, 22 insertions(+), 5 deletions(-)

diff --git a/kernel/mod_typing.ml b/kernel/mod_typing.ml
index b1daea2287..09edc63f63 100644
--- a/kernel/mod_typing.ml
+++ b/kernel/mod_typing.ml
@@ -266,7 +266,13 @@ and translate_struct_entry env mse = match mse with
       let sub2 = match eval_struct env (SEBident mp) with
 	| SEBstruct (msid,sign) -> subst_key (map_msid msid mp) sub2
 	| _ -> sub2 in
-      let sub3 = update_subst_alias sub2 (join_alias sub1 (map_mbid farg_id mp None)) in
+       let sub3=
+	if sub1 = empty_subst then
+	  update_subst_alias sub2 (map_mbid farg_id mp None)
+	else
+	  update_subst_alias sub2
+	    (join_alias sub1 (map_mbid farg_id mp None))
+       in
       let sub = if sub2 = sub3 then
 	join sub1 sub2 else join (join sub1 sub2) sub3 in
       let sub = join_alias sub (map_mbid farg_id mp None) in
diff --git a/library/declaremods.ml b/library/declaremods.ml
index 93e322e2c4..5f7daa9b51 100644
--- a/library/declaremods.ml
+++ b/library/declaremods.ml
@@ -564,8 +564,13 @@ let rec get_modtype_substobjs env = function
 	    (subst_key (map_msid msid mp) sub_alias)
 	      (map_msid msid mp)
 	| _ -> sub_alias in
-      let sub3 = update_subst_alias sub_alias
-	(join_alias sub1 (map_mbid farg_id mp None)) in
+      let sub3=
+	if sub1 = empty_subst then
+	  update_subst_alias sub_alias (map_mbid farg_id mp None)
+	else
+	  update_subst_alias sub_alias
+	    (join_alias sub1 (map_mbid farg_id mp None))
+      in
       let sub = if sub_alias = sub3 then
 	join sub1 sub_alias else join (join sub1 sub_alias) sub3 in
       let sub = join_alias sub (map_mbid farg_id mp None) in
@@ -876,8 +881,14 @@ let rec get_module_substobjs env = function
 	    (subst_key (map_msid msid mp) sub_alias)
 	      (map_msid msid mp)
 	| _ -> sub_alias in
-      let sub3 = update_subst_alias sub_alias
-	(join_alias sub1 (map_mbid farg_id mp None)) in
+
+      let sub3=
+	if sub1 = empty_subst then
+	  update_subst_alias sub_alias (map_mbid farg_id mp None)
+	else
+	  update_subst_alias sub_alias
+	    (join_alias sub1 (map_mbid farg_id mp None))
+      in
       let sub = if sub_alias = sub3 then
 	join sub1 sub_alias else join (join sub1 sub_alias) sub3 in
       let sub = join_alias sub (map_mbid farg_id mp None) in
-- 
cgit v1.2.3