PR 33870

[pf3gnuchains/gcc-fork.git] / gcc / ada / sem_ch12.adb

diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb
index f48724d..ab5e162 100644 (file)
--- a/gcc/ada/sem_ch12.adb
+++ b/gcc/ada/sem_ch12.adb
@@ -10,14 +10,13 @@
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
--- ware  Foundation;  either version 2,  or (at your option) any later ver- --
+-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
 -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
 -- for  more details.  You should have  received  a copy of the GNU General --
--- Public License  distributed with GNAT;  see file COPYING.  If not, write --
--- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
--- Boston, MA 02110-1301, USA.                                              --
+-- Public License  distributed with GNAT; see file COPYING3.  If not, go to --
+-- http://www.gnu.org/licenses for a complete copy of the license.          --
 --                                                                          --
 -- GNAT was originally developed  by the GNAT team at  New York University. --
 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
@@ -2013,8 +2012,13 @@ package body Sem_Ch12 is
          --  create corresponding declarations for all entities in the formal
          --  part, so that names with the proper types are available in the
          --  specification of the formal package.
+         --  On the other hand, if there are no associations, then all the
+         --  formals must have defaults, and this will be checked by the
+         --  call to Analyze_Associations.
 
-         if No_Associations then
+         if Box_Present (N)
+           or else Nkind (First (Generic_Associations (N))) = N_Others_Choice
+         then
             declare
                Formal_Decl : Node_Id;
 
@@ -2143,10 +2147,30 @@ package body Sem_Ch12 is
       Formal := New_Copy (Pack_Id);
       Create_Instantiation_Source (N, Gen_Unit, False, S_Adjustment);
 
-      --  Make local generic without formals. The formals will be replaced with
-      --  internal declarations.
+      begin
+         --  Make local generic without formals. The formals will be replaced
+         --  with internal declarations.
+
+         New_N := Build_Local_Package;
+
+         --  If there are errors in the parameter list, Analyze_Associations
+         --  raises Instantiation_Error. Patch the declaration to prevent
+         --  further exception propagation.
+
+      exception
+         when Instantiation_Error =>
+
+            Enter_Name (Formal);
+            Set_Ekind  (Formal, E_Variable);
+            Set_Etype  (Formal, Any_Type);
+
+            if Parent_Installed then
+               Remove_Parent;
+            end if;
+
+            return;
+      end;
 
-      New_N := Build_Local_Package;
       Rewrite (N, New_N);
       Set_Defining_Unit_Name (Specification (New_N), Formal);
       Set_Generic_Parent (Specification (N), Gen_Unit);
@@ -2227,21 +2251,6 @@ package body Sem_Ch12 is
       Set_Etype (Pack_Id, Standard_Void_Type);
       Set_Scope (Pack_Id, Scope (Formal));
       Set_Has_Completion (Pack_Id, True);
-
-      --  If there are errors in the parameter list, Analyze_Associations
-      --  raises Instantiation_Error. Patch the declaration to prevent
-      --  further exception propagation.
-
-      exception
-         when Instantiation_Error =>
-
-            Enter_Name (Formal);
-            Set_Ekind  (Formal, E_Variable);
-            Set_Etype  (Formal, Any_Type);
-
-            if Parent_Installed then
-               Remove_Parent;
-            end if;
    end Analyze_Formal_Package;
 
    ---------------------------------
@@ -4878,8 +4887,8 @@ package body Sem_Ch12 is
    is
       Loc      : constant Source_Ptr := Sloc (Gen_Id);
       Gen_Par  : Entity_Id := Empty;
-      Inst_Par : Entity_Id;
       E        : Entity_Id;
+      Inst_Par : Entity_Id;
       S        : Node_Id;
 
       function Find_Generic_Child
@@ -5146,7 +5155,22 @@ package body Sem_Ch12 is
          --  to be installed, if they are not of the same generation.
 
          Analyze (Prefix (Gen_Id));
+
+         --  In the unlikely case that a local declaration hides the name
+         --  of the parent package, locate it on the homonym chain. If the
+         --  context is an instance of the parent, the renaming entity is
+         --  flagged as such.
+
          Inst_Par := Entity (Prefix (Gen_Id));
+         while Present (Inst_Par)
+           and then Ekind (Inst_Par) /= E_Package
+           and then Ekind (Inst_Par) /= E_Generic_Package
+         loop
+            Inst_Par := Homonym (Inst_Par);
+         end loop;
+
+         pragma Assert (Present (Inst_Par));
+         Set_Entity (Prefix (Gen_Id), Inst_Par);
 
          if In_Enclosing_Instance then
             null;
@@ -5884,9 +5908,8 @@ package body Sem_Ch12 is
          end if;
 
       elsif Nkind (N) = N_Aggregate
-              or else Nkind (N) = N_Extension_Aggregate
+        or else Nkind (N) = N_Extension_Aggregate
       then
-
          if not Instantiating then
             Set_Associated_Node (N, New_N);
 
@@ -8431,7 +8454,7 @@ package body Sem_Ch12 is
          Gen_Body := Unit_Declaration_Node (Gen_Body_Id);
 
          Create_Instantiation_Source
-          (Inst_Node, Gen_Body_Id, False, S_Adjustment);
+           (Inst_Node, Gen_Body_Id, False, S_Adjustment);
 
          Act_Body :=
            Copy_Generic_Node