[multiple changes]

2010-10-19  Tristan Gingold  <gingold@adacore.com>

	* init.c: On Alpha/VMS, only adjust PC for HPARITH.

2010-10-19  Tristan Gingold  <gingold@adacore.com>

	* sem_attr.adb (Eval_Attribute): Handle Attribute_Ref, which can be
	evaluated on VMS.

2010-10-19  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch12.adb (Check_Generic_Child_Unit): Handle properly the case of
	an instantiation of a renaming of the implicit generic child that
	appears within an instance of its parent.

2010-10-19  Thomas Quinot  <quinot@adacore.com>

	* exp_ch9.adb: Minor reformatting.
	* einfo.adb, einfo.ads, atree.adb, atree.ads, exp_dist.adb, atree.h:
	(Referenced_Object): Remove unused entity attribute.
	(Direct_Primitive_Operations): Move to Elist10, this is set for all
	tagged types, including synchronous ones, so can't use field15 which is
	used as Storage_Size_Variable for task types and Entry_Bodies_Array for
	protected types.
	(Add_RACW_Primitive_Declarations_And_Bodies): Remove bogus guard
	against Concurrent_Types (we must handle the case of a RACW designating
	a class-wide private synchronous type).
	Use Direct_Primitive_Operations, not Primitive_Operations, since we
	really want the former.

2010-10-19  Bob Duff  <duff@adacore.com>

	* sem_ch8.adb (Pop_Scope): Change "return;" to "raise Program_Error;".

2010-10-19  Javier Miranda  <miranda@adacore.com>

	* exp_ch4.adb (Expand_Set_Membership.Make_Cond): Add missing support
	for N_Range nodes.

From-SVN: r165689

13 files changed, 143 insertions, 84 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index acc417c..52d61914 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,42 @@
+2010-10-19  Tristan Gingold  <gingold@adacore.com>
+
+	* init.c: On Alpha/VMS, only adjust PC for HPARITH.
+
+2010-10-19  Tristan Gingold  <gingold@adacore.com>
+
+	* sem_attr.adb (Eval_Attribute): Handle Attribute_Ref, which can be
+	evaluated on VMS.
+
+2010-10-19  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_ch12.adb (Check_Generic_Child_Unit): Handle properly the case of
+	an instantiation of a renaming of the implicit generic child that
+	appears within an instance of its parent.
+
+2010-10-19  Thomas Quinot  <quinot@adacore.com>
+
+	* exp_ch9.adb: Minor reformatting.
+	* einfo.adb, einfo.ads, atree.adb, atree.ads, exp_dist.adb, atree.h:
+	(Referenced_Object): Remove unused entity attribute.
+	(Direct_Primitive_Operations): Move to Elist10, this is set for all
+	tagged types, including synchronous ones, so can't use field15 which is
+	used as Storage_Size_Variable for task types and Entry_Bodies_Array for
+	protected types.
+	(Add_RACW_Primitive_Declarations_And_Bodies): Remove bogus guard
+	against Concurrent_Types (we must handle the case of a RACW designating
+	a class-wide private synchronous type).
+	Use Direct_Primitive_Operations, not Primitive_Operations, since we
+	really want the former.
+
+2010-10-19  Bob Duff  <duff@adacore.com>
+
+	* sem_ch8.adb (Pop_Scope): Change "return;" to "raise Program_Error;".
+
+2010-10-19  Javier Miranda  <miranda@adacore.com>
+
+	* exp_ch4.adb (Expand_Set_Membership.Make_Cond): Add missing support
+	for N_Range nodes.
+
 2010-10-19  Thomas Quinot  <quinot@adacore.com>
 
 	* einfo.ads, atree.ads: Minor comment fixes.
diff --git a/gcc/ada/atree.adb b/gcc/ada/atree.adb
index 4b518b1..957cca5 100644
--- a/gcc/ada/atree.adb
+++ b/gcc/ada/atree.adb
@@ -2455,6 +2455,17 @@ package body Atree is
          end if;
       end Elist8;
 
+      function Elist10 (N : Node_Id) return Elist_Id is
+         pragma Assert (Nkind (N) in N_Entity);
+         Value : constant Union_Id := Nodes.Table (N + 1).Field10;
+      begin
+         if Value = 0 then
+            return No_Elist;
+         else
+            return Elist_Id (Value);
+         end if;
+      end Elist10;
+
       function Elist13 (N : Node_Id) return Elist_Id is
          pragma Assert (Nkind (N) in N_Entity);
          Value : constant Union_Id := Nodes.Table (N + 2).Field6;
