https://gcc.gnu.org/g:28e9236a4ae0543469f407858e4c157ae55f97d4
commit r16-9001-g28e9236a4ae0543469f407858e4c157ae55f97d4 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 c3d996a97d1d..5a9009c06a87 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 @@ -5762,9 +5746,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 @@ -5782,20 +5763,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 -- --------------------------- @@ -5885,7 +5852,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 @@ -5906,7 +5874,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 a3888d4a8f0b..0a1fda07d547 100644 --- a/gcc/ada/exp_ch6.adb +++ b/gcc/ada/exp_ch6.adb @@ -5781,13 +5781,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 38fc751277ae..93aa84403b0d 100644 --- a/gcc/ada/exp_util.adb +++ b/gcc/ada/exp_util.adb @@ -8955,6 +8955,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 6ebda7f44993..5cd6d81bcb4f 100644 --- a/gcc/ada/exp_util.ads +++ b/gcc/ada/exp_util.ads @@ -830,6 +830,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
