[Ada] AI-230 & 385
Arnaud Charlet
charlet@adacore.com
Thu Jun 16 09:41:00 GMT 2005
Tested on i686-linux, committed on mainline.
Part of implementation of AI-230 and AI-385
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.
-------------- next part --------------
Index: sem_aggr.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/sem_aggr.adb,v
retrieving revision 1.18
diff -u -p -r1.18 sem_aggr.adb
--- sem_aggr.adb 10 Feb 2005 13:50:35 -0000 1.18
+++ sem_aggr.adb 15 Jun 2005 15:48:20 -0000
@@ -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);
Index: sem_ch5.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/sem_ch5.adb,v
retrieving revision 1.21
diff -u -p -r1.21 sem_ch5.adb
--- sem_ch5.adb 29 Mar 2005 16:20:30 -0000 1.21
+++ sem_ch5.adb 15 Jun 2005 15:48:20 -0000
@@ -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));
More information about the Gcc-patches
mailing list