From: Eric Botcazou <ebotcazou@gcc.gnu.org>
Date: Sat, 27 Dec 2025 09:24:52 +0000 (+0100)
Subject: Ada: Fix assertion failure for unfrozen mutably tagged type as actual
X-Git-Url: http://git.ipfire.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=48db9b45057416ba3116fa9bc6e63ff13990c92d;p=thirdparty%2Fgcc.git

Ada: Fix assertion failure for unfrozen mutably tagged type as actual

...in instance.  An instantiation is a freezing point for the actuals,
so the mutably tagged type will be frozen by the instantiation, but this
happens too late in the current implementation of mutably tagged types,
because the declaration of their CW-equivalent type is not analyzed until
after the type is frozen.

gcc/ada/
	PR ada/123306
	* sem_ch12.adb (Analyze_One_Association): Immediately freeze the
	root type of mutably tagged types used as actual type parameters.

gcc/testsuite/
	* gnat.dg/specs/mutably_tagged1.ads: New test.
---

diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb
index d2478d24ec8..729a6b145ac 100644
--- a/gcc/ada/sem_ch12.adb
+++ b/gcc/ada/sem_ch12.adb
@@ -2657,9 +2657,20 @@ package body Sem_Ch12 is
                if Ekind (Etype (Match)) /= E_Void
                  and then Is_Mutably_Tagged_Type (Etype (Match))
                then
+                  --  The declaration of the CW-equivalent type of a mutably
+                  --  tagged type is analyzed when the tagged type is frozen.
+
+                  if Nkind (N) /= N_Formal_Package_Declaration
+                    and then Ekind (Defining_Identifier (Assoc.An_Formal)) /=
+                                                              E_Incomplete_Type
+                  then
+                     Freeze_Before (N, Root_Type (Etype (Match)));
+                  end if;
+
                   Rewrite (Match, New_Occurrence_Of
                     (Class_Wide_Equivalent_Type
                       (Etype (Match)), Sloc (Match)));
+
                   Analyze (Match);
                end if;
 
diff --git a/gcc/testsuite/gnat.dg/specs/mutably_tagged1.ads b/gcc/testsuite/gnat.dg/specs/mutably_tagged1.ads
new file mode 100644
index 00000000000..4c03f0ff2d2
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/specs/mutably_tagged1.ads
@@ -0,0 +1,15 @@
+-- { dg-do compile }
+-- { dg-options "-gnatX0" }
+
+package Mutably_Tagged1 is
+
+  generic
+    type T is private;
+  package G is
+  end G;
+
+  type Rec is tagged null record with Size'Class => 128;
+
+  package My_G is new G (Rec'Class);
+
+end Mutably_Tagged1;