From 841dd0f5e68139c1a695c983b6f3372a4c5c7bad Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Tue, 22 Jun 2010 09:15:42 +0200 Subject: [PATCH] [multiple changes] 2010-06-22 Gary Dismukes * 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 * exp_aggr.adb (Flatten): Return False if one choice is statically known to be out of bounds. From-SVN: r161137 --- gcc/ada/ChangeLog | 17 +++++++++++++++++ gcc/ada/exp_aggr.adb | 42 ++++++++++++++++++++++++++---------------- gcc/ada/exp_util.adb | 8 ++++---- gcc/ada/sem_res.adb | 8 ++++---- 4 files changed, 51 insertions(+), 24 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index ec822d3dc27..a1621e1cbfc 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,20 @@ +2010-06-22 Gary Dismukes + + * 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 + + * exp_aggr.adb (Flatten): Return False if one choice is statically + known to be out of bounds. + 2010-06-22 Ed Schonberg * 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 a2c54911bb6..c15b92282e3 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 f948ee15f2c..df70651480c 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 89b5e1b4b39..a6b9d3a0549 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 -- 2.30.2