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 --git a/gcc/ada/accessibility.adb b/gcc/ada/accessibility.adb
index 2e1406be9a615adba85454b7bcfa755e415ffaac..5f7949b49b3b3e472ff8baea3977f58fa89dbc59 100644 (file)
--- 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 e408888b5c513ec1a5d3422a0b91f20b09dfdf8f..1d78974d444938e90fdf6cd0e529125e59c9274b 100644 (file)
--- 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 c3d996a97d1de5cd562624bbd0649221e8cf12a2..476508b7449d6e8e072f94f7d99c3b37356eeb73 100644 (file)
--- 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