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.
Tested on x86_64-pc-linux-gnu, committed on trunk
2018-05-21 Ed Schonberg <schonb...@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.
--- gcc/ada/freeze.adb
+++ 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
--- /dev/null
new file mode 100644
+++ 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;
--- /dev/null
new file mode 100644
+++ 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;