diff options
author | Eric Botcazou <ebotcazou@adacore.com> | 2025-02-01 10:56:44 +0100 |
---|---|---|
committer | Eric Botcazou <ebotcazou@adacore.com> | 2025-02-01 11:41:10 +0100 |
commit | 8ca6bbf84c168056c94b5f0374fb82916ee24772 (patch) | |
tree | 1a3395a8269921c9417da1d6ab9942926ad4d9de | |
parent | b38efaf36058b40aaf8659a9348815110242ced8 (diff) | |
download | gcc-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.adb | 4 | ||||
-rw-r--r-- | gcc/testsuite/gnat.dg/warn33.adb | 9 | ||||
-rw-r--r-- | gcc/testsuite/gnat.dg/warn33_pkg.ads | 7 |
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; |