[multiple changes]

2013-10-14  Robert Dewar  <dewar@adacore.com>

	* freeze.adb (Freeze_Record): Don't give warning about packed
	and foreign convention.

2013-10-14  Ed Schonberg  <schonberg@adacore.com>

	* sem_aux.adb, sem_aux.ads (Package_Specification): New function, to
	replace the less efficient idiom Specification.
	(Unit_Declaration_Node (Pack_Id)), which handles library units and
	child units.
	* sem_ch3.adb, sem_ch10.adb, sem_prag.adb, sem_ch12.adb, sem_ch6.adb,
	exp_disp.adb, sem_cat.adb, exp_dist.adb: Use Package_Specification.

2013-10-14  Hristian Kirtchev  <kirtchev@adacore.com>

	* exp_attr.adb (Expand_Update_Attribute): Update the call to
	Process_Range_Update.
	(Process_Range_Update): Add new formal parameter Typ and associated
	comment on usage. Add local constant Index_Typ. Add a type conversion
	as part of the indexed component to ensure that the loop variable
	corresponds to the index type.

From-SVN: r203556

gcc/ada/ChangeLog

@@ -1,3 +1,26 @@
+2013-10-14  Robert Dewar  <dewar@adacore.com>
+
+	* freeze.adb (Freeze_Record): Don't give warning about packed
+	and foreign convention.
+
+2013-10-14  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_aux.adb, sem_aux.ads (Package_Specification): New function, to
+	replace the less efficient idiom Specification.
+	(Unit_Declaration_Node (Pack_Id)), which handles library units and
+	child units.
+	* sem_ch3.adb, sem_ch10.adb, sem_prag.adb, sem_ch12.adb, sem_ch6.adb,
+	exp_disp.adb, sem_cat.adb, exp_dist.adb: Use Package_Specification.
+
+2013-10-14  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* exp_attr.adb (Expand_Update_Attribute): Update the call to
+	Process_Range_Update.
+	(Process_Range_Update): Add new formal parameter Typ and associated
+	comment on usage. Add local constant Index_Typ. Add a type conversion
+	as part of the indexed component to ensure that the loop variable
+	corresponds to the index type.
+
 2013-10-14  Tristan Gingold  <gingold@adacore.com>
 
 	* a-exexpr-gcc.adb: Adjust comment.

gcc/ada/exp_attr.adb

@@ -6609,12 +6609,14 @@ package body Exp_Attr is
       procedure Process_Range_Update
         (Temp : Entity_Id;
          Comp : Node_Id;
-         Expr : Node_Id);
+         Expr : Node_Id;
+         Typ  : Entity_Id);
       --  Generate the statements necessary to update a slice of the prefix.
       --  The code is inserted before the attribute N. Temp denotes the entity
       --  of the anonymous object created to reflect the changes in values.
       --  Comp is range of the slice to be updated. Expr is an expression
-      --  yielding the new value of Comp.
+      --  yielding the new value of Comp. Typ is the type of the prefix of
+      --  attribute Update.
 
       -----------------------------------------
       -- Process_Component_Or_Element_Update --
@@ -6688,10 +6690,12 @@ package body Exp_Attr is
       procedure Process_Range_Update
         (Temp : Entity_Id;
          Comp : Node_Id;
-         Expr : Node_Id)
+         Expr : Node_Id;
+         Typ  : Entity_Id)
       is
-         Loc   : constant Source_Ptr := Sloc (Comp);
+         Index_Typ : constant Entity_Id  := Etype (First_Index (Typ));
-         Index : Entity_Id;
+         Loc       : constant Source_Ptr := Sloc (Comp);
+         Index     : Entity_Id;
 
       begin
          --  A range update appears as
@@ -6703,7 +6707,7 @@ package body Exp_Attr is
          --  value of Expr:
 
          --    for Index in Low .. High loop
-         --       Temp (Index) := Expr;
+         --       Temp (<Index_Typ> (Index)) := Expr;
          --    end loop;
 
          Index := Make_Temporary (Loc, 'I');
@@ -6722,7 +6726,8 @@ package body Exp_Attr is
                  Name       =>
                    Make_Indexed_Component (Loc,
                      Prefix      => New_Reference_To (Temp, Loc),
-                     Expressions => New_List (New_Reference_To (Index, Loc))),
+                     Expressions => New_List (
+                       Convert_To (Index_Typ, New_Reference_To (Index, Loc)))),
                  Expression => Relocate_Node (Expr))),
 
              End_Label        => Empty));
@@ -6730,10 +6735,10 @@ package body Exp_Attr is
 
       --  Local variables
 
