https://gcc.gnu.org/g:cb71c251d846032cfb31e86c8e4d678c58a90ecc

commit r15-597-gcb71c251d846032cfb31e86c8e4d678c58a90ecc
Author: Bob Duff <d...@adacore.com>
Date:   Tue Mar 5 18:35:25 2024 -0500

    ada: Fix Constraint_Error on mutable assignment
    
    For an assignment statement "X := Y;", where X is a formal parameter
    of a "late overriding" subprogram (i.e. it has no spec, and the body
    is overriding), and the subtype of X is an unconstrained record with
    defaulted discriminants, if the actual parameter passed to X is
    unconstrained, then X is unconstrained. This patch fixes a bug
    where X was incorrectly considered constrained, so that if Y's
    discriminants are different from X, Constraint_Error was raised.
    
    The bug was caused by the fact that an extra "constrained" formal
    parameter was missing in both caller and callee.
    
    gcc/ada/
    
            * sem_disp.adb (Check_Dispatching_Operation): Call
            Create_Extra_Formals, so that the caller will have an extra
            "constrained" parameter, which will be checked on assignment in
            the callee, and will be passed in by the caller.

Diff:
---
 gcc/ada/sem_disp.adb | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/gcc/ada/sem_disp.adb b/gcc/ada/sem_disp.adb
index 525a9f7f0a1a..fd521a09bc0f 100644
--- a/gcc/ada/sem_disp.adb
+++ b/gcc/ada/sem_disp.adb
@@ -1514,10 +1514,10 @@ package body Sem_Disp is
                         Subp);
 
                   else
-
                      --  The subprogram body declares a primitive operation.
                      --  We must update its dispatching information here. The
                      --  information is taken from the overridden subprogram.
+                     --  Such a late-overriding body also needs extra formals.
                      --  We must also generate a cross-reference entry because
                      --  references to other primitives were already created
                      --  when type was frozen.
@@ -1527,6 +1527,7 @@ package body Sem_Disp is
                      if Present (DTC_Entity (Old_Subp)) then
                         Set_DTC_Entity (Subp, DTC_Entity (Old_Subp));
                         Set_DT_Position_Value (Subp, DT_Position (Old_Subp));
+                        Create_Extra_Formals (Subp);
 
                         if not Restriction_Active (No_Dispatching_Calls) then
                            if Building_Static_DT (Tagged_Type) then

Reply via email to