From: Eric Botcazou <ebotcazou@adacore.com>
Date: Mon, 14 Jul 2025 10:11:44 +0000 (+0200)
Subject: Ada: Add missing guard before accessing the Underlying_Record_View field
X-Git-Url: http://git.ipfire.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=762ca0be09e00d02a72bd65fe8c3027a056d4a81;p=thirdparty%2Fgcc.git

Ada: Add missing guard before accessing the Underlying_Record_View field

It is necessary when GNAT extensions are enabled (-gnatX switch).

gcc/ada/
	PR ada/121056
	* sem_ch4.adb (Try_Object_Operation.Try_Primitive_Operation): Add
	test on Is_Record_Type before accessing Underlying_Record_View.

gcc/testsuite/
	* gnat.dg/deref4.adb: New test.
	* gnat.dg/deref4_pkg.ads: New helper.
---

diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb
index 835e61e3ab0..217a89436e0 100644
--- a/gcc/ada/sem_ch4.adb
+++ b/gcc/ada/sem_ch4.adb
@@ -10692,6 +10692,7 @@ package body Sem_Ch4 is
 
               or else
                 (Has_Unknown_Discriminants (Typ)
+                  and then Is_Record_Type (Base_Type (Obj_Type))
                   and then Typ = Underlying_Record_View (Base_Type (Obj_Type)))
 
                --  Prefix can be dereferenced
diff --git a/gcc/testsuite/gnat.dg/deref4.adb b/gcc/testsuite/gnat.dg/deref4.adb
new file mode 100644
index 00000000000..586a61869ea
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/deref4.adb
@@ -0,0 +1,9 @@
+-- { dg-do compile }
+-- { dg-options "-gnatX" }
+
+with Deref4_Pkg; use Deref4_Pkg;
+
+procedure Deref4 is
+begin
+  Obj.Proc (null);
+end;
diff --git a/gcc/testsuite/gnat.dg/deref4_pkg.ads b/gcc/testsuite/gnat.dg/deref4_pkg.ads
new file mode 100644
index 00000000000..9410d0d22bc
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/deref4_pkg.ads
@@ -0,0 +1,8 @@
+package Deref4_Pkg is
+
+  type A is tagged null record;
+  type A_Ptr is access A;
+  procedure Proc (This : in out A'Class; Some_Parameter : A_Ptr) is null;
+  Obj : A_Ptr;
+
+end Deref4_Pkg;