@@ -4672,6 +4683,12 @@ package body Atree is
          Nodes.Table (N + 1).Field8 := Union_Id (Val);
       end Set_Elist8;
 
+      procedure Set_Elist10 (N : Node_Id; Val : Elist_Id) is
+      begin
+         pragma Assert (Nkind (N) in N_Entity);
+         Nodes.Table (N + 1).Field10 := Union_Id (Val);
+      end Set_Elist10;
+
       procedure Set_Elist13 (N : Node_Id; Val : Elist_Id) is
       begin
          pragma Assert (Nkind (N) in N_Entity);
diff --git a/gcc/ada/atree.ads b/gcc/ada/atree.ads
index 06e06de..904c637 100644
--- a/gcc/ada/atree.ads
+++ b/gcc/ada/atree.ads
@@ -193,8 +193,8 @@ package Atree is
    --   Uint6         Synonym for Field6 typed as Uint (Empty = Uint_0)
 
    --   Similar definitions for Field7 to Field28 (and Node7-Node28,
-   --   Elist7-Elist28, Uint7-Uint28, Ureal7-Ureal28). Note that not all
-   --   these functions are defined, only the ones that are actually used.
+   --   Elist7-Elist28, Uint7-Uint28, Ureal7-Ureal28). Note that not all these
+   --   functions are defined, only the ones that are actually used.
 
    function Last_Node_Id return Node_Id;
    pragma Inline (Last_Node_Id);
@@ -1112,6 +1112,9 @@ package Atree is
       function Elist8 (N : Node_Id) return Elist_Id;
       pragma Inline (Elist8);
 
+      function Elist10 (N : Node_Id) return Elist_Id;
+      pragma Inline (Elist10);
+
       function Elist13 (N : Node_Id) return Elist_Id;
       pragma Inline (Elist13);
 
@@ -2172,6 +2175,9 @@ package Atree is
       procedure Set_Elist8 (N : Node_Id; Val : Elist_Id);
       pragma Inline (Set_Elist8);
 
+      procedure Set_Elist10 (N : Node_Id; Val : Elist_Id);
+      pragma Inline (Set_Elist10);
+
       procedure Set_Elist13 (N : Node_Id; Val : Elist_Id);
       pragma Inline (Set_Elist13);
 
diff --git a/gcc/ada/atree.h b/gcc/ada/atree.h
index 447338f..454ed14 100644
--- a/gcc/ada/atree.h
+++ b/gcc/ada/atree.h
@@ -427,6 +427,7 @@ extern Node_Id Current_Error_Node;
 #define Elist3(N)     Field3  (N)
 #define Elist4(N)     Field4  (N)
 #define Elist8(N)     Field8  (N)
+#define Elist10(N)    Field10 (N)
 #define Elist13(N)    Field13 (N)
 #define Elist15(N)    Field15 (N)
 #define Elist16(N)    Field16 (N)
diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb
index 0ea9515..48672cf 100644
--- a/gcc/ada/einfo.adb
+++ b/gcc/ada/einfo.adb
@@ -85,10 +85,10 @@ package body Einfo is
    --    Current_Value                   Node9
    --    Renaming_Map                    Uint9
 
+   --    Direct_Primitive_Operations     Elist10
    --    Discriminal_Link                Node10
    --    Handler_Records                 List10
    --    Normalized_Position_Max         Uint10
-   --    Referenced_Object               Node10
 
    --    Component_Bit_Offset            Uint11
    --    Full_View                       Node11
@@ -121,7 +121,6 @@ package body Einfo is
    --    Entry_Parameters_Type           Node15
    --    Extra_Formal                    Node15
    --    Lit_Indexes                     Node15
-   --    Direct_Primitive_Operations     Elist15
    --    Related_Instance                Node15
    --    Scale_Value                     Uint15
    --    Storage_Size_Variable           Node15
@@ -819,9 +818,8 @@ package body Einfo is
 
    function Direct_Primitive_Operations (Id : E) return L is
    begin
-      pragma Assert (Is_Tagged_Type (Id)
-        and then not Is_Concurrent_Type (Id));
-      return Elist15 (Id);
+      pragma Assert (Is_Tagged_Type (Id));
+      return Elist10 (Id);
    end Direct_Primitive_Operations;
 
    function Directly_Designated_Type (Id : E) return E is
@@ -2429,12 +2427,6 @@ package body Einfo is
       return Flag227 (Id);
    end Referenced_As_Out_Parameter;
 
