2013-01-03 Basile Starynkevitch <basile@starynkevitch.net>

	MELT branch merged with trunk rev 194833 using svnmerge.py



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/branches/melt-branch@194835 138bc75d-0d04-0410-961f-82ee72b054a4

1 files changed, 50 insertions, 6 deletions

diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb
index 60edce32f2d..ee883327054 100644
--- a/gcc/ada/sem_ch12.adb
+++ b/gcc/ada/sem_ch12.adb
@@ -1448,10 +1448,15 @@ package body Sem_Ch12 is
                   --  defined aspect/pragma Remote_Access_Type. In that case
                   --  the actual must be remote as well.
 
+                  --  If the current instantiation is the construction of a
+                  --  local copy for a formal package the actuals may be
+                  --  defaulted, and there is no matching actual to check.
+
                   if Nkind (Analyzed_Formal) = N_Formal_Type_Declaration
                     and then
                       Nkind (Formal_Type_Definition (Analyzed_Formal)) =
                                             N_Access_To_Object_Definition
+                     and then Present (Match)
                   then
                      declare
                         Formal_Ent : constant Entity_Id :=
@@ -4924,6 +4929,17 @@ package body Sem_Ch12 is
             Assoc := Associated_Node (Assoc);
          end if;
 
+         --  An additional special case: an unconstrained type in an object
+         --  declaration may have been rewritten as a local subtype constrained
+         --  by the expression in the declaration. We need to recover the
+         --  original entity which may be global.
+
+         if Present (Original_Node (Assoc))
+           and then Nkind (Parent (N)) = N_Object_Declaration
+         then
+            Assoc := Original_Node (Assoc);
+         end if;
+
          return Assoc;
       end if;
    end Get_Associated_Node;
@@ -10475,8 +10491,7 @@ package body Sem_Ch12 is
 
          --  This is a binding interpretation that applies to previous versions
          --  of the language, but for now we retain the milder check in order
-         --  to preserve ACATS tests.
-         --  These will be protested eventually ???
+         --  to preserve ACATS tests. These will be protested eventually ???
 
          if Ada_Version < Ada_2012 then
             Check_Mode_Conformant
@@ -12139,8 +12154,8 @@ package body Sem_Ch12 is
       E1 := First_Entity (Form);
       E2 := First_Entity (Act);
       while Present (E1) and then E1 /= First_Private_Entity (Form) loop
-         --  Could this test be a single condition???
-         --  Seems like it could, and isn't FPE (Form) a constant anyway???
+         --  Could this test be a single condition??? Seems like it could, and
+         --  isn't FPE (Form) a constant anyway???
 
          if not Is_Internal (E1)
            and then Present (Parent (E1))
@@ -12406,7 +12421,7 @@ package body Sem_Ch12 is
                   --  provide additional warning which might explain the error.
 
                   Set_Is_Immediately_Visible (Cur, Vis);
-                  Error_Msg_NE ("& hides outer unit with the same name?",
+                  Error_Msg_NE ("& hides outer unit with the same name??",
                     N, Defining_Unit_Name (N));
                end if;
 
@@ -12981,7 +12996,36 @@ package body Sem_Ch12 is
             end if;
 
             if Is_Global (E) then
-               Set_Global_Type (N, N2);
+
+               --  If the entity is a package renaming that is the prefix of
+               --  an expanded name, it has been rewritten as the renamed
+               --  package, which is necessary semantically but complicates
+               --  ASIS tree traversal, so we recover the original entity to
+               --  expose the renaming. Take into account that the context may
+               --  be a nested generic and that the original node may itself
+               --  have an associated node.
+
+               if Ekind (E) = E_Package
+                 and then Nkind (Parent (N)) = N_Expanded_Name
+                 and then Present (Original_Node (N2))
+                 and then Present (Entity (Original_Node (N2)))
+                 and then Is_Entity_Name (Entity (Original_Node (N2)))
+               then
+                  if Is_Global (Entity (Original_Node (N2))) then
+                     N2 := Original_Node (N2);
+                     Set_Associated_Node (N, N2);
+                     Set_Global_Type (N, N2);
+
+                  else
+                     --  Renaming is local, and will be resolved in instance
+
+                     Set_Associated_Node (N, Empty);
+                     Set_Etype  (N, Empty);
+                  end if;
+
+               else
+                  Set_Global_Type (N, N2);
+               end if;
 
             elsif Nkind (N) = N_Op_Concat
               and then Is_Generic_Type (Etype (N2))