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 835e61e3ab03dcd57f7f4230e385f7c59b312b72..217a89436e06e311df03f5eebff59d00fdef9825 100644 (file)
--- 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 (file)
index 0000000..586a618
--- /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 (file)
index 0000000..9410d0d
--- /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;