-   function Referenced_Object (Id : E) return N is
-   begin
-      pragma Assert (Is_Type (Id));
-      return Node10 (Id);
-   end Referenced_Object;
-
    function Register_Exception_Call (Id : E) return N is
    begin
       pragma Assert (Ekind (Id) = E_Exception);
@@ -4832,15 +4824,8 @@ package body Einfo is
 
    procedure Set_Direct_Primitive_Operations (Id : E; V : L) is
    begin
-      pragma Assert
-        (Is_Tagged_Type (Id)
-           and then
-             (Is_Record_Type (Id)
-                or else
-              Is_Incomplete_Type (Id)
-                or else
-              Ekind_In (Id, E_Private_Type, E_Private_Subtype)));
-      Set_Elist15 (Id, V);
+      pragma Assert (Is_Tagged_Type (Id));
+      Set_Elist10 (Id, V);
    end Set_Direct_Primitive_Operations;
 
    procedure Set_Prival (Id : E; V : E) is
@@ -4908,12 +4893,6 @@ package body Einfo is
       Set_Flag227 (Id, V);
    end Set_Referenced_As_Out_Parameter;
 
-   procedure Set_Referenced_Object (Id : E; V : N) is
-   begin
-      pragma Assert (Is_Type (Id));
-      Set_Node10 (Id, V);
-   end Set_Referenced_Object;
-
    procedure Set_Register_Exception_Call (Id : E; V : N) is
    begin
       pragma Assert (Ekind (Id) = E_Exception);
@@ -7432,8 +7411,13 @@ package body Einfo is
    procedure Write_Field10_Name (Id : Entity_Id) is
    begin
       case Ekind (Id) is
-         when Type_Kind                                    =>
-            Write_Str ("Referenced_Object");
+         when Class_Wide_Kind                              |
+              Incomplete_Kind                              |
+              E_Record_Type                                |
+              E_Record_Subtype                             |
+              Private_Kind                                 |
+              Concurrent_Kind                              =>
+            Write_Str ("Direct_Primitive_Operations");
 
          when E_In_Parameter                               |
               E_Constant                                   =>
@@ -7616,13 +7600,6 @@ package body Einfo is
               Task_Kind                                    =>
             Write_Str ("Storage_Size_Variable");
 
-         when Class_Wide_Kind                              |
-              Incomplete_Kind                              |
-              E_Record_Type                                |
-              E_Record_Subtype                             |
-              Private_Kind                                 =>
-            Write_Str ("Direct_Primitive_Operations");
-
          when E_Component                                  =>
             Write_Str ("DT_Entry_Count");
 
diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads
index 6accd05..de37ed3 100644
--- a/gcc/ada/einfo.ads
+++ b/gcc/ada/einfo.ads
@@ -769,7 +769,7 @@ package Einfo is
 --       Present in floating point types and subtypes and decimal types and
 --       subtypes. Contains the Digits value specified in the declaration.
 
---    Direct_Primitive_Operations (Elist15)
+--    Direct_Primitive_Operations (Elist10)
 --       Present in tagged types and subtypes (including synchronized types),
 --       in tagged private types and in tagged incomplete types. Element list
 --       of entities for primitive operations of the tagged type. Not present
@@ -3308,12 +3308,6 @@ package Einfo is
 --       we have a separate warning for variables that are only assigned and
 --       never read, and out parameters are a special case.
 
---    Referenced_Object (Node10)
---       Present in all type entities. Set non-Empty only for type entities
---       constructed for unconstrained objects, or objects that depend on
---       discriminants. Points to the expression from which the actual
---       subtype of the object can be evaluated.
-
 --    Register_Exception_Call (Node20)
 --       Present in exception entities. When an exception is declared,
 --       a call is expanded to Register_Exception. This field points to
@@ -4697,7 +4691,6 @@ package Einfo is
 
    --    Associated_Node_For_Itype           (Node8)
    --    Class_Wide_Type                     (Node9)
-   --    Referenced_Object                   (Node10)
    --    Full_View                           (Node11)
    --    Esize                               (Uint12)
    --    RM_Size                             (Uint13)
@@ -4854,6 +4847,7 @@ package Einfo is
 
    --  E_Class_Wide_Type
    --  E_Class_Wide_Subtype
+   --    Direct_Primitive_Operations         (Elist10)
    --    Cloned_Subtype                      (Node16)   (subtype case only)
    --    First_Entity                        (Node17)
    --    Equivalent_Type                     (Node18)   (always Empty for type)
