From 1a0d29099af1fa1f0dc8aa7c13ec71c7e014cd96 Mon Sep 17 00:00:00 2001 From: Justin Squirek Date: Fri, 5 Jun 2020 15:41:33 -0400 Subject: [PATCH] [Ada] Spurious accessibility error on allocator in generic instance gcc/ada/ * exp_ch4.adb (Expand_N_Type_Conversion): Remove flawed test for whether "statically deeper" accessibility rules apply to a given target type and instead use the new routine Statically_Deeper_Relation_Applies. (Statically_Deeper_Relation_Applies): Created to centralize the calculation of whether a target type within a conversion must have static accessibility checks. * sem_ch13.adb (Check_One_Function): Minor comment revision. --- gcc/ada/exp_ch4.adb | 40 +++++++++++++++++++++++++--------------- gcc/ada/sem_ch13.adb | 2 +- 2 files changed, 26 insertions(+), 16 deletions(-) diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index fd75eb8..c35fea3 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -11305,6 +11305,11 @@ package body Exp_Ch4 is -- True iff Present (Effective_Extra_Accessibility (Id)) successfully -- evaluates to True. + function Statically_Deeper_Relation_Applies (Targ_Typ : Entity_Id) + return Boolean; + -- Given a target type for a conversion, determine whether the + -- statically deeper accessibility rules apply to it. + -------------------------- -- Discrete_Range_Check -- -------------------------- @@ -11887,6 +11892,25 @@ package body Exp_Ch4 is end if; end Has_Extra_Accessibility; + ---------------------------------------- + -- Statically_Deeper_Relation_Applies -- + ---------------------------------------- + + function Statically_Deeper_Relation_Applies (Targ_Typ : Entity_Id) + return Boolean + is + begin + -- The case where the target type is an anonymous access type is + -- ignored since they have different semantics and get covered by + -- various runtime checks depending on context. + + -- Note, the current implementation of this predicate is incomplete + -- and doesn't fully reflect the rules given in RM 3.10.2 (19) and + -- (19.1) ??? + + return Ekind (Targ_Typ) /= E_Anonymous_Access_Type; + end Statically_Deeper_Relation_Applies; + -- Start of processing for Expand_N_Type_Conversion begin @@ -12133,21 +12157,7 @@ package body Exp_Ch4 is -- Note: warnings are issued by the analyzer for the instance cases elsif In_Instance_Body - - -- The case where the target type is an anonymous access type of - -- a discriminant is excluded, because the level of such a type - -- depends on the context and currently the level returned for such - -- types is zero, resulting in warnings about check failures - -- in certain legal cases involving class-wide interfaces as the - -- designated type (some cases, such as return statements, are - -- checked at run time, but not clear if these are handled right - -- in general, see 3.10.2(12/2-12.5/3) ???). - - and then - not (Ekind (Target_Type) = E_Anonymous_Access_Type - and then Present (Associated_Node_For_Itype (Target_Type)) - and then Nkind (Associated_Node_For_Itype (Target_Type)) = - N_Discriminant_Specification) + and then Statically_Deeper_Relation_Applies (Target_Type) and then Type_Access_Level (Operand_Type) > Type_Access_Level (Target_Type) then diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index fcd94da..01f2a4c 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -5488,7 +5488,7 @@ package body Sem_Ch13 is end if; end if; - -- All checks succeeded. + -- All checks succeeded Indexing_Found := True; end Check_One_Function; -- 2.7.4