[Ada] Spurious warning on object declaration with address clause

The compiler warns on an object declaration with default initialization
and an address clause, to indicate that the overlay implied by the address
clause might affect a value elsewhere. The warning is suppressed if the type
carries the Suppress_Initialization aspect. With this patch the compiler
also inhibits the warning if the aspect is specified for the object itself.

2018-05-21  Ed Schonberg  <schonberg@adacore.com>

gcc/ada/

	* freeze.adb (Warn_Overlay): Do not emit a wawrning on an object
	declaration with an explicit address clause and a type with default
	initialization, if the declaration carries an aspect
	Suppress_Initialization.

gcc/testsuite/

	* gnat.dg/suppress_initialization.adb,
	gnat.dg/suppress_initialization_pkg.ads: New testcase.

From-SVN: r260471

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 1d5f07919f42c413e952dfc7474785a7b9d7b015..907142ff6efc545f0bcc4bdaf0cfeac357b832f2 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,10 @@
+2018-05-21  Ed Schonberg  <schonberg@adacore.com>
+
+       * freeze.adb (Warn_Overlay): Do not emit a wawrning on an object
+       declaration with an explicit address clause and a type with default
+       initialization, if the declaration carries an aspect
+       Suppress_Initialization.
+
 2018-04-04  Daniel Mercier  <mercier@adacore.com>
 
        * pprint.adb: Use mixed case for attribute names.

diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb
index 0df747b911854f8a0f58f6c936f580178287dcee..9a67061e3fcb5a3c3be9bb11faac3ab1aeee3c41 100644 (file)
--- a/gcc/ada/freeze.adb
+++ b/gcc/ada/freeze.adb
@@ -8690,11 +8690,14 @@ package body Freeze is
       --  tested for because predefined String types are initialized by inline
       --  code rather than by an init_proc). Note that we do not give the
       --  warning for Initialize_Scalars, since we suppressed initialization
-      --  in this case. Also, do not warn if Suppress_Initialization is set.
+      --  in this case. Also, do not warn if Suppress_Initialization is set
+      --  either on the type, or on the object via pragma or aspect.
 
       if Present (Expr)
         and then not Is_Imported (Ent)
         and then not Initialization_Suppressed (Typ)
+        and then not (Ekind (Ent) = E_Variable
+                        and then Initialization_Suppressed (Ent))
         and then (Has_Non_Null_Base_Init_Proc (Typ)
                    or else Is_Access_Type (Typ)
                    or else (Normalize_Scalars

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 923c65b09c3f60fdc64c522775171d9d84b14595..d028fcd5c5105752659985ab200e7440058bb55f 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2018-04-04  Ed Schonberg  <schonberg@adacore.com>
+
+       * gnat.dg/suppress_initialization.adb,
+       gnat.dg/suppress_initialization_pkg.ads: New testcase.
+
 2018-04-04  Ed Schonberg  <schonberg@adacore.com>
 
        * gnat.dg/exit1.adb: New testcase.

diff --git a/gcc/testsuite/gnat.dg/suppress_initialization.adb b/gcc/testsuite/gnat.dg/suppress_initialization.adb
new file mode 100644 (file)
index 0000000..68293d5
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/suppress_initialization.adb
@@ -0,0 +1,8 @@
+--  { dg-do compile }
+
+with Suppress_Initialization_Pkg;
+
+procedure Suppress_Initialization is
+begin
+   Suppress_Initialization_Pkg.Read;
+end Suppress_Initialization;

diff --git a/gcc/testsuite/gnat.dg/suppress_initialization_pkg.ads b/gcc/testsuite/gnat.dg/suppress_initialization_pkg.ads
new file mode 100644 (file)
index 0000000..4128067
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/suppress_initialization_pkg.ads
@@ -0,0 +1,31 @@
+with Interfaces; use Interfaces;
+with System;
+
+package Suppress_Initialization_Pkg is
+
+   type Discriminated_Type (Foo : Unsigned_8 := 0) is record
+      case Foo is
+         when 0 =>
+            Bar  : Boolean;
+         when 1 =>
+            Baz  : Unsigned_32;
+         when others =>
+            null;
+      end case;
+   end record;
+
+   for Discriminated_Type use record
+      Foo at 0 range  0 ..  7;
+      Bar at 1 range  0 ..  0;
+      Baz at 1 range  0 .. 31;
+   end record;
+
+   External : Discriminated_Type
+   with
+     Volatile,
+     Suppress_Initialization,
+     Address => System'To_Address (16#1234_5678#);
+
+   procedure Read;
+
+end Suppress_Initialization_Pkg;