@@ -5126,6 +5120,7 @@ package Einfo is
 
    --  E_Incomplete_Type
    --  E_Incomplete_Subtype
+   --    Direct_Primitive_Operations         (Elist10)
    --    Non_Limited_View                    (Node17)
    --    Private_Dependents                  (Elist18)
    --    Discriminant_Constraint             (Elist21)
@@ -5280,7 +5275,7 @@ package Einfo is
 
    --  E_Private_Type
    --  E_Private_Subtype
-   --    Direct_Primitive_Operations         (Elist15)
+   --    Direct_Primitive_Operations         (Elist10)
    --    First_Entity                        (Node17)
    --    Private_Dependents                  (Elist18)
    --    Underlying_Full_View                (Node19)
@@ -5369,6 +5364,7 @@ package Einfo is
 
    --  E_Protected_Type
    --  E_Protected_Subtype
+   --    Direct_Primitive_Operations         (Elist10)
    --    Entry_Bodies_Array                  (Node15)
    --    First_Private_Entity                (Node16)
    --    First_Entity                        (Node17)
@@ -5387,7 +5383,7 @@ package Einfo is
 
    --  E_Record_Type
    --  E_Record_Subtype
-   --    Direct_Primitive_Operations         (Elist15)
+   --    Direct_Primitive_Operations         (Elist10)
    --    Access_Disp_Table                   (Elist16)  (base type only)
    --    Dispatch_Table_Wrappers             (Elist26)  (base type only)
    --    Cloned_Subtype                      (Node16)   (subtype case only)
@@ -5420,7 +5416,7 @@ package Einfo is
 
    --  E_Record_Type_With_Private
    --  E_Record_Subtype_With_Private
-   --    Direct_Primitive_Operations         (Elist15)
+   --    Direct_Primitive_Operations         (Elist10)
    --    Access_Disp_Table                   (Elist16)  (base type only)
    --    Dispatch_Table_Wrappers             (Elist26)  (base type only)
    --    First_Entity                        (Node17)
@@ -5494,6 +5490,7 @@ package Einfo is
 
    --  E_Task_Type
    --  E_Task_Subtype
+   --    Direct_Primitive_Operations         (Elist10)
    --    Storage_Size_Variable               (Node15)   (base type only)
    --    First_Private_Entity                (Node16)
    --    First_Entity                        (Node17)
@@ -6104,7 +6101,6 @@ package Einfo is
    function Referenced                          (Id : E) return B;
    function Referenced_As_LHS                   (Id : E) return B;
    function Referenced_As_Out_Parameter         (Id : E) return B;
-   function Referenced_Object                   (Id : E) return N;
    function Register_Exception_Call             (Id : E) return N;
    function Related_Array_Object                (Id : E) return E;
    function Related_Expression                  (Id : E) return N;
@@ -6287,7 +6283,7 @@ package Einfo is
    --  predicate is true only if the value is set (Known) and is set to a
    --  compile time known value. Note that in the case of Alignment and
    --  Normalized_First_Bit, dynamic values are not possible, so we do not