-      Aggr  : constant Node_Id := First (Expressions (N));
+      Aggr  : constant Node_Id    := First (Expressions (N));
       Loc   : constant Source_Ptr := Sloc (N);
-      Pref  : constant Node_Id := Prefix (N);
+      Pref  : constant Node_Id    := Prefix (N);
-      Typ   : constant Entity_Id := Etype (Pref);
+      Typ   : constant Entity_Id  := Etype (Pref);
       Assoc : Node_Id;
       Comp  : Node_Id;
       Expr  : Node_Id;
@@ -6763,7 +6768,7 @@ package body Exp_Attr is
          Expr := Expression (Assoc);
          while Present (Comp) loop
             if Nkind (Comp) = N_Range then
-               Process_Range_Update (Temp, Comp, Expr);
+               Process_Range_Update (Temp, Comp, Expr, Typ);
             else
                Process_Component_Or_Element_Update (Temp, Comp, Expr, Typ);
             end if;

gcc/ada/exp_disp.adb

@@ -7645,7 +7645,7 @@ package body Exp_Disp is
       end if;
 
       return List_Containing (Parent (Typ)) =
-        Visible_Declarations (Specification (Unit_Declaration_Node (Scop)));
+        Visible_Declarations (Package_Specification (Scop));
    end Original_View_In_Visible_Part;
 
    ------------------
@@ -8446,8 +8446,7 @@ package body Exp_Disp is
            and then In_Private_Part (Current_Scope)
            and then
              List_Containing (Parent (Prim)) =
-               Private_Declarations
+               Private_Declarations (Package_Specification (Current_Scope))
-                (Specification (Unit_Declaration_Node (Current_Scope)))
            and then Original_View_In_Visible_Part (Typ)
          then
             --  We exclude Input and Output stream operations because

gcc/ada/exp_dist.adb

@@ -2874,8 +2874,7 @@ package body Exp_Dist is
 
          if RCI_Locator = Empty then
             RCI_Locator_Decl :=
-              RCI_Package_Locator
+              RCI_Package_Locator (Loc, Package_Specification (RCI_Package));
-                (Loc, Specification (Unit_Declaration_Node (RCI_Package)));
             Prepend_To (Current_Sem_Unit_Declarations, RCI_Locator_Decl);
             Analyze (RCI_Locator_Decl);
             RCI_Locator := Defining_Unit_Name (RCI_Locator_Decl);

gcc/ada/freeze.adb

@@ -2741,6 +2741,11 @@ package body Freeze is
 
                   if Has_Foreign_Convention (Etype (Comp))
                     and then Has_Pragma_Pack (Rec)
+
+                    --  Don't warn for aliased components, since override
+                    --  cannot happen in that case.
+
+                    and then not Is_Aliased (Comp)
                   then
                      declare
                         CN : constant Name_Id :=

gcc/ada/sem_aux.adb

@@ -1151,6 +1151,27 @@ package body Sem_Aux is
                   and then Has_Discriminants (Typ));
    end Object_Type_Has_Constrained_Partial_View;
 
+   ---------------------------
+   -- Package_Specification --
+   ---------------------------
+
+   function Package_Specification (Pack_Id : Entity_Id) return Node_Id is
+      N : Node_Id;
+
+   begin
+      N := Parent (Pack_Id);
+
+      while Nkind (N) /= N_Package_Specification loop
+         N := Parent (N);
+
+         if No (N) then
+            raise Program_Error;
+         end if;
+      end loop;
+
+      return N;
+   end Package_Specification;
+
    ---------------
    -- Tree_Read --
    ---------------

gcc/ada/sem_aux.ads

@@ -348,4 +348,8 @@ package Sem_Aux is
    --  it returns the subprogram, task or protected body node for it. The unit
    --  may be a child unit with any number of ancestors.
 
+   function Package_Specification (Pack_Id : Entity_Id) return Node_Id;
+   --  Given an entity for a package or generic package, return corresponding
+   --  package specification. Simplifies handling of child units, and better
+   --  than the old idiom: Specification (Unit_Declaration_Node (Pack_Id).
 end Sem_Aux;

gcc/ada/sem_cat.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2012, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2013, Free Software Foundation, Inc.         --
 --                                                                          --
 -- 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- --
@@ -561,8 +561,7 @@ package body Sem_Cat is
         and then Is_Package_Or_Generic_Package (Unit_Entity)
         and then Unit_Kind /= N_Package_Body
         and then List_Containing (N) =
-                   Visible_Declarations
+                   Visible_Declarations (Package_Specification (Unit_Entity))
-                     (Specification (Unit_Declaration_Node (Unit_Entity)))
         and then not In_Package_Body (Unit_Entity)
         and then not In_Instance;
 

gcc/ada/sem_ch10.adb

@@ -4028,7 +4028,7 @@ package body Sem_Ch10 is
          Is_Private_Descendant (P_Name)
            or else Private_Present (Parent (Lib_Unit)));
 
