OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

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:
Gary Dismukes 2005-06-16 10:45:32 +02:00 committed by Arnaud Charlet
parent 357ac4df50
commit bc49df98e8
2 changed files with 34 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
gcc/ada/sem_aggr.adb
View File

@ -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);

39
gcc/ada/sem_ch5.adb
View File

@ -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));