-   --  need a separate Known_Static calls in these cases. The not set (unknown
+   --  need a separate Known_Static calls in these cases. The not set (unknown)
    --  values are as follows:
 
    --    Alignment               Uint_0 or No_Uint
@@ -6675,7 +6671,6 @@ package Einfo is
    procedure Set_Referenced                      (Id : E; V : B := True);
    procedure Set_Referenced_As_LHS               (Id : E; V : B := True);
    procedure Set_Referenced_As_Out_Parameter     (Id : E; V : B := True);
-   procedure Set_Referenced_Object               (Id : E; V : N);
    procedure Set_Register_Exception_Call         (Id : E; V : N);
    procedure Set_Related_Array_Object            (Id : E; V : E);
    procedure Set_Related_Expression              (Id : E; V : N);
@@ -7393,7 +7388,6 @@ package Einfo is
    pragma Inline (Referenced);
    pragma Inline (Referenced_As_LHS);
    pragma Inline (Referenced_As_Out_Parameter);
-   pragma Inline (Referenced_Object);
    pragma Inline (Register_Exception_Call);
    pragma Inline (Related_Array_Object);
    pragma Inline (Related_Expression);
@@ -7784,7 +7778,6 @@ package Einfo is
    pragma Inline (Set_Referenced);
    pragma Inline (Set_Referenced_As_LHS);
    pragma Inline (Set_Referenced_As_Out_Parameter);
-   pragma Inline (Set_Referenced_Object);
    pragma Inline (Set_Register_Exception_Call);
    pragma Inline (Set_Related_Array_Object);
    pragma Inline (Set_Related_Expression);
diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index d501cd5..efa0e74 100644
--- a/gcc/ada/exp_ch4.adb
+++ b/gcc/ada/exp_ch4.adb
@@ -3351,7 +3351,7 @@ package body Exp_Ch4 is
 
          --    number-of-elements * component_type'Max_Size_In_Storage_Elements
 
-         --  which avoids this problem. All this is a big bogus, but it does
+         --  which avoids this problem. All this is a bit bogus, but it does
          --  mean we catch common cases of trying to allocate arrays that
          --  are too large, and which in the absence of a check results in
          --  undetected chaos ???
@@ -4348,8 +4348,9 @@ package body Exp_Ch4 is
             R    : constant Node_Id := Relocate_Node (Alt);
 
          begin
-            if Is_Entity_Name (Alt)
-              and then Is_Type (Entity (Alt))
+            if (Is_Entity_Name (Alt)
+                  and then Is_Type (Entity (Alt)))
+              or else Nkind (Alt) = N_Range
             then
                Cond :=
                  Make_In (Sloc (Alt),
diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb
index b38e2ab..171c81c 100644
--- a/gcc/ada/exp_ch9.adb
+++ b/gcc/ada/exp_ch9.adb
@@ -7420,11 +7420,10 @@ package body Exp_Ch9 is
          --  Generate a specification without a letter suffix in order to
          --  override an interface function or procedure.
 
-         Spec :=
-           Build_Protected_Sub_Specification (N, Pid, Dispatching_Mode);
+         Spec := Build_Protected_Sub_Specification (N, Pid, Dispatching_Mode);
 
-         --  The formal parameters become the actuals of the protected
-         --  function or procedure call.
+         --  The formal parameters become the actuals of the protected function
+         --  or procedure call.
 
          Actuals := New_List;
          Formal  := First (Parameter_Specifications (Spec));
@@ -7457,8 +7456,8 @@ package body Exp_Ch9 is
 
          return
            Make_Subprogram_Body (Loc,
-             Declarations  => Empty_List,
-             Specification => Spec,
+             Declarations               => Empty_List,
+             Specification              => Spec,
              Handled_Statement_Sequence =>
                Make_Handled_Sequence_Of_Statements (Loc, Stmts));
       end Build_Dispatching_Subprogram_Body;
diff --git a/gcc/ada/exp_dist.adb b/gcc/ada/exp_dist.adb
index 2a0f800..84cba49 100644
--- a/gcc/ada/exp_dist.adb
+++ b/gcc/ada/exp_dist.adb
@@ -1314,15 +1314,17 @@ package body Exp_Dist is
       end if;
 
       --  Build callers, receivers for every primitive operations and a RPC
-      --  receiver for this type.
+      --  receiver for this type. Note that we use Direct_Primitive_Operations,
+      --  not Primitive_Operations, because we really want just the primitives
+      --  of the tagged type itself, and in the case of a tagged synchronized
+      --  type we do not want to get the primitives of the corresponding
+      --  record type).
 
-      if not Is_Concurrent_Type (Designated_Type)
-        and then Present (Primitive_Operations (Designated_Type))
-      then
+      if Present (Direct_Primitive_Operations (Designated_Type)) then
          Overload_Counter_Table.Reset;
 
          Current_Primitive_Elmt :=
-           First_Elmt (Primitive_Operations (Designated_Type));
+           First_Elmt (Direct_Primitive_Operations (Designated_Type));
          while Current_Primitive_Elmt /= No_Elmt loop
             Current_Primitive := Node (Current_Primitive_Elmt);
 
diff --git a/gcc/ada/init.c b/gcc/ada/init.c
index 766dbdd..60b7cfd 100644
--- a/gcc/ada/init.c
+++ b/gcc/ada/init.c
@@ -1396,13 +1396,13 @@ __gnat_handle_vms_condition (int *sigargs, void *mechargs)
 	    exception = &storage_error;
 	    msg = "stack overflow (or erroneous memory access)";
 	  }
-	__gnat_adjust_context_for_raise (0, (void *)mechargs);
+	__gnat_adjust_context_for_raise (SS$_ACCVIO, (void *)mechargs);
 	break;
 
       case SS$_STKOVF:
 	exception = &storage_error;
 	msg = "stack overflow";
