This set of changes implements support for the Ada 2012 features of
implicit conversions for anonymous access types and membership tests
with a test expression of an anonymous access type (see AI05-0149).
Expressions of an anonymous access type are now generally allowed in
contexts where the expected type is a general access type, unless
the expression denotes the name of an access object that has a
dynamically determined accessibility level (specifically, access
parameters and stand-alone objects of anonymous access types are
not allowed to be implicitly converted). If such an expression is
resolved, then the expression is rewritten as a conversion to the
expected type (except for the expression of a membership test),
and the checks for valid conversions take care of applying the
legality restrictions (the equivalent explicit conversion must
be legal). In the case of membership tests, the test will return
true if the conversion of the expression is legal, if it satisfies
accessibility rules, and the designated object satisfies any
constraints and tagged type coverage requirements of the tested
type's designated type.
The test given below must report the following errors when compiled
with -gnat2012:
ai05_0149_test_errors.adb:28:18: implicit conversion of anonymous access formal
not allowed
ai05_0149_test_errors.adb:54:18: implicit conversion of stand-alone anonymous
access object not allowed
ai05_0149_test_errors.adb:56:26: implicit conversion of anonymous access value
violates accessibility
ai05_0149_test_errors.adb:59:39: cannot convert local pointer to non-local
access type
ai05_0149_test_errors.adb:62:30: implicit conversion of anonymous access value
violates accessibility
ai05_0149_test_errors.adb:85:16: implicit conversion of stand-alone anonymous
access object not allowed
ai05_0149_test_errors.adb:87:15: implicit conversion of stand-alone anonymous
access object not allowed
procedure AI05_0149_Test_Errors is
type Acc_Integer is access all Integer;
type Extra_Acc_Integer is access all Integer;
I : aliased Integer := 0;
Acc_I_1 : Acc_Integer := I'Access;
Anon_Acc_I_1 : access Integer := Acc_I_1;
type Rec is record
A : access Integer;
end record;
R : Rec;
procedure Proc (A : access Integer) is
type Nested_Acc_Integer is access all Integer;
Nested_Acc_Int : Nested_Acc_Integer := I'Access;
Local_Anon_Acc : access Integer := A; -- OK
begin
Acc_I_1 := A; -- ERROR (implicit conversion of access parameter)
if A in Acc_Integer then
I := A.all;
end if;
Nested_Acc_Int := Nested_Acc_Integer (A); -- OK
if A in Nested_Acc_Integer then
I := A.all;
end if;
end Proc;
procedure Other_Proc (A : Acc_Integer) is
Nested_Anon_Acc_I : access Integer := A; -- OK
type Nested_Rec is record
A : access Integer;
end record;
Nested_R : Nested_Rec;
Local_Anon_Acc : access Integer := Nested_Anon_Acc_I; -- OK
begin
Acc_I_1 := Nested_Anon_Acc_I; -- ERROR: accessibility level violation
Acc_I_1 := Nested_R.A; -- ERROR: accessibility level violation
Acc_I_1 := Acc_Integer (Nested_R.A); -- ERROR: illegal conversion
if Nested_R.A /= null then
Other_Proc (Nested_R.A); -- ERROR: accessibility level violation
end if;
if Nested_R.A in Acc_Integer then -- OK (legal, but should it be?)
I := Nested_R.A.all;
end if;
if Nested_Anon_Acc_I in Acc_Integer then -- OK (legal, but should it be?)
I := Nested_Anon_Acc_I.all;
end if;
if Nested_Anon_Acc_I = Anon_Acc_I_1 then -- OK (unambiguous)
I := 123;
end if;
if Nested_R.A = Nested_R.A then -- OK (unambiguous)
I := 123;
end if;
end Other_Proc;
begin
Other_Proc (R.A); -- OK
Other_Proc (Anon_Acc_I_1); -- ERROR
Acc_I_1 := Anon_Acc_I_1; -- ERROR (implicit conversion of stand-alone obj)
if Anon_Acc_I_1 in Acc_Integer then -- OK
I := Anon_Acc_I_1.all;
end if;
end AI05_0149_Test_Errors;
Tested on x86_64-pc-linux-gnu, committed on trunk
2011-08-30 Gary Dismukes <dismu...@adacore.com>
* sem_ch6.adb (Check_Return_Subtype_Indication): Issue error if the
return object has an anonymous access type and the function's type is
a named access type.
* sem_ch8.adb (Analyze_Object_Renaming): Suppress error about renaming
conversions on implicit conversions, since such conversions can occur
for anonymous access cases due to expansion. Issue error for attempt
to rename an anonymous expression as an object of a named access type.
* sem_res.ads (Valid_Conversion): Add defaulted parameter Report_Errs,
to indicate whether this function should report errors on invalid
conversions.
* sem_res.adb (Resolve): For Ada 2012, in the case where the type of
the expression is of an anonymous access type and the expected type is
a named general access type, rewrite the expression as a type
conversion, unless this is an expression of a membership test.
(Valid_Conversion.Error_Msg_N): New procedure that conditions the
calling of Error_Msg_N on new formal Report_Errs.
(Valid_Conversion.Error_Msg_NE): New procedure that conditions the
calling of Error_Msg_NE on new formal Report_Errs.
(Valid_Conversion): Move declaration of this function to the package
spec, to allow calls from membership test processing. For Ada 2012,
enforce legality restrictions on implicit conversions of anonymous
access values to general access types, disallowing such conversions in
cases where the expression has a dynamic accessibility level (access
parameters, stand-alone anonymous access objects, or a component of a
dereference of one of the first two cases).
* sem_type.adb (Covers): For Ada 2012, allow an anonymous access type
in the context of a named general access expected type.
* exp_ch4.adb Add with and use of Exp_Ch2.
(Expand_N_In): Add processing for membership tests applied to
expressions of an anonymous access type. First, Valid_Conversion is
called to check whether the test is statically False, and then the
conversion is expanded to test that the expression's accessibility
level is no deeper than that of the tested type. In the case of
anonymous access-to-tagged types, a tagged membership test is applied
as well.
(Tagged_Membership): Extend to handle access type cases, applying the
test to the designated types.
* exp_ch6.adb (Expand_Call): When creating an extra actual for an
accessibility level, and the actual is a 'Access applied to a current
instance, pass the accessibility level of the type of the current
instance rather than applying Object_Access_Level to the prefix. Add a
??? comment, since this level isn't quite right either (will eventually
need to pass an implicit level parameter to init procs).
Index: sem_type.adb
===================================================================
--- sem_type.adb (revision 178293)
+++ sem_type.adb (working copy)
@@ -967,6 +967,19 @@
then
return True;
+ -- Ada 2012 (AI05-0149): Allow an anonymous access type in the context
+ -- of a named general access type. An implicit conversion will be
+ -- applied. For the resolution, one designated type must cover the
+ -- other.
+
+ elsif Ada_Version >= Ada_2012
+ and then Ekind (BT1) = E_General_Access_Type
+ and then Ekind (BT2) = E_Anonymous_Access_Type
+ and then (Covers (Designated_Type (T1), Designated_Type (T2))
+ or else Covers (Designated_Type (T2), Designated_Type (T1)))
+ then
+ return True;
+
-- An Access_To_Subprogram is compatible with itself, or with an
-- anonymous type created for an attribute reference Access.
Index: sem_res.adb
===================================================================
--- sem_res.adb (revision 178294)
+++ sem_res.adb (working copy)
@@ -273,15 +273,6 @@
-- is only one requires a search over all visible entities, and happens
-- only in very pathological cases (see 6115-006).
- function Valid_Conversion
- (N : Node_Id;
- Target : Entity_Id;
- Operand : Node_Id) return Boolean;
- -- Verify legality rules given in 4.6 (8-23). Target is the target type
- -- of the conversion, which may be an implicit conversion of an actual
- -- parameter to an anonymous access type (in which case N denotes the
- -- actual parameter and N = Operand).
-
-------------------------
-- Ambiguous_Character --
-------------------------
@@ -2759,6 +2750,22 @@
Resolve_Unchecked_Type_Conversion (N, Ctx_Type);
end case;
+ -- Ada 2012 (AI05-0149): Apply an (implicit) conversion to an
+ -- expression of an anonymous access type that occurs in the context
+ -- of a named general access type, except when the expression is that
+ -- of a membership test. This ensures proper legality checking in
+ -- terms of allowed conversions (expressions that would be illegal to
+ -- convert implicitly are allowed in membership tests).
+
+ if Ada_Version >= Ada_2012
+ and then Ekind (Ctx_Type) = E_General_Access_Type
+ and then Ekind (Etype (N)) = E_Anonymous_Access_Type
+ and then Nkind (Parent (N)) not in N_Membership_Test
+ then
+ Rewrite (N, Convert_To (Ctx_Type, Relocate_Node (N)));
+ Analyze_And_Resolve (N, Ctx_Type);
+ end if;
+
-- If the subexpression was replaced by a non-subexpression, then
-- all we do is to expand it. The only legitimate case we know of
-- is converting procedure call statement to entry call statements,
@@ -10097,9 +10104,10 @@
----------------------
function Valid_Conversion
- (N : Node_Id;
- Target : Entity_Id;
- Operand : Node_Id) return Boolean
+ (N : Node_Id;
+ Target : Entity_Id;
+ Operand : Node_Id;
+ Report_Errs : Boolean := True) return Boolean
is
Target_Type : constant Entity_Id := Base_Type (Target);
Opnd_Type : Entity_Id := Etype (Operand);
@@ -10109,6 +10117,15 @@
Msg : String) return Boolean;
-- Little routine to post Msg if Valid is False, returns Valid value
+ procedure Error_Msg_N (Msg : String; N : Node_Or_Entity_Id);
+ -- If Report_Errs, then calls Errout.Error_Msg_N with its arguments
+
+ procedure Error_Msg_NE
+ (Msg : String;
+ N : Node_Or_Entity_Id;
+ E : Node_Or_Entity_Id);
+ -- If Report_Errs, then calls Errout.Error_Msg_NE with its arguments
+
function Valid_Tagged_Conversion
(Target_Type : Entity_Id;
Opnd_Type : Entity_Id) return Boolean;
@@ -10134,6 +10151,32 @@
return Valid;
end Conversion_Check;
+ -----------------
+ -- Error_Msg_N --
+ -----------------
+
+ procedure Error_Msg_N (Msg : String; N : Node_Or_Entity_Id) is
+ begin
+ if Report_Errs then
+ Errout.Error_Msg_N (Msg, N);
+ end if;
+ end Error_Msg_N;
+
+ ------------------
+ -- Error_Msg_NE --
+ ------------------
+
+ procedure Error_Msg_NE
+ (Msg : String;
+ N : Node_Or_Entity_Id;
+ E : Node_Or_Entity_Id)
+ is
+ begin
+ if Report_Errs then
+ Errout.Error_Msg_NE (Msg, N, E);
+ end if;
+ end Error_Msg_NE;
+
----------------------------
-- Valid_Array_Conversion --
----------------------------
@@ -10588,9 +10631,76 @@
if Ekind (Target_Type) /= E_Anonymous_Access_Type
or else Is_Local_Anonymous_Access (Target_Type)
then
- if Type_Access_Level (Opnd_Type)
- > Type_Access_Level (Target_Type)
+ -- Ada 2012 (AI05-0149): Perform legality checking on implicit
+ -- conversions from an anonymous access type to a named general
+ -- access type. Such conversions are not allowed in the case of
+ -- access parameters and stand-alone objects of an anonymous
+ -- access type.
+
+ if Ada_Version >= Ada_2012
+ and then not Comes_From_Source (N)
+ and then Ekind (Target_Type) = E_General_Access_Type
+ and then Ekind (Opnd_Type) = E_Anonymous_Access_Type
then
+ if Is_Itype (Opnd_Type) then
+
+ -- Implicit conversions aren't allowed for objects of an
+ -- anonymous access type, since such objects have nonstatic
+ -- levels in Ada 2012.
+
+ if Nkind (Associated_Node_For_Itype (Opnd_Type)) =
+ N_Object_Declaration
+ then
+ Error_Msg_N
+ ("implicit conversion of stand-alone anonymous " &
+ "access object not allowed", Operand);
+ return False;
+
+ -- Implicit conversions aren't allowed for anonymous access
+ -- parameters. The "not Is_Local_Anonymous_Access_Type" test
+ -- is done to exclude anonymous access results.
+
+ elsif not Is_Local_Anonymous_Access (Opnd_Type)
+ and then Nkind_In (Associated_Node_For_Itype (Opnd_Type),
+ N_Function_Specification,
+ N_Procedure_Specification)
+ then
+ Error_Msg_N
+ ("implicit conversion of anonymous access formal " &
+ "not allowed", Operand);
+ return False;
+
+ -- This is a case where there's an enclosing object whose
+ -- to which the "statically deeper than" relationship does
+ -- not apply (such as an access discriminant selected from
+ -- a dereference of an access parameter).
+
+ elsif Object_Access_Level (Operand)
+ = Scope_Depth (Standard_Standard)
+ then
+ Error_Msg_N
+ ("implicit conversion of anonymous access value " &
+ "not allowed", Operand);
+ return False;
+
+ -- In other cases, the level of the operand's type must be
+ -- statically less deep than that of the target type, else
+ -- implicit conversion is disallowed (by RM12-8.6(27.1/3)).
+
+ elsif Type_Access_Level (Opnd_Type)
+ > Type_Access_Level (Target_Type)
+ then
+ Error_Msg_N
+ ("implicit conversion of anonymous access value " &
+ "violates accessibility", Operand);
+ return False;
+ end if;
+ end if;
+
+ elsif Type_Access_Level (Opnd_Type)
+ > Type_Access_Level (Target_Type)
+ then
+
-- In an instance, this is a run-time check, but one we know
-- will fail, so generate an appropriate warning. The raise
-- will be generated by Expand_N_Type_Conversion.
Index: sem_res.ads
===================================================================
--- sem_res.ads (revision 178293)
+++ sem_res.ads (working copy)
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2008, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2011, 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- --
@@ -122,6 +122,18 @@
procedure Preanalyze_And_Resolve (N : Node_Id);
-- Same, but use type of node because context does not impose a single type
+ function Valid_Conversion
+ (N : Node_Id;
+ Target : Entity_Id;
+ Operand : Node_Id;
+ Report_Errs : Boolean := True) return Boolean;
+ -- Verify legality rules given in 4.6 (8-23). Target is the target type
+ -- of the conversion, which may be an implicit conversion of an actual
+ -- parameter to an anonymous access type (in which case N denotes the
+ -- actual parameter and N = Operand). Returns a Boolean result indicating
+ -- whether the conversion is legal. Reports errors in the case of illegal
+ -- conversions, unless Report_Errs is False.
+
private
procedure Resolve_Implicit_Type (N : Node_Id) renames Resolve;
pragma Inline (Resolve_Implicit_Type);
Index: exp_ch4.adb
===================================================================
--- exp_ch4.adb (revision 178293)
+++ exp_ch4.adb (working copy)
@@ -31,6 +31,7 @@
with Errout; use Errout;
with Exp_Aggr; use Exp_Aggr;
with Exp_Atag; use Exp_Atag;
+with Exp_Ch2; use Exp_Ch2;
with Exp_Ch3; use Exp_Ch3;
with Exp_Ch6; use Exp_Ch6;
with Exp_Ch7; use Exp_Ch7;
@@ -4955,6 +4956,121 @@
Rewrite (N, Cond);
Analyze_And_Resolve (N, Restyp);
end if;
+
+ -- Ada 2012 (AI05-0149): Handle membership tests applied to an
+ -- expression of an anonymous access type. This can involve an
+ -- accessibility test and a tagged type membership test in the
+ -- case of tagged designated types.
+
+ if Ada_Version >= Ada_2012
+ and then Is_Acc
+ and then Ekind (Ltyp) = E_Anonymous_Access_Type
+ then
+ declare
+ Expr_Entity : Entity_Id := Empty;
+ New_N : Node_Id;
+ Param_Level : Node_Id;
+ Type_Level : Node_Id;
+ begin
+ if Is_Entity_Name (Lop) then
+ Expr_Entity := Param_Entity (Lop);
+ if not Present (Expr_Entity) then
+ Expr_Entity := Entity (Lop);
+ end if;
+ end if;
+
+ -- If a conversion of the anonymous access value to the
+ -- tested type would be illegal, then the result is False.
+
+ if not Valid_Conversion
+ (Lop, Rtyp, Lop, Report_Errs => False)
+ then
+ Rewrite (N, New_Occurrence_Of (Standard_False, Loc));
+ Analyze_And_Resolve (N, Restyp);
+
+ -- Apply an accessibility check if the access object has an
+ -- associated access level and when the level of the type is
+ -- less deep than the level of the access parameter. This
+ -- only occur for access parameters and stand-alone objects
+ -- of an anonymous access type.
+
+ else
+ if Present (Expr_Entity)
+ and then Present (Extra_Accessibility (Expr_Entity))
+ and then UI_Gt
+ (Object_Access_Level (Lop),
+ Type_Access_Level (Rtyp))
+ then
+ Param_Level :=
+ New_Occurrence_Of
+ (Extra_Accessibility (Expr_Entity), Loc);
+
+ Type_Level :=
+ Make_Integer_Literal (Loc, Type_Access_Level (Rtyp));
+
+ -- Return True only if the accessibility level of the
+ -- expression entity is not deeper than the level of
+ -- the tested access type.
+
+ Rewrite (N,
+ Make_And_Then (Loc,
+ Left_Opnd => Relocate_Node (N),
+ Right_Opnd => Make_Op_Le (Loc,
+ Left_Opnd => Param_Level,
+ Right_Opnd => Type_Level)));
+
+ Analyze_And_Resolve (N);
+ end if;
+
+ -- If the designated type is tagged, do tagged membership
+ -- operation.
+
+ -- *** NOTE: we have to check not null before doing the
+ -- tagged membership test (but maybe that can be done
+ -- inside Tagged_Membership?).
+
+ if Is_Tagged_Type (Typ) then
+ Rewrite (N,
+ Make_And_Then (Loc,
+ Left_Opnd => Relocate_Node (N),
+ Right_Opnd =>
+ Make_Op_Ne (Loc,
+ Left_Opnd => Obj,
+ Right_Opnd => Make_Null (Loc))));
+
+ -- No expansion will be performed when VM_Target, as
+ -- the VM back-ends will handle the membership tests
+ -- directly (tags are not explicitly represented in
+ -- Java objects, so the normal tagged membership
+ -- expansion is not what we want).
+
+ if Tagged_Type_Expansion then
+
+ -- Note that we have to pass Original_Node, because
+ -- the membership test might already have been
+ -- rewritten by earlier parts of membership test.
+
+ Tagged_Membership
+ (Original_Node (N), SCIL_Node, New_N);
+
+ -- Update decoration of relocated node referenced
+ -- by the SCIL node.
+
+ if Generate_SCIL and then Present (SCIL_Node) then
+ Set_SCIL_Node (New_N, SCIL_Node);
+ end if;
+
+ Rewrite (N,
+ Make_And_Then (Loc,
+ Left_Opnd => Relocate_Node (N),
+ Right_Opnd => New_N));
+
+ Analyze_And_Resolve (N, Restyp);
+ end if;
+ end if;
+ end if;
+ end;
+ end if;
end;
end if;
@@ -10909,6 +11025,15 @@
Left_Type := Available_View (Etype (Left));
Right_Type := Available_View (Etype (Right));
+ -- In the case where the type is an access type, the test is applied
+ -- using the designated types (needed in Ada 2012 for implicit anonymous
+ -- access conversions, for AI05-0149).
+
+ if Is_Access_Type (Right_Type) then
+ Left_Type := Designated_Type (Left_Type);
+ Right_Type := Designated_Type (Right_Type);
+ end if;
+
if Is_Class_Wide_Type (Left_Type) then
Left_Type := Root_Type (Left_Type);
end if;
Index: exp_ch6.adb
===================================================================
--- exp_ch6.adb (revision 178293)
+++ exp_ch6.adb (working copy)
@@ -2436,13 +2436,40 @@
-- For X'Access, pass on the level of the prefix X
when Attribute_Access =>
- Add_Extra_Actual
- (Make_Integer_Literal (Loc,
- Intval =>
- Object_Access_Level
- (Prefix (Prev_Orig))),
- Extra_Accessibility (Formal));
+ -- If this is an Access attribute applied to the
+ -- the current instance object passed to a type
+ -- initialization procedure, then use the level
+ -- of the type itself. This is not really correct,
+ -- as there should be an extra level parameter
+ -- passed in with _init formals (only in the case
+ -- where the type is immutably limited), but we
+ -- don't have an easy way currently to create such
+ -- an extra formal (init procs aren't ever frozen).
+ -- For now we just use the level of the type,
+ -- which may be too shallow, but that works better
+ -- than passing Object_Access_Level of the type,
+ -- which can be one level too deep in some cases.
+ -- ???
+ if Is_Entity_Name (Prefix (Prev_Orig))
+ and then Is_Type (Entity (Prefix (Prev_Orig)))
+ then
+ Add_Extra_Actual
+ (Make_Integer_Literal (Loc,
+ Intval =>
+ Type_Access_Level
+ (Entity (Prefix (Prev_Orig)))),
+ Extra_Accessibility (Formal));
+
+ else
+ Add_Extra_Actual
+ (Make_Integer_Literal (Loc,
+ Intval =>
+ Object_Access_Level
+ (Prefix (Prev_Orig))),
+ Extra_Accessibility (Formal));
+ end if;
+
-- Treat the unchecked attributes as library-level
when Attribute_Unchecked_Access |
Index: sem_ch6.adb
===================================================================
--- sem_ch6.adb (revision 178293)
+++ sem_ch6.adb (working copy)
@@ -564,6 +564,15 @@
Error_Msg_N ("must use anonymous access type", Subtype_Ind);
end if;
+ -- If the return object is of an anonymous access type, then report
+ -- an error if the function's result type is not also anonymous.
+
+ elsif R_Stm_Type_Is_Anon_Access
+ and then not R_Type_Is_Anon_Access
+ then
+ Error_Msg_N ("anonymous access not allowed for function with " &
+ "named access result", Subtype_Ind);
+
-- Subtype indication case: check that the return object's type is
-- covered by the result type, and that the subtypes statically match
-- when the result subtype is constrained. Also handle record types
Index: sem_ch8.adb
===================================================================
--- sem_ch8.adb (revision 178293)
+++ sem_ch8.adb (working copy)
@@ -802,8 +802,13 @@
T := Entity (Subtype_Mark (N));
Analyze (Nam);
+ -- Reject renamings of conversions unless the type is tagged, or
+ -- the conversion is implicit (which can occur for cases of anonymous
+ -- access types in Ada 2012).
+
if Nkind (Nam) = N_Type_Conversion
- and then not Is_Tagged_Type (T)
+ and then Comes_From_Source (Nam)
+ and then not Is_Tagged_Type (T)
then
Error_Msg_N
("renaming of conversion only allowed for tagged types", Nam);
@@ -834,6 +839,22 @@
return;
end if;
+ -- Ada 2012 (AI05-149): Reject renaming of an anonymous access object
+ -- when renaming declaration has a named access type. The Ada 2012
+ -- coverage rules allow an anonymous access type in the context of
+ -- an expected named general access type, but the renaming rules
+ -- require the types to be the same. (An exception is when the type
+ -- of the renaming is also an anonymous access type, which can only
+ -- happen due to a renaming created by the expander.)
+
+ if Nkind (Nam) = N_Type_Conversion
+ and then not Comes_From_Source (Nam)
+ and then Ekind (Etype (Expression (Nam))) = E_Anonymous_Access_Type
+ and then Ekind (T) /= E_Anonymous_Access_Type
+ then
+ Wrong_Type (Expression (Nam), T); -- Should we give better error???
+ end if;
+
-- Check that a class-wide object is not being renamed as an object
-- of a specific type. The test for access types is needed to exclude
-- cases where the renamed object is a dynamically tagged access
