From: Gary Dismukes Date: Thu, 16 Jun 2005 08:45:32 +0000 (+0200) Subject: sem_aggr.adb (Aggregate_Constraint_Checks): Apply a conversion to the expression... X-Git-Tag: misc/cutover-cvs2svn~2334 X-Git-Url: http://git.ipfire.org/?a=commitdiff_plain;h=bc49df98e8b97ae433a903486a987bd33f44d1f2;p=thirdparty%2Fgcc.git sem_aggr.adb (Aggregate_Constraint_Checks): Apply a conversion to the expression when the component type is an anonymous... 2005-06-14 Gary Dismukes * sem_aggr.adb (Aggregate_Constraint_Checks): Apply a conversion to the expression when the component type is an anonymous access type to ensure that appropriate accessibility checks are done. * sem_ch5.adb (Analyze_Assignment): Apply a implicit conversion to the expression of an assignment when the target object is of an anonymous access type. This ensures that required accessibility checks are done. (One_Bound): Move the check for type Universal_Integer to Process_Bounds. (Process_Bounds): Check whether the type of the preanalyzed range is Universal_Integer, and in that case set Typ to Integer_Type prior to setting the type of the original range and the calls to One_Bound. From-SVN: r101057 --- diff --git a/gcc/ada/sem_aggr.adb b/gcc/ada/sem_aggr.adb index aa7cddff6a17..8c5d7f9b4ffb 100644 --- a/gcc/ada/sem_aggr.adb +++ b/gcc/ada/sem_aggr.adb @@ -468,12 +468,16 @@ package body Sem_Aggr is Check_Unset_Reference (Exp); end if; + -- Ada 2005 (AI-230): Generate a conversion to an anonymous access + -- component's type to force the appropriate accessibility checks. + -- Ada 2005 (AI-231): Generate conversion to the null-excluding -- type to force the corresponding run-time check elsif Is_Access_Type (Check_Typ) - and then Can_Never_Be_Null (Check_Typ) - and then not Can_Never_Be_Null (Exp_Typ) + and then ((Is_Local_Anonymous_Access (Check_Typ)) + or else (Can_Never_Be_Null (Check_Typ) + and then not Can_Never_Be_Null (Exp_Typ))) then Rewrite (Exp, Convert_To (Check_Typ, Relocate_Node (Exp))); Analyze_And_Resolve (Exp, Check_Typ); @@ -543,7 +547,7 @@ package body Sem_Aggr is elsif Expr_Value (This_Low) /= Expr_Value (Aggr_Low (Dim)) then Set_Raises_Constraint_Error (N); - Error_Msg_N ("Sub-aggregate low bound mismatch?", N); + Error_Msg_N ("sub-aggregate low bound mismatch?", N); Error_Msg_N ("Constraint_Error will be raised at run-time?", N); end if; @@ -557,7 +561,7 @@ package body Sem_Aggr is Expr_Value (This_High) /= Expr_Value (Aggr_High (Dim)) then Set_Raises_Constraint_Error (N); - Error_Msg_N ("Sub-aggregate high bound mismatch?", N); + Error_Msg_N ("sub-aggregate high bound mismatch?", N); Error_Msg_N ("Constraint_Error will be raised at run-time?", N); end if; @@ -1301,7 +1305,7 @@ package body Sem_Aggr is if Range_Len < Len then Set_Raises_Constraint_Error (N); - Error_Msg_N ("Too many elements?", N); + Error_Msg_N ("too many elements?", N); Error_Msg_N ("Constraint_Error will be raised at run-time?", N); end if; end Check_Length; @@ -1392,7 +1396,7 @@ package body Sem_Aggr is -- aggregate must not be enclosed in parentheses. if Paren_Count (Expr) /= 0 then - Error_Msg_N ("No parenthesis allowed here", Expr); + Error_Msg_N ("no parenthesis allowed here", Expr); end if; Make_String_Into_Aggregate (Expr); diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb index 163365fc46a3..6d9bcaa4ff9c 100644 --- a/gcc/ada/sem_ch5.adb +++ b/gcc/ada/sem_ch5.adb @@ -400,6 +400,17 @@ package body Sem_Ch5 is Propagate_Tag (Lhs, Rhs); end if; + -- Ada 2005 (AI-230 and AI-385): When the lhs type is an anonymous + -- access type, apply an implicit conversion of the rhs to that type + -- to force appropriate static and run-time accessibility checks. + + if Ada_Version >= Ada_05 + and then Ekind (T1) = E_Anonymous_Access_Type + then + Rewrite (Rhs, Convert_To (T1, Relocate_Node (Rhs))); + Analyze_And_Resolve (Rhs, T1); + end if; + -- Ada 2005 (AI-231) if Ada_Version >= Ada_05 @@ -1151,10 +1162,9 @@ package body Sem_Ch5 is (Original_Bound : Node_Id; Analyzed_Bound : Node_Id) return Node_Id is - Assign : Node_Id; - Id : Entity_Id; - Decl : Node_Id; - Decl_Typ : Entity_Id; + Assign : Node_Id; + Id : Entity_Id; + Decl : Node_Id; begin -- If the bound is a constant or an object, no need for a @@ -1181,20 +1191,10 @@ package body Sem_Ch5 is Make_Defining_Identifier (Loc, Chars => New_Internal_Name ('S')); - -- If the type of the discrete range is Universal_Integer, then - -- the bound's type must be resolved to Integer, so the object - -- used to hold the bound must also have type Integer. - - if Typ = Universal_Integer then - Decl_Typ := Standard_Integer; - else - Decl_Typ := Typ; - end if; - Decl := Make_Object_Declaration (Loc, Defining_Identifier => Id, - Object_Definition => New_Occurrence_Of (Decl_Typ, Loc)); + Object_Definition => New_Occurrence_Of (Typ, Loc)); Insert_Before (Parent (N), Decl); Analyze (Decl); @@ -1224,6 +1224,15 @@ package body Sem_Ch5 is Set_Parent (R_Copy, Parent (R)); Pre_Analyze_And_Resolve (R_Copy); Typ := Etype (R_Copy); + + -- If the type of the discrete range is Universal_Integer, then + -- the bound's type must be resolved to Integer, and any object + -- used to hold the bound must also have type Integer. + + if Typ = Universal_Integer then + Typ := Standard_Integer; + end if; + Set_Etype (R, Typ); New_Lo_Bound := One_Bound (Lo, Low_Bound (R_Copy));