-	__gnat_adjust_context_for_raise (0, (void *)mechargs);
+	__gnat_adjust_context_for_raise (SS$_STKOVF, (void *)mechargs);
 	break;
 
       case SS$_HPARITH:
@@ -1411,11 +1411,7 @@ __gnat_handle_vms_condition (int *sigargs, void *mechargs)
 #else
 	exception = &constraint_error;
 	msg = "arithmetic error";
-#ifndef __alpha__
-	/* No need to adjust pc on Alpha: the pc is already on the instruction
-	   after the trapping one.  */
-	__gnat_adjust_context_for_raise (0, (void *)mechargs);
-#endif
+	__gnat_adjust_context_for_raise (SS$_HPARITH, (void *)mechargs);
 #endif
 	break;
 
@@ -1491,17 +1487,20 @@ __gnat_install_handler (void)
 void
 __gnat_adjust_context_for_raise (int signo ATTRIBUTE_UNUSED, void *ucontext)
 {
-  /* Add one to the address of the instruction signaling the condition,
-     located in the sigargs array.  */
+  if (signo == SS$_HPARITH)
+    {
+      /* Sub one to the address of the instruction signaling the condition,
+         located in the sigargs array.  */
 
-  CHF$MECH_ARRAY * mechargs = (CHF$MECH_ARRAY *) ucontext;
-  CHF$SIGNAL_ARRAY * sigargs
-    = (CHF$SIGNAL_ARRAY *) mechargs->chf$q_mch_sig_addr;
+      CHF$MECH_ARRAY * mechargs = (CHF$MECH_ARRAY *) ucontext;
+      CHF$SIGNAL_ARRAY * sigargs
+        = (CHF$SIGNAL_ARRAY *) mechargs->chf$q_mch_sig_addr;
 
-  int vcount = sigargs->chf$is_sig_args;
-  int * pc_slot = & (&sigargs->chf$l_sig_name)[vcount-2];
+      int vcount = sigargs->chf$is_sig_args;
+      int * pc_slot = & (&sigargs->chf$l_sig_name)[vcount-2];
 
-  (*pc_slot) ++;
+      (*pc_slot)--;
+    }
 }
 
 #endif
diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
index 1691fab..f520b4b 100644
--- a/gcc/ada/sem_attr.adb
+++ b/gcc/ada/sem_attr.adb
@@ -6910,6 +6910,13 @@ package body Sem_Attr is
             end case;
          end;
 
+      ---------
+      -- Ref --
+      ---------
+
+      when Attribute_Ref =>
+         Fold_Uint (N, Expr_Value (E1), True);
+
       ---------------
       -- Remainder --
       ---------------
@@ -7679,7 +7686,6 @@ package body Sem_Attr is
            Attribute_Position                 |
            Attribute_Priority                 |
            Attribute_Read                     |
-           Attribute_Ref                      |
            Attribute_Result                   |
            Attribute_Storage_Pool             |
            Attribute_Storage_Size             |
diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb
index 45b61bb..4b15644 100644
--- a/gcc/ada/sem_ch12.adb
+++ b/gcc/ada/sem_ch12.adb
@@ -5309,6 +5309,25 @@ package body Sem_Ch12 is
             then
                Install_Parent (Inst_Par);
                Parent_Installed := True;
+
+            --  The generic unit may be the renaming of the implicit child
+            --  present in an instance. In that case the parent instance is
+            --  obtained from the name of the renamed entity.
+
+            elsif Ekind (Entity (Gen_Id)) = E_Generic_Package
+              and then Present (Renamed_Entity (Entity (Gen_Id)))
+              and then Is_Child_Unit (Renamed_Entity (Entity (Gen_Id)))
+            then
+               declare
+                  Renamed_Package : constant Node_Id :=
+                    Name (Parent (Entity (Gen_Id)));
+               begin
+                  if Nkind (Renamed_Package) = N_Expanded_Name then
+                     Inst_Par := Entity (Prefix (Renamed_Package));
+                     Install_Parent (Inst_Par);
+                     Parent_Installed := True;
+                  end if;
+               end;
             end if;
          end if;
 
diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb
index cdd8bf6..0e9d0b4 100644
--- a/gcc/ada/sem_ch8.adb
+++ b/gcc/ada/sem_ch8.adb
@@ -6683,7 +6683,7 @@ package body Sem_Ch8 is
            or else
          SST.Actions_To_Be_Wrapped_After  /= No_List
       then
-         return;
+         raise Program_Error;
       end if;
 
       --  Free last subprogram name if allocated, and pop scope