sem_aggr.adb (Aggregate_Constraint_Checks): Apply a conversion to the expression when the component type is an anonymous...
2005-06-14 Gary Dismukes <dismukes@adacore.com> * 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
This commit is contained in:
parent
357ac4df50
commit
bc49df98e8
|
@ -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);
|
||||
|
|
|
@ -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));
|
||||
|
|
Loading…
Reference in New Issue