From: Eric Botcazou <[email protected]>
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.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/exp_ch4.adb | 44 ++++++--------------------------------------
gcc/ada/exp_ch6.adb | 7 +------
gcc/ada/exp_util.adb | 37 +++++++++++++++++++++++++++++++++++++
gcc/ada/exp_util.ads | 7 +++++++
4 files changed, 51 insertions(+), 44 deletions(-)
diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index 40ff66bfef5..533e2f0d754 100644
--- 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 4f7a0dc0c41..7a6f9567f87 100644
--- 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 770d5d69b6a..ea7aeb4d2c8 100644
--- 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 c12d68b27b2..f8118b76424 100644
--- 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
--
2.53.0
