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.

diff --git a/gcc/ada/sem_warn.adb b/gcc/ada/sem_warn.adb
index 7ecb4d9c4a6710cb64252fd6eba96b428837c047..125f5c701e0d3ab4dbcf662c04568833f4db9549 100644 (file)
--- 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 e7848701818619ab60ffa5d159031cb876aa4714..cdf28aecbf534b061a3885cf0a594dc619b602f4 100644 (file)
--- 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