-      P_Spec := Specification (Unit_Declaration_Node (P_Name));
+      P_Spec := Package_Specification (P_Name);
       Push_Scope (P_Name);
 
       --  Save current visibility of unit

gcc/ada/sem_ch12.adb

@@ -5664,8 +5664,7 @@ package body Sem_Ch12 is
                            (Related_Instance (Instance))));
                else
                   Gen_Id :=
-                    Generic_Parent
+                    Generic_Parent (Package_Specification (Instance));
-                      (Specification (Unit_Declaration_Node (Instance)));
                end if;
 
                Parent_Scope := Scope (Gen_Id);
@@ -8365,7 +8364,7 @@ package body Sem_Ch12 is
       --  of its generic parent.
 
       if Is_Generic_Instance (Par) then
-         Gen   := Generic_Parent (Specification (Unit_Declaration_Node (Par)));
+         Gen   := Generic_Parent (Package_Specification (Par));
          Gen_E := First_Entity (Gen);
       end if;
 
@@ -8449,8 +8448,7 @@ package body Sem_Ch12 is
       ------------------
 
       procedure Install_Spec (Par : Entity_Id) is
-         Spec : constant Node_Id :=
+         Spec : constant Node_Id := Package_Specification (Par);
-                  Specification (Unit_Declaration_Node (Par));
 
       begin
          --  If this parent of the child instance is a top-level unit,
@@ -8519,8 +8517,7 @@ package body Sem_Ch12 is
 
       First_Par := Inst_Par;
 
-      Gen_Par :=
+      Gen_Par := Generic_Parent (Package_Specification (Inst_Par));
-        Generic_Parent (Specification (Unit_Declaration_Node (Inst_Par)));
 
       First_Gen := Gen_Par;
 
@@ -8538,9 +8535,7 @@ package body Sem_Ch12 is
                Inst_Par := Renamed_Entity (Inst_Par);
             end if;
 
-            Gen_Par :=
+            Gen_Par := Generic_Parent (Package_Specification (Inst_Par));
-              Generic_Parent
-                (Specification (Unit_Declaration_Node (Inst_Par)));
 
             if Present (Gen_Par) then
                Prepend_Elmt (Inst_Par, Ancestors);
@@ -9009,7 +9004,7 @@ package body Sem_Ch12 is
          end if;
 
          if Nkind (Parent (Actual_Pack)) = N_Defining_Program_Unit_Name then
-            Parent_Spec := Specification (Unit_Declaration_Node (Actual_Pack));
+            Parent_Spec := Package_Specification (Actual_Pack);
          else
             Parent_Spec := Parent (Actual_Pack);
          end if;
@@ -12571,8 +12566,7 @@ package body Sem_Ch12 is
             elsif S = Current_Scope and then Is_Generic_Instance (S) then
                declare
                   Par : constant Entity_Id :=
-                          Generic_Parent
+                          Generic_Parent (Package_Specification (S));
-                            (Specification (Unit_Declaration_Node (S)));
                begin
                   if Present (Par)
                     and then P = Scope (Par)

gcc/ada/sem_ch3.adb

@@ -10919,8 +10919,7 @@ package body Sem_Ch3 is
          elsif Ekind (Current_Scope) = E_Package
            and then
              List_Containing (Parent (Prev)) /=
-               Visible_Declarations
+               Visible_Declarations (Package_Specification (Current_Scope))
-                 (Specification (Unit_Declaration_Node (Current_Scope)))
          then
             Error_Msg_N
               ("deferred constant must be declared in visible part",

gcc/ada/sem_ch6.adb

@@ -10318,8 +10318,7 @@ package body Sem_Ch6 is
            and then In_Private_Part (Current_Scope)
          then
             Priv_Decls :=
-              Private_Declarations
+              Private_Declarations (Package_Specification (Current_Scope));
-                (Specification (Unit_Declaration_Node (Current_Scope)));
 
             return In_Package_Body (Current_Scope)
               or else

gcc/ada/sem_prag.adb

@@ -21725,7 +21725,7 @@ package body Sem_Prag is
 
          --  Local variables
 
-         Pack_Spec : constant Node_Id := Parent (Spec_Id);
+         Pack_Spec : constant Node_Id := Package_Specification (Spec_Id);
 
       --  Start of processing for Collect_Hidden_States