[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 1d5f079..907142f 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 0df747b..9a67061 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 923c65b..d028fcd 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,5 +1,10 @@
 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.
 
 2018-04-04  Ed Schonberg  <schonberg@adacore.com>

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;