From: Justin Squirek Date: Thu, 3 Jun 2021 21:15:51 +0000 (-0400) Subject: [Ada] Incremental patch for restriction No_Dynamic_Accessibility_Checks X-Git-Tag: basepoints/gcc-13~6114 X-Git-Url: http://git.ipfire.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=9b1647a50dda833a0640e66bb0bedb6c477b7561;p=thirdparty%2Fgcc.git [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 --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index e2c069ca7400..03d747ef1abe 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 9cd5d14b0c51..5d0aa49a2db6 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 440ac800c111..b0d6a2a2ef35 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;