From: Ed Schonberg <schonberg@adacore.com>
Date: Mon, 21 May 2018 14:52:36 +0000 (+0000)
Subject: [Ada] Spurious warning on object declaration with address clause
X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=f9e9ab637986a24d7cd8538ff5bd68e599ce6e12;p=gcc.git

[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 1d5f07919f4..907142ff6ef 100644
--- 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 0df747b9118..9a67061e3fc 100644
--- 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 923c65b09c3..d028fcd5c51 100644
--- 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
index 00000000000..68293d598a3
--- /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
index 00000000000..41280671582
--- /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;