From: Eric Botcazou <ebotca...@adacore.com> 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. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/sem_warn.adb | 46 ++++++++++++++++++++++++++------ 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 7ecb4d9c4a6..125f5c701e0 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 e7848701818..cdf28aecbf5 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 -- 2.42.0