diff options
author | Justin Squirek <squirek@adacore.com> | 2021-06-03 17:15:51 -0400 |
---|---|---|
committer | Pierre-Marie de Rodat <derodat@adacore.com> | 2021-07-09 12:35:26 +0000 |
commit | 9b1647a50dda833a0640e66bb0bedb6c477b7561 (patch) | |
tree | 5ee5e2dae6d8d1b662e8b47d63606f47a66a78bb | |
parent | d80c73318785edec642b04dfe00db2e61503bf20 (diff) | |
download | gcc-9b1647a50dda833a0640e66bb0bedb6c477b7561.zip gcc-9b1647a50dda833a0640e66bb0bedb6c477b7561.tar.gz gcc-9b1647a50dda833a0640e66bb0bedb6c477b7561.tar.bz2 |
[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.
-rw-r--r-- | gcc/ada/sem_res.adb | 15 | ||||
-rw-r--r-- | gcc/ada/sem_util.adb | 34 | ||||
-rw-r--r-- | 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 e2c069c..03d747e 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 9cd5d14..5d0aa49 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 440ac80..b0d6a2a 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; |