[gcc(refs/users/guojiufu/heads/personal-branch)] [Ada] Fix anonymous-to-named access type implicit conversion legality checking
Jiu Fu Guo
guojiufu@gcc.gnu.org
Sat Jun 13 03:01:27 GMT 2020
https://gcc.gnu.org/g:a6db99a61a86814241b66a17a65633338d86cc17
commit a6db99a61a86814241b66a17a65633338d86cc17
Author: Steve Baird <baird@adacore.com>
Date: Fri Mar 27 11:56:40 2020 -0700
[Ada] Fix anonymous-to-named access type implicit conversion legality checking
2020-06-12 Steve Baird <baird@adacore.com>
gcc/ada/
* sem_res.adb (Valid_Conversion): The simpler cases of
violations of the aforementioned 8.6 rule are already handled
correctly. These include cases where the operand of the type
conversion is an access parameter or a stand-alone object of an
anonymous access type. Add code to detect violations where the
operand of the type conversion is an access discriminant whose
accessibility level is tied to one of the other simpler cases.
This is implemented in a new function,
Valid_Conversion.Is_Discrim_Of_Bad_Access_Conversion_Argument,
which is called in place of the previous test.
Diff:
---
gcc/ada/sem_res.adb | 89 +++++++++++++++++++++++++++++++++++++++++++++++++----
1 file changed, 83 insertions(+), 6 deletions(-)
diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index ee64248231a..0290c53d413 100644
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -12482,6 +12482,18 @@ package body Sem_Res is
-- are not rechecked because type visbility may lead to spurious errors,
-- but conversions in an actual for a formal object must be checked.
+ function Is_Discrim_Of_Bad_Access_Conversion_Argument
+ (Expr : Node_Id) return Boolean;
+ -- Implicit anonymous-to-named access type conversions are not allowed
+ -- if the "statically deeper than" relationship does not apply to the
+ -- type of the conversion operand. See RM 8.6(28.1) and AARM 8.6(28.d).
+ -- We deal with most such cases elsewhere so that we can emit more
+ -- specific error messages (e.g., if the operand is an access parameter
+ -- or a saooaaat (stand-alone object of an anonymous access type)), but
+ -- here is where we catch the case where the operand is an access
+ -- discriminant selected from a dereference of another such "bad"
+ -- conversion argument.
+
function Valid_Tagged_Conversion
(Target_Type : Entity_Id;
Opnd_Type : Entity_Id) return Boolean;
@@ -12584,6 +12596,74 @@ package body Sem_Res is
end if;
end In_Instance_Code;
+ --------------------------------------------------
+ -- Is_Discrim_Of_Bad_Access_Conversion_Argument --
+ --------------------------------------------------
+
+ function Is_Discrim_Of_Bad_Access_Conversion_Argument
+ (Expr : Node_Id) return Boolean
+ is
+ Exp_Type : Entity_Id := Base_Type (Etype (Expr));
+ pragma Assert (Is_Access_Type (Exp_Type));
+
+ Associated_Node : Node_Id;
+ Deref_Prefix : Node_Id;
+ begin
+ if not Is_Anonymous_Access_Type (Exp_Type) then
+ return False;
+ end if;
+
+ pragma Assert (Is_Itype (Exp_Type));
+ Associated_Node := Associated_Node_For_Itype (Exp_Type);
+
+ if Nkind (Associated_Node) /= N_Discriminant_Specification then
+ return False; -- not the type of an access discriminant
+ end if;
+
+ -- return False if Expr not of form <prefix>.all.Some_Component
+
+ if (Nkind (Expr) /= N_Selected_Component)
+ or else (Nkind (Prefix (Expr)) /= N_Explicit_Dereference)
+ then
+ -- conditional expressions, declare expressions ???
+ return False;
+ end if;
+
+ Deref_Prefix := Prefix (Prefix (Expr));
+ Exp_Type := Base_Type (Etype (Deref_Prefix));
+
+ -- The "statically deeper relationship" does not apply
+ -- to generic formal access types, so a prefix of such
+ -- a type is a "bad" prefix.
+
+ if Is_Generic_Formal (Exp_Type) then
+ return True;
+
+ -- The "statically deeper relationship" does apply to
+ -- any other named access type.
+
+ elsif not Is_Anonymous_Access_Type (Exp_Type) then
+ return False;
+ end if;
+
+ pragma Assert (Is_Itype (Exp_Type));
+ Associated_Node := Associated_Node_For_Itype (Exp_Type);
+
+ -- The "statically deeper relationship" applies to some
+ -- anonymous access types and not to others. Return
+ -- True for the cases where it does not apply. Also check
+ -- recursively for the
+ -- <prefix>.all.Access_Discrim.all.Access_Discrim case,
+ -- where the correct result depends on <prefix>.
+
+ return Nkind_In (Associated_Node,
+ N_Procedure_Specification, -- access parameter
+ N_Function_Specification, -- access parameter
+ N_Object_Declaration -- saooaaat
+ )
+ or else Is_Discrim_Of_Bad_Access_Conversion_Argument (Deref_Prefix);
+ end Is_Discrim_Of_Bad_Access_Conversion_Argument;
+
----------------------------
-- Valid_Array_Conversion --
----------------------------
@@ -13133,13 +13213,10 @@ package body Sem_Res is
& "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).
+ -- Detect access discriminant values that are illegal
+ -- implicit anonymous-to-named access conversion operands.
- elsif Object_Access_Level (Operand)
- = Scope_Depth (Standard_Standard)
+ elsif Is_Discrim_Of_Bad_Access_Conversion_Argument (Operand)
then
Conversion_Error_N
("implicit conversion of anonymous access value "
More information about the Gcc-cvs
mailing list