diff options
author | Eric Botcazou <ebotcazou@adacore.com> | 2023-10-31 17:49:47 +0100 |
---|---|---|
committer | Marc Poulhiès <poulhies@adacore.com> | 2023-11-21 10:57:42 +0100 |
commit | 3bf92fe3f2e4d6915ee6b9e9cb9cd9778a3386df (patch) | |
tree | c8092c601e51ad7c1c0938aed3b3345f24927eb5 | |
parent | ea60a4cd194eeea2d7a63b93b6b01b9c951302da (diff) | |
download | gcc-3bf92fe3f2e4d6915ee6b9e9cb9cd9778a3386df.zip gcc-3bf92fe3f2e4d6915ee6b9e9cb9cd9778a3386df.tar.gz gcc-3bf92fe3f2e4d6915ee6b9e9cb9cd9778a3386df.tar.bz2 |
ada: Small consistency fix for -gnatwv warning
The goal is to arrange for the warning to be issued consistently between
objects whose address is taken and objects whose address is not taken.
gcc/ada/
* sem_warn.adb (Check_References.Type_OK_For_No_Value_Assigned):
New predicate.
(Check_References): For Warn_On_No_Value_Assigned, use the same test
on the type in the address-not-taken and default cases.
gcc/testsuite/ChangeLog:
* gnat.dg/warn25.adb: Add xfail.
-rw-r--r-- | gcc/ada/sem_warn.adb | 46 | ||||
-rw-r--r-- | gcc/testsuite/gnat.dg/warn25.adb | 1 |
2 files changed, 39 insertions, 8 deletions
diff --git a/gcc/ada/sem_warn.adb b/gcc/ada/sem_warn.adb index 7ecb4d9..125f5c7 100644 --- a/gcc/ada/sem_warn.adb +++ b/gcc/ada/sem_warn.adb @@ -857,6 +857,10 @@ package body Sem_Warn is -- from another unit. This is true for entities in packages that are at -- the library level. + function Type_OK_For_No_Value_Assigned (T : Entity_Id) return Boolean; + -- Return True if it is OK for an object of type T to be referenced + -- without having been assigned a value in the source. + function Warnings_Off_E1 return Boolean; -- Return True if Warnings_Off is set for E1, or for its Etype (E1T), -- or for the base type of E1T. @@ -1121,6 +1125,37 @@ package body Sem_Warn is end loop; end Publicly_Referenceable; + ----------------------------------- + -- Type_OK_For_No_Value_Assigned -- + ----------------------------------- + + function Type_OK_For_No_Value_Assigned (T : Entity_Id) return Boolean is + begin + -- No information for generic types, so be conservative + + if Is_Generic_Type (T) then + return False; + end if; + + -- Even if objects of access types are implicitly initialized to null + + if Is_Access_Type (T) then + return False; + end if; + + -- The criterion is whether the type is (partially) initialized in + -- the source, in other words we disregard implicit default values. + -- But we do not require full initialization for by-reference types + -- because they are complex and it may not be possible to have it. + + if Is_By_Reference_Type (T) then + return + Is_Partially_Initialized_Type (T, Include_Implicit => False); + else + return Is_Fully_Initialized_Type (T); + end if; + end Type_OK_For_No_Value_Assigned; + --------------------- -- Warnings_Off_E1 -- --------------------- @@ -1414,10 +1449,7 @@ package body Sem_Warn is and then not Warnings_Off_E1 and then not Has_Junk_Name (E1) then - if Is_Access_Type (E1T) - or else - not Is_Partially_Initialized_Type (E1T, False) - then + if not Type_OK_For_No_Value_Assigned (E1T) then Output_Reference_Error ("?v?variable& is read but never assigned!"); end if; @@ -1456,14 +1488,12 @@ package body Sem_Warn is goto Continue; end if; - -- Check for unset reference. If type of object has - -- preelaborable initialization, warning is misleading. + -- Check for unset reference if Warn_On_No_Value_Assigned and then Present (UR) - and then not Known_To_Have_Preelab_Init (Etype (E1)) + and then not Type_OK_For_No_Value_Assigned (E1T) then - -- Don't issue warning if appearing inside Initial_Condition -- pragma or aspect, since that expression is not evaluated -- at the point where it occurs in the source. diff --git a/gcc/testsuite/gnat.dg/warn25.adb b/gcc/testsuite/gnat.dg/warn25.adb index e784870..cdf28ae 100644 --- a/gcc/testsuite/gnat.dg/warn25.adb +++ b/gcc/testsuite/gnat.dg/warn25.adb @@ -1,5 +1,6 @@ -- { dg-do compile } -- { dg-options "-gnatwa" } +-- { dg-xfail-if "expected regression" { *-*-* } } with Ada.Exceptions; procedure Warn25 is |