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 --git a/gcc/ada/sem_warn.adb b/gcc/ada/sem_warn.adb
index eaf9a257ba0417aba0c53b52705cff99e340faf0..6a7d36e58d2e32da371553a76c7803029491bc4f 100644 (file)
--- a/gcc/ada/sem_warn.adb
+++ b/gcc/ada/sem_warn.adb
@@ -1229,6 +1229,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 (file)
index 0000000..779e2d1
--- /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 (file)
index 0000000..326fda8
--- /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;