aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorEric Botcazou <ebotcazou@adacore.com>2025-02-01 10:56:44 +0100
committerEric Botcazou <ebotcazou@adacore.com>2025-02-01 11:41:10 +0100
commit8ca6bbf84c168056c94b5f0374fb82916ee24772 (patch)
tree1a3395a8269921c9417da1d6ab9942926ad4d9de
parentb38efaf36058b40aaf8659a9348815110242ced8 (diff)
downloadgcc-8ca6bbf84c168056c94b5f0374fb82916ee24772.zip
gcc-8ca6bbf84c168056c94b5f0374fb82916ee24772.tar.gz
gcc-8ca6bbf84c168056c94b5f0374fb82916ee24772.tar.bz2
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.
-rw-r--r--gcc/ada/sem_warn.adb4
-rw-r--r--gcc/testsuite/gnat.dg/warn33.adb9
-rw-r--r--gcc/testsuite/gnat.dg/warn33_pkg.ads7
3 files changed, 20 insertions, 0 deletions
diff --git a/gcc/ada/sem_warn.adb b/gcc/ada/sem_warn.adb
index e460799..35ef616 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 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
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;