From: Eric Botcazou <ebotcazou@adacore.com>
Date: Thu, 11 Dec 2025 19:08:54 +0000 (+0100)
Subject: Ada: Fix internal error on incomplete private tagged type
X-Git-Url: http://git.ipfire.org/?a=commitdiff_plain;h=b0365ca040bdba4de17d72f45bfc18912fca36ac;p=thirdparty%2Fgcc.git

Ada: Fix internal error on incomplete private tagged type

The code expects the partial view but gets the incomplete view instead.

gcc/ada/
	PR ada/123096
	* exp_put_image.adb (Build_Record_Put_Image_Procedure): Call
	Incomplete_Or_Partial_View with Partial_Only set to True.

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

diff --git a/gcc/ada/exp_put_image.adb b/gcc/ada/exp_put_image.adb
index c11bc43cfca..18bcb637913 100644
--- a/gcc/ada/exp_put_image.adb
+++ b/gcc/ada/exp_put_image.adb
@@ -1011,7 +1011,8 @@ package body Exp_Put_Image is
                --  use the first copy instead.
 
                Partial_View := Incomplete_Or_Partial_View
-                                 (Defining_Identifier (Type_Decl));
+                                 (Defining_Identifier (Type_Decl),
+                                  Partial_Only => True);
 
                pragma Assert (Ekind (Partial_View) in
                               E_Private_Type
diff --git a/gcc/testsuite/gnat.dg/specs/put_image2.ads b/gcc/testsuite/gnat.dg/specs/put_image2.ads
new file mode 100644
index 00000000000..0f1f2aec6a7
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/specs/put_image2.ads
@@ -0,0 +1,21 @@
+-- { dg-do compile }
+-- { dg-options "-gnat2022" }
+
+package Put_Image2 is
+
+  type Abstract_Configuration_Provider is tagged;
+
+  type Configuration_Provider_Access is
+    access all Abstract_Configuration_Provider'Class;
+
+  type Abstract_Configuration_Provider
+    (Child : Configuration_Provider_Access := null) is
+    abstract tagged limited private;
+
+private
+
+  type Abstract_Configuration_Provider
+    (Child : Configuration_Provider_Access := null) is
+    abstract tagged limited null record;
+
+end Put_Image2;