ada: Fix spurious discriminant check failure for unconstrained actual parameter

This happens when the unconstrained variable passed as actual parameter is
initialized by a conditional expression, because its declaration is wrongly
distributed into the dependent expressions of the conditional expression.

gcc/ada/ChangeLog:

	* exp_util.ads (Is_Distributable_Declaration): New predicate.
	* exp_util.adb (Is_Distributable_Declaration): New predicate coming
	from Expand_N_Case_Expression and Expand_N_If_Expression.  Return
	False for variables of an unconstrained definite nonlimited subtype.
	* exp_ch4.adb (Expand_N_Case_Expression): Replace calls to local
	Is_Optimizable_Declaration by calls to Is_Distributable_Declaration.
	(Expand_N_If_Expression): Likewise.
	* exp_ch6.adb (Expand_Ctrl_Function_Call): Likewise.

diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index 40ff66bfef563aa6a8795377d7777ac5362b80ef..533e2f0d7542ddcee1f7599556d1b9694f7312a6 100644 (file)
--- a/gcc/ada/exp_ch4.adb
+++ b/gcc/ada/exp_ch4.adb
@@ -5162,9 +5162,6 @@ package body Exp_Ch4 is
       --  Return True if we can copy objects of this type when expanding a case
       --  expression.
 
-      function Is_Optimizable_Declaration (N : Node_Id) return Boolean;
-      --  Return True if N is an object declaration that can be optimized
-
       ------------------
       -- Is_Copy_Type --
       ------------------
@@ -5174,20 +5171,6 @@ package body Exp_Ch4 is
          return Is_Elementary_Type (Underlying_Type (Typ));
       end Is_Copy_Type;
 
-      --------------------------------
-      -- Is_Optimizable_Declaration --
-      --------------------------------
-
-      function Is_Optimizable_Declaration (N : Node_Id) return Boolean is
-      begin
-         return Nkind (N) = N_Object_Declaration
-           and then not (Is_Entity_Name (Object_Definition (N))
-                          and then Is_Class_Wide_Type
-                                     (Entity (Object_Definition (N))))
-           and then not Is_Return_Object (Defining_Identifier (N))
-           and then not Is_Copy_Type (Typ);
-      end Is_Optimizable_Declaration;
-
       --  Local variables
 
       Acts       : List_Id;
@@ -5265,7 +5248,8 @@ package body Exp_Ch4 is
                            Unqualified_Unconditional_Parent (N);
          begin
             if Nkind (Uncond_Par) = N_Simple_Return_Statement
-              or else Is_Optimizable_Declaration (Uncond_Par)
+              or else (Is_Distributable_Declaration (Uncond_Par)
+                        and then not Is_Copy_Type (Typ))
               or else (Parent_Is_Regular_Aggregate (Uncond_Par)
                         and then not Is_Copy_Type (Typ))
             then
@@ -5286,7 +5270,7 @@ package body Exp_Ch4 is
          elsif Nkind (Par) = N_Simple_Return_Statement then
             Optimize_Return_Stmt := True;
 
-         elsif Is_Optimizable_Declaration (Par) then
+         elsif Is_Distributable_Declaration (Par) then
             Optimize_Object_Decl := True;
 
          else
@@ -5766,9 +5750,6 @@ package body Exp_Ch4 is
       --  Return True if we can copy objects of this type when expanding an if
       --  expression.
 
-      function Is_Optimizable_Declaration (N : Node_Id) return Boolean;
-      --  Return True if N is an object declaration that can be optimized
-
       function OK_For_Single_Subtype (T1, T2 : Entity_Id) return Boolean;
       --  Return true if it is acceptable to use a single subtype for two
       --  dependent expressions of subtype T1 and T2 respectively, which are
@@ -5786,20 +5767,6 @@ package body Exp_Ch4 is
            and then not Is_By_Reference_Type (Utyp);
       end Is_Copy_Type;
 
-      --------------------------------
-      -- Is_Optimizable_Declaration --
-      --------------------------------
-
-      function Is_Optimizable_Declaration (N : Node_Id) return Boolean is
-      begin
-         return Nkind (N) = N_Object_Declaration
-           and then not (Is_Entity_Name (Object_Definition (N))
-                          and then Is_Class_Wide_Type
-                                     (Entity (Object_Definition (N))))
-           and then not Is_Return_Object (Defining_Identifier (N))
-           and then not Is_Copy_Type (Typ);
-      end Is_Optimizable_Declaration;
-
       ---------------------------
       -- OK_For_Single_Subtype --
       ---------------------------
@@ -5889,7 +5856,8 @@ package body Exp_Ch4 is
                            Unqualified_Unconditional_Parent (N);
          begin
             if Nkind (Uncond_Par) = N_Simple_Return_Statement
