From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: by sourceware.org (Postfix, from userid 1914) id DBC90398703F; Fri, 9 Jul 2021 12:38:27 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org DBC90398703F MIME-Version: 1.0 Content-Transfer-Encoding: 7bit Content-Type: text/plain; charset="utf-8" From: Pierre-Marie de Rodat To: gcc-cvs@gcc.gnu.org Subject: [gcc r12-2199] [Ada] Incremental patch for restriction No_Dynamic_Accessibility_Checks X-Act-Checkin: gcc X-Git-Author: Justin Squirek X-Git-Refname: refs/heads/master X-Git-Oldrev: d80c73318785edec642b04dfe00db2e61503bf20 X-Git-Newrev: 9b1647a50dda833a0640e66bb0bedb6c477b7561 Message-Id: <20210709123827.DBC90398703F@sourceware.org> Date: Fri, 9 Jul 2021 12:38:27 +0000 (GMT) X-BeenThere: gcc-cvs@gcc.gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: Gcc-cvs mailing list List-Unsubscribe: , List-Archive: List-Help: List-Subscribe: , X-List-Received-Date: Fri, 09 Jul 2021 12:38:28 -0000 https://gcc.gnu.org/g:9b1647a50dda833a0640e66bb0bedb6c477b7561 commit r12-2199-g9b1647a50dda833a0640e66bb0bedb6c477b7561 Author: Justin Squirek Date: Thu Jun 3 17:15:51 2021 -0400 [Ada] Incremental patch for restriction No_Dynamic_Accessibility_Checks gcc/ada/ * sem_util.ads (Type_Access_Level): Add new optional parameter Assoc_Ent. * sem_util.adb (Accessibility_Level): Treat access discriminants the same as components when the restriction No_Dynamic_Accessibility_Checks is enabled. (Deepest_Type_Access_Level): Remove exception for Debug_Flag_Underscore_B when returning the result of Type_Access_Level in the case where No_Dynamic_Accessibility_Checks is active. (Function_Call_Or_Allocator_Level): Correctly calculate the level of Expr based on its containing subprogram instead of using Current_Subprogram. * sem_res.adb (Valid_Conversion): Add actual for new parameter Assoc_Ent in call to Type_Access_Level, and add test of No_Dynamic_Accessibility_Checks_Enabled to ensure that static accessibility checks are performed for all anonymous access type conversions. Diff: --- gcc/ada/sem_res.adb | 15 ++++++++++----- gcc/ada/sem_util.adb | 34 ++++++++++++++++++++++++++++------ gcc/ada/sem_util.ads | 7 ++++++- 3 files changed, 44 insertions(+), 12 deletions(-) diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index e2c069ca740..03d747ef1ab 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -13734,11 +13734,16 @@ package body Sem_Res is -- the target type is anonymous access as well - see RM 3.10.2 -- (10.3/3). - elsif Type_Access_Level (Opnd_Type) > - Deepest_Type_Access_Level (Target_Type) - and then (Nkind (Associated_Node_For_Itype (Opnd_Type)) /= - N_Function_Specification - or else Ekind (Target_Type) in Anonymous_Access_Kind) + -- Note that when the restriction No_Dynamic_Accessibility_Checks + -- is in effect wei also want to proceed with the conversion check + -- described above. + + elsif Type_Access_Level (Opnd_Type, Assoc_Ent => Operand) + > Deepest_Type_Access_Level (Target_Type) + and then (Nkind (Associated_Node_For_Itype (Opnd_Type)) + /= N_Function_Specification + or else Ekind (Target_Type) in Anonymous_Access_Kind + or else No_Dynamic_Accessibility_Checks_Enabled (N)) -- Check we are not in a return value ??? diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 9cd5d14b0c5..5d0aa49a2db 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -420,7 +420,7 @@ package body Sem_Util is else return Make_Level_Literal - (Subprogram_Access_Level (Current_Subprogram)); + (Subprogram_Access_Level (Entity (Name (N)))); end if; end if; @@ -791,12 +791,22 @@ package body Sem_Util is -- is an anonymous access type means that its associated -- level is that of the containing type - see RM 3.10.2 (16). + -- Note that when restriction No_Dynamic_Accessibility_Checks is + -- in effect we treat discriminant components as regular + -- components. + elsif Nkind (E) = N_Selected_Component and then Ekind (Etype (E)) = E_Anonymous_Access_Type and then Ekind (Etype (Pre)) /= E_Anonymous_Access_Type - and then not (Nkind (Selector_Name (E)) in N_Has_Entity - and then Ekind (Entity (Selector_Name (E))) - = E_Discriminant) + and then (not (Nkind (Selector_Name (E)) in N_Has_Entity + and then Ekind (Entity (Selector_Name (E))) + = E_Discriminant) + + -- The alternative accessibility models both treat + -- discriminants as regular components. + + or else (No_Dynamic_Accessibility_Checks_Enabled (E) + and then Allow_Alt_Model)) then -- When restriction No_Dynamic_Accessibility_Checks is active -- and -gnatd_b set, the level is that of the designated type. @@ -7215,7 +7225,6 @@ package body Sem_Util is if Allow_Alt_Model and then No_Dynamic_Accessibility_Checks_Enabled (Typ) - and then not Debug_Flag_Underscore_B then return Type_Access_Level (Typ, Allow_Alt_Model); end if; @@ -29157,7 +29166,8 @@ package body Sem_Util is function Type_Access_Level (Typ : Entity_Id; - Allow_Alt_Model : Boolean := True) return Uint + Allow_Alt_Model : Boolean := True; + Assoc_Ent : Entity_Id := Empty) return Uint is Btyp : Entity_Id := Base_Type (Typ); Def_Ent : Entity_Id; @@ -29187,6 +29197,18 @@ package body Sem_Util is (Designated_Type (Btyp), Allow_Alt_Model); end if; + -- When an anonymous access type's Assoc_Ent is specifiedi, + -- calculate the result based on the general accessibility + -- level routine. + + -- We would like to use Associated_Node_For_Itype here instead, + -- but in some cases it is not fine grained enough ??? + + if Present (Assoc_Ent) then + return Static_Accessibility_Level + (Assoc_Ent, Object_Decl_Level); + end if; + -- Otherwise take the context of the anonymous access type into -- account. diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads index 440ac800c11..b0d6a2a2ef3 100644 --- a/gcc/ada/sem_util.ads +++ b/gcc/ada/sem_util.ads @@ -3267,12 +3267,17 @@ package Sem_Util is function Type_Access_Level (Typ : Entity_Id; - Allow_Alt_Model : Boolean := True) return Uint; + Allow_Alt_Model : Boolean := True; + Assoc_Ent : Entity_Id := Empty) return Uint; -- Return the accessibility level of Typ -- The Allow_Alt_Model parameter allows the alternative level calculation -- under the restriction No_Dynamic_Accessibility_Checks to be performed. + -- Assoc_Ent allows for the optional specification of the entity associated + -- with Typ. This gets utilized mostly for anonymous access type + -- processing, where context matters in interpreting Typ's level. + function Type_Without_Stream_Operation (T : Entity_Id; Op : TSS_Name_Type := TSS_Null) return Entity_Id;