https://gcc.gnu.org/g:fce134ecbd33f8164d36e027c562933f3430fbc6
commit r17-732-gfce134ecbd33f8164d36e027c562933f3430fbc6 Author: Steve Baird <[email protected]> Date: Thu Jan 8 14:31:16 2026 -0800 ada: Missing dynamic accessibility check assigning conditional expr to saooaaat. When a conditional expression is assigned to a saooaaat (that is, to a stand-alone object of an anonymous access type), in some cases the required dynamic accessibility check was not being performed. gcc/ada/ChangeLog: * accessibility.adb (Needs_Accessibility_Level_Temp_Or_Check): Conform to spec changes. Return True for the RHS of an assignment statement. * accessibility.ads: Change name of Is_Anonymous_Access_Actual to Needs_Accessibility_Level_Temp_Or_Check; the function now returns True in cases other than those described by the old name. Also change name of the formal parameter from N to Conditional_Expr. * exp_ch4.adb (Expand_N_If_Expression): Update call to a function whose name changed. Diff: --- gcc/ada/accessibility.adb | 19 +++++++++++-------- gcc/ada/accessibility.ads | 14 +++++++++----- gcc/ada/exp_ch4.adb | 8 ++++++-- 3 files changed, 26 insertions(+), 15 deletions(-) diff --git a/gcc/ada/accessibility.adb b/gcc/ada/accessibility.adb index 2e1406be9a61..5f7949b49b3b 100644 --- a/gcc/ada/accessibility.adb +++ b/gcc/ada/accessibility.adb @@ -1958,18 +1958,20 @@ package body Accessibility is return False; end Has_Unconstrained_Access_Discriminants; - -------------------------------- - -- Is_Anonymous_Access_Actual -- - -------------------------------- + --------------------------------------------- + -- Needs_Accessibility_Level_Temp_Or_Check -- + --------------------------------------------- - function Is_Anonymous_Access_Actual (N : Node_Id) return Boolean is + function Needs_Accessibility_Level_Temp_Or_Check + (Conditional_Expr : Node_Id) return Boolean + is Par : Node_Id; begin - if Ekind (Etype (N)) /= E_Anonymous_Access_Type then + if Ekind (Etype (Conditional_Expr)) /= E_Anonymous_Access_Type then return False; end if; - Par := Parent (N); + Par := Parent (Conditional_Expr); while Present (Par) and then Nkind (Par) in N_Case_Expression | N_If_Expression @@ -1977,8 +1979,9 @@ package body Accessibility is loop Par := Parent (Par); end loop; - return Nkind (Par) in N_Subprogram_Call; - end Is_Anonymous_Access_Actual; + + return Nkind (Par) in N_Subprogram_Call | N_Assignment_Statement; + end Needs_Accessibility_Level_Temp_Or_Check; -------------------------------------- -- Needs_Result_Accessibility_Level -- diff --git a/gcc/ada/accessibility.ads b/gcc/ada/accessibility.ads index e408888b5c51..1d78974d4449 100644 --- a/gcc/ada/accessibility.ads +++ b/gcc/ada/accessibility.ads @@ -45,10 +45,10 @@ package Accessibility is -- When in the context of the function Accessibility_Level, -- Accessibility_Level_Kind signals what type of accessibility level to -- obtain. For example, when Level is Dynamic_Level, a defining identifier - -- associated with a SAOOAAT may be returned or an N_Integer_Literal node. + -- associated with a saooaaat may be returned or an N_Integer_Literal node. -- When the level is Object_Decl_Level, an N_Integer_Literal node is -- returned containing the level of the declaration of the object if - -- relevant (be it a SAOOAAT or otherwise). Finally, Zero_On_Dynamic_Level + -- relevant (be it a saooaaat or otherwise). Finally, Zero_On_Dynamic_Level -- returns library level for all cases where the accessibility level is -- dynamic (used to bypass static accessibility checks in dynamic cases). @@ -178,9 +178,13 @@ package Accessibility is -- Returns True if the given subtype is unconstrained and has one or more -- access discriminants. - function Is_Anonymous_Access_Actual (N : Node_Id) return Boolean; - -- Determine if N is used as an actual for a call whose corresponding - -- formal is of an anonymous access type. + function Needs_Accessibility_Level_Temp_Or_Check + (Conditional_Expr : Node_Id) return Boolean; + -- Determine whether a conditional expression occurs in a context that + -- requires either an associated accessibility-level-valued temp (which + -- is assigned to in each arm of the conditional expression) or an + -- accessibility level check (which is pushed down into each arm of the + -- conditional expression). function Needs_Result_Accessibility_Level (Func_Id : Entity_Id) return Boolean; diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index c3d996a97d1d..476508b7449d 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -5751,12 +5751,16 @@ package body Exp_Ch4 is Par : constant Node_Id := Parent (N); Typ : constant Entity_Id := Etype (N); - Force_Expand : constant Boolean := Is_Anonymous_Access_Actual (N); + Force_Expand : constant Boolean + := Needs_Accessibility_Level_Temp_Or_Check (N); -- Determine if we are dealing with a special case of a conditional -- expression used as an actual for an anonymous access type which -- forces us to transform the if expression into an expression with -- actions in order to create a temporary to capture the level of the - -- expression in each branch. + -- expression in each branch. Also True if the conditional + -- expression is the RHS of an assignment to a saooaaat (so the + -- accessibility level temp associated with the saooaaat also needs + -- to be updated as part of the assignment). function Is_Copy_Type (Typ : Entity_Id) return Boolean; -- Return True if we can copy objects of this type when expanding an if
