[gcc r15-9968] Ada: Add missing guard before accessing the Underlying_Record_View field

[Eric Botcazou via Gcc-cvs]

https://gcc.gnu.org/g:762ca0be09e00d02a72bd65fe8c3027a056d4a81

commit r15-9968-g762ca0be09e00d02a72bd65fe8c3027a056d4a81
Author: Eric Botcazou <ebotca...@adacore.com>
Date:   Mon Jul 14 12:11:44 2025 +0200

    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:
---
 gcc/ada/sem_ch4.adb                  | 1 +
 gcc/testsuite/gnat.dg/deref4.adb     | 9 +++++++++
 gcc/testsuite/gnat.dg/deref4_pkg.ads | 8 ++++++++
 3 files changed, 18 insertions(+)

diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb
index 835e61e3ab03..217a89436e06 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 000000000000..586a61869eae
--- /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 000000000000..9410d0d22bc3
--- /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;