[multiple changes]

2010-06-22  Gary Dismukes  <dismukes@adacore.com>

	* exp_util.adb (Find_Interface_ADT): Retrieve Designated_Type instead of
	Directly_Designated_Type when the type argument is an access type.
	(Find_Interface_Tag): Retrieve Designated_Type instead of
	Directly_Designated_Type when the type argument is an access type.
	(Has_Controlled_Coextensions): Retrieve Designated_Type instead of
	Directly_Designated_Type of each access discriminant.
	* sem_res.adb (Resolve_Type_Conversion): Retrieve Designated_Type
	instead of Directly_Designated_Type when the operand and target types
	are access types.

2010-06-22  Thomas Quinot  <quinot@adacore.com>

	* exp_aggr.adb (Flatten): Return False if one choice is statically
	known to be out of bounds.

From-SVN: r161137

4 files changed, 51 insertions, 24 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index ec822d3..a1621e1 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,20 @@
+2010-06-22  Gary Dismukes  <dismukes@adacore.com>
+
+	* exp_util.adb (Find_Interface_ADT): Retrieve Designated_Type instead of
+	Directly_Designated_Type when the type argument is an access type.
+	(Find_Interface_Tag): Retrieve Designated_Type instead of
+	Directly_Designated_Type when the type argument is an access type.
+	(Has_Controlled_Coextensions): Retrieve Designated_Type instead of
+	Directly_Designated_Type of each access discriminant.
+	* sem_res.adb (Resolve_Type_Conversion): Retrieve Designated_Type
+	instead of Directly_Designated_Type when the operand and target types
+	are access types.
+
+2010-06-22  Thomas Quinot  <quinot@adacore.com>
+
+	* exp_aggr.adb (Flatten): Return False if one choice is statically
+	known to be out of bounds.
+
 2010-06-22  Ed Schonberg  <schonberg@adacore.com>
 
 	* sem_res.adb (Resolve_Call): If the call is rewritten as an indexed of
diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb
index a2c5491..c15b922 100644
--- a/gcc/ada/exp_aggr.adb
+++ b/gcc/ada/exp_aggr.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2009, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2010, 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- --
@@ -173,14 +173,14 @@ package body Exp_Aggr is
    -----------------------------------------------------
 
    function Aggr_Size_OK (N : Node_Id; Typ : Entity_Id) return Boolean;
-   --  Very large static aggregates present problems to the back-end, and
-   --  are transformed into assignments and loops. This function verifies
-   --  that the total number of components of an aggregate is acceptable
-   --  for transformation into a purely positional static form. It is called
-   --  prior to calling Flatten.
-   --  This function also detects and warns about one-component aggregates
-   --  that appear in a non-static context. Even if the component value is
-   --  static, such an aggregate must be expanded into an assignment.
+   --  Very large static aggregates present problems to the back-end, and are
+   --  transformed into assignments and loops. This function verifies that the
+   --  total number of components of an aggregate is acceptable for rewriting
+   --  into a purely positional static form. It is called prior to calling
+   --  Flatten.
+   --  This function also detects and warns about one-component aggregates that
+   --  appear in a non-static context. Even if the component value is static,
+   --  such an aggregate must be expanded into an assignment.
 
    procedure Convert_Array_Aggr_In_Allocator
      (Decl   : Node_Id;
@@ -3782,10 +3782,11 @@ package body Exp_Aggr is
             Rep_Count : Nat;
             --  Used to validate Max_Others_Replicate limit
 
-            Elmt   : Node_Id;
-            Num    : Int := UI_To_Int (Lov);
-            Choice : Node_Id;
-            Lo, Hi : Node_Id;
+            Elmt         : Node_Id;
+            Num          : Int := UI_To_Int (Lov);
+            Choice_Index : Int;
+            Choice       : Node_Id;
+            Lo, Hi       : Node_Id;
 
          begin
             if Present (Expressions (N)) then
@@ -3911,9 +3912,18 @@ package body Exp_Aggr is
                         return False;
 
                      else
-                        Vals (UI_To_Int (Expr_Value (Choice))) :=
-                          New_Copy_Tree (Expression (Elmt));
-                        goto Continue;
+                        Choice_Index := UI_To_Int (Expr_Value (Choice));
+                        if Choice_Index in Vals'Range then
+                           Vals (Choice_Index) :=
+                             New_Copy_Tree (Expression (Elmt));
+                           goto Continue;
+
+                        else
+                           --  Choice is statically out-of-range, will be
+                           --  rewritten to raise Constraint_Error.
+
+                           return False;
+                        end if;
                      end if;
                   end if;
 
diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb
index f948ee1..df70651 100644
--- a/gcc/ada/exp_util.adb
+++ b/gcc/ada/exp_util.adb
@@ -1487,7 +1487,7 @@ package body Exp_Util is
       --  Handle access types
 
       if Is_Access_Type (Typ) then
-         Typ := Directly_Designated_Type (Typ);
+         Typ := Designated_Type (Typ);
       end if;
 
       --  Handle task and protected types implementing interfaces
@@ -1594,7 +1594,7 @@ package body Exp_Util is
       --  Handle access types
 
       if Is_Access_Type (Typ) then
-         Typ := Directly_Designated_Type (Typ);
+         Typ := Designated_Type (Typ);
       end if;
 
       --  Handle class-wide types
@@ -2129,9 +2129,9 @@ package body Exp_Util is
 
             if Ekind (D_Typ) = E_Anonymous_Access_Type
               and then
-                (Is_Controlled (Directly_Designated_Type (D_Typ))
+                (Is_Controlled (Designated_Type (D_Typ))
                    or else
-                 Is_Concurrent_Type (Directly_Designated_Type (D_Typ)))
+                 Is_Concurrent_Type (Designated_Type (D_Typ)))
             then
                return True;
             end if;
diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index 89b5e1b..a6b9d3a 100644
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -218,7 +218,7 @@ package body Sem_Res is
    --  A call to a user-defined intrinsic operator is rewritten as a call
    --  to the corresponding predefined operator, with suitable conversions.
    --  Note that this applies only for intrinsic operators that denote
-   --  predefined operators, not opeartors that are intrinsic imports of
+   --  predefined operators, not operators that are intrinsic imports of
    --  back-end builtins.
 
    procedure Resolve_Intrinsic_Unary_Operator (N : Node_Id; Typ : Entity_Id);
@@ -4625,7 +4625,7 @@ package body Sem_Res is
 
          --  If the context is Universal_Fixed and the operands are also
          --  universal fixed, this is an error, unless there is only one
-         --  applicable fixed_point type (usually duration).
+         --  applicable fixed_point type (usually Duration).
 
          if B_Typ = Universal_Fixed and then Etype (L) = Universal_Fixed then
             T := Unique_Fixed_Point_Type (N);
@@ -8608,11 +8608,11 @@ package body Sem_Res is
 
          begin
             if Is_Access_Type (Opnd) then
-               Opnd := Directly_Designated_Type (Opnd);
+               Opnd := Designated_Type (Opnd);
             end if;
 
             if Is_Access_Type (Target_Typ) then
-               Target := Directly_Designated_Type (Target);
+               Target := Designated_Type (Target);
             end if;
 
             if Opnd = Target then