diff options
| author | Bob Duff <duff@adacore.com> | 2024-03-05 18:35:25 -0500 |
|---|---|---|
| committer | Marc Poulhiès <poulhies@adacore.com> | 2024-05-17 10:21:01 +0200 |
| commit | cb71c251d846032cfb31e86c8e4d678c58a90ecc (patch) | |
| tree | af9f0b4fde2de9146a2b0c006e5de8194746edff /gcc/ada/sem_disp.adb | |
| parent | 376a8ea17dfb3dc1267dc88bd90e5f84b82aadaa (diff) | |
| download | gcc-cb71c251d846032cfb31e86c8e4d678c58a90ecc.zip gcc-cb71c251d846032cfb31e86c8e4d678c58a90ecc.tar.gz gcc-cb71c251d846032cfb31e86c8e4d678c58a90ecc.tar.bz2 | |
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.
Diffstat (limited to 'gcc/ada/sem_disp.adb')
| -rw-r--r-- | gcc/ada/sem_disp.adb | 3 |
1 files changed, 2 insertions, 1 deletions
diff --git a/gcc/ada/sem_disp.adb b/gcc/ada/sem_disp.adb index 525a9f7..fd521a0 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 |