-              or else Is_Optimizable_Declaration (Uncond_Par)
+              or else (Is_Distributable_Declaration (Uncond_Par)
+                        and then not Is_Copy_Type (Typ))
               or else (Parent_Is_Regular_Aggregate (Uncond_Par)
                         and then not Is_Copy_Type (Typ))
             then
@@ -5910,7 +5878,7 @@ package body Exp_Ch4 is
          elsif Nkind (Par) = N_Simple_Return_Statement then
             Optimize_Return_Stmt := True;
 
-         elsif Is_Optimizable_Declaration (Par) then
+         elsif Is_Distributable_Declaration (Par) then
             Optimize_Object_Decl := True;
 
          else

diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
index 4f7a0dc0c414bbe1f5849952e684107de08fefb7..7a6f9567f874d2ed4ef7c8c4c999ef0a452be7a8 100644 (file)
--- a/gcc/ada/exp_ch6.adb
+++ b/gcc/ada/exp_ch6.adb
@@ -5412,13 +5412,8 @@ package body Exp_Ch6 is
 
       --  Note that object declarations are also distributed into conditional
       --  expressions, but we may be invoked before this distribution is done.
-      --  However that's not the case for the declarations of return objects,
-      --  see the twin Is_Optimizable_Declaration predicates that are present
-      --  in Expand_N_Case_Expression and Expand_N_If_Expression of Exp_Ch4.
 
-      elsif Nkind (Uncond_Par) = N_Object_Declaration
-        and then not Is_Return_Object (Defining_Identifier (Uncond_Par))
-      then
+      elsif Is_Distributable_Declaration  (Uncond_Par) then
          return;
       end if;
 

diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb
index 770d5d69b6a3afbfc2865e2fb067c0947f892527..ea7aeb4d2c8d700a8b4228083031cbb62989d3d6 100644 (file)
--- a/gcc/ada/exp_util.adb
+++ b/gcc/ada/exp_util.adb
@@ -9082,6 +9082,43 @@ package body Exp_Util is
         and then Expansion_Delayed (Unqual_N);
    end Is_Delayed_Conditional_Expression;
 
+   --------------------------------
+   -- Is_Distributable_Declaration --
+   --------------------------------
+
+   function Is_Distributable_Declaration (N : Node_Id) return Boolean is
+      Obj_Def : Node_Id;
+
+   begin
+      --  First limitation: distribution is not implemented for return objects
+
+      if Nkind (N) /= N_Object_Declaration
+        or else Is_Return_Object (Defining_Identifier (N))
+      then
+         return False;
+      end if;
+
+      Obj_Def := Object_Definition (N);
+
+      --  Second limitation: distribution is not implemented for CW types
+
+      if Is_Entity_Name (Obj_Def)
+        and then Is_Class_Wide_Type (Entity (Obj_Def))
+      then
+         return False;
+      end if;
+
+      --  The declaration of a variable of an unconstrained definite nonlimited
+      --  subtype cannot be distributed because the variable is mutable and the
+      --  expansion of 'Constrained must statically return False for it.
+
+      return Constant_Present (N)
+        or else not Is_Entity_Name (Obj_Def)
+        or else Is_Constrained (Entity (Obj_Def))
+        or else not Is_Definite_Subtype (Entity (Obj_Def))
+        or else Is_Inherently_Limited_Type (Entity (Obj_Def));
+   end Is_Distributable_Declaration;
+
    --------------------------------------------------
    -- Is_Expanded_Class_Wide_Interface_Object_Decl --
    --------------------------------------------------

diff --git a/gcc/ada/exp_util.ads b/gcc/ada/exp_util.ads
index c12d68b27b2c8dca475394268d1b4fcdd23a0c5d..f8118b76424cf1d42cf4204a4793e8a94b21c09c 100644 (file)
--- a/gcc/ada/exp_util.ads
+++ b/gcc/ada/exp_util.ads
@@ -851,6 +851,13 @@ package Exp_Util is
    --  Return True if N is a type conversion, or a dereference thereof, or a
    --  reference to a formal parameter.
 
+   function Is_Distributable_Declaration (N : Node_Id) return Boolean;
+   --  Return True if N is an object declaration that can be distributed into
+   --  the dependent expressions of a conditional expression, given that the
+   --  conditional expression is the initialization expression of N. Such a
+   --  distribution avoids a copy operation and is required for limited types
+   --  and, more generally, desirable for all by-reference types.
+
    function Is_Expanded_Class_Wide_Interface_Object_Decl
       (N : Node_Id) return Boolean;
    --  Determine if N is the expanded code for a class-wide interface type