https://gcc.gnu.org/g:c78a3dc86b428d2d54f10c2e8c0e3620db956b7d
commit r17-866-gc78a3dc86b428d2d54f10c2e8c0e3620db956b7d Author: Eric Botcazou <[email protected]> Date: Mon Feb 23 09:43:17 2026 +0100 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: --- 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 40ff66bfef56..533e2f0d7542 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 4f7a0dc0c414..7a6f9567f874 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 770d5d69b6a3..ea7aeb4d2c8d 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 c12d68b27b2c..f8118b76424c 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
