From: Steve Baird <[email protected]>
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.
Tested on x86_64-pc-linux-gnu, committed on master.
---
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 2e1406be9a6..5f7949b49b3 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 e408888b5c5..1d78974d444 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 c3d996a97d1..476508b7449 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
--
2.53.0
