[gcc r15-7316] Ada: Fix segfault on uninitialized variable as operand of primitive operator

[Eric Botcazou via Gcc-cvs]

https://gcc.gnu.org/g:8ca6bbf84c168056c94b5f0374fb82916ee24772

commit r15-7316-g8ca6bbf84c168056c94b5f0374fb82916ee24772
Author: Eric Botcazou <ebotca...@adacore.com>
Date:   Sat Feb 1 10:56:44 2025 +0100

    Ada: Fix segfault on uninitialized variable as operand of primitive operator
    
    ...of derived real type.  It comes from an unexpected internal adjustment.
    
    gcc/ada/
            PR ada/118712
            * sem_warn.adb (Check_References): Deal with small adjustments of
            references.
    
    gcc/testsuite/
            * gnat.dg/warn33.adb: New test.
            * gnat.dg/warn33_pkg.ads: New helper.

Diff:
---
 gcc/ada/sem_warn.adb                 | 4 ++++
 gcc/testsuite/gnat.dg/warn33.adb     | 9 +++++++++
 gcc/testsuite/gnat.dg/warn33_pkg.ads | 7 +++++++
 3 files changed, 20 insertions(+)

diff --git a/gcc/ada/sem_warn.adb b/gcc/ada/sem_warn.adb
index e460799da1f0..35ef61664723 100644
--- a/gcc/ada/sem_warn.adb
+++ b/gcc/ada/sem_warn.adb
@@ -1257,6 +1257,10 @@ package body Sem_Warn is
                   UR := Unset_Reference (E1);
                end if;
 
+               --  Protect again small adjustments of reference
+
+               UR := Unqual_Conv (UR);
+
                --  Special processing for access types
 
                if Present (UR) and then Is_Access_Type (E1T) then
diff --git a/gcc/testsuite/gnat.dg/warn33.adb b/gcc/testsuite/gnat.dg/warn33.adb
new file mode 100644
index 000000000000..779e2d12cfcf
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/warn33.adb
@@ -0,0 +1,9 @@
+--  { dg-do compile }
+
+with Warn33_Pkg; use Warn33_Pkg;
+
+procedure Warn33 is
+  Var : DerT;
+begin
+  Var := 1.0 - Var; -- { dg-warning "may be referenced before" }
+end;
diff --git a/gcc/testsuite/gnat.dg/warn33_pkg.ads 
b/gcc/testsuite/gnat.dg/warn33_pkg.ads
new file mode 100644
index 000000000000..326fda85f981
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/warn33_pkg.ads
@@ -0,0 +1,7 @@
+package Warn33_Pkg is
+
+  type GenT is delta 1.0 range 1.0 .. 10.0;
+  function "-" (X : GenT; Y : GenT) return GenT;
+  type DerT is new GenT;
+
+end Warn33_Pkg;