diff mbox series

[COMMITTED,11/35] ada: Fix Constraint_Error on mutable assignment

Message ID 20240517083207.130391-11-poulhies@adacore.com
State New
Headers show
Series [COMMITTED,01/35] ada: Add support for 'Object_Size to pragma Compile_Time_{Warning, Error} | expand

Commit Message

Marc Poulhiès May 17, 2024, 8:31 a.m. UTC 
From: Bob Duff <duff@adacore.com>

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.

Tested on x86_64-pc-linux-gnu, committed on master.

---
 gcc/ada/sem_disp.adb | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)
diff mbox series

Patch

diff --git a/gcc/ada/sem_disp.adb b/gcc/ada/sem_disp.adb
index 525a9f7f0a1..fd521a09bc0 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