From f9e9ab637986a24d7cd8538ff5bd68e599ce6e12 Mon Sep 17 00:00:00 2001 From: Ed Schonberg Date: Mon, 21 May 2018 14:52:36 +0000 Subject: [PATCH] [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 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 --- gcc/ada/ChangeLog | 7 +++++ gcc/ada/freeze.adb | 5 ++- gcc/testsuite/ChangeLog | 5 +++ .../gnat.dg/suppress_initialization.adb | 8 +++++ .../gnat.dg/suppress_initialization_pkg.ads | 31 +++++++++++++++++++ 5 files changed, 55 insertions(+), 1 deletion(-) create mode 100644 gcc/testsuite/gnat.dg/suppress_initialization.adb create mode 100644 gcc/testsuite/gnat.dg/suppress_initialization_pkg.ads 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 + + * 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 * 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 + + * gnat.dg/suppress_initialization.adb, + gnat.dg/suppress_initialization_pkg.ads: New testcase. + 2018-04-04 Ed Schonberg * 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; -- 2.30.2