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 c11bc43cfcabab9bb1317ac2804c2cb352a5ea5c..18bcb637913650ddda9488a6d57c1228ffba7f32 100644 (file)
--- 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 (file)
index 0000000..0f1f2ae
--- /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;