[Ada] Fix spurious alignment warning on simple address clause

This eliminates a spurious alignment warning given by the compiler on an
address clause when the No_Exception_Propagation restriction is in
effect and the -gnatw.x switch is used. In this configuration the
address clauses whose expression is itself of the form X'Address would
not be sufficiently analyzed and, therefore, the compiler might give
false positive warnings.

2019-09-18  Eric Botcazou  <ebotcazou@adacore.com>

gcc/ada/

	* checks.ads (Alignment_Warnings_Record): Add P component.
	* checks.adb (Apply_Address_Clause_Check): Be prepared to kill
	the warning also if the clause is of the form X'Address.
	(Validate_Alignment_Check_Warning): Kill the warning if the
	clause is of the form X'Address and the alignment of X is
	compatible.

gcc/testsuite/

	* gnat.dg/warn31.adb, gnat.dg/warn31.ads: New testcase.

From-SVN: r275865

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 2a5ca047355bfb26a2246bf234e934b1da757cd7..240bc087a66660dc32a6a872e780bd6b5aa44c14 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,12 @@
+2019-09-18  Eric Botcazou  <ebotcazou@adacore.com>
+
+       * checks.ads (Alignment_Warnings_Record): Add P component.
+       * checks.adb (Apply_Address_Clause_Check): Be prepared to kill
+       the warning also if the clause is of the form X'Address.
+       (Validate_Alignment_Check_Warning): Kill the warning if the
+       clause is of the form X'Address and the alignment of X is
+       compatible.
+
 2019-09-18  Ed Schonberg  <schonberg@adacore.com>
 
        * sem_res.adb (Set_Mixed_Node_Expression): If a conditional

diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb
index caee9ad7fd564d7fd214fad7ecbc742df1ad1c9d..9ca1cf0cdce0a993753845a31e3e74c4641e36e0 100644 (file)
--- a/gcc/ada/checks.adb
+++ b/gcc/ada/checks.adb
@@ -808,7 +808,21 @@ package body Checks is
 
             if Compile_Time_Known_Value (Expr) then
                Alignment_Warnings.Append
-                 ((E => E, A => Expr_Value (Expr), W => Warning_Msg));
+                 ((E => E,
+                   A => Expr_Value (Expr),
+                   P => Empty,
+                   W => Warning_Msg));
+
+            --  Likewise if the expression is of the form X'Address
+
+            elsif Nkind (Expr) = N_Attribute_Reference
+              and then Attribute_Name (Expr) = Name_Address
+            then
+               Alignment_Warnings.Append
+                 ((E => E,
+                   A => No_Uint,
+                   P => Prefix (Expr),
+                   W => Warning_Msg));
 
             --  Add explanation of the warning generated by the check
 
@@ -10925,7 +10939,12 @@ package body Checks is
                     renames Alignment_Warnings.Table (J);
          begin
             if Known_Alignment (AWR.E)
-              and then AWR.A mod Alignment (AWR.E) = 0
+              and then ((AWR.A /= No_Uint
+                          and then AWR.A mod Alignment (AWR.E) = 0)
+                        or else (Present (AWR.P)
+                                  and then Has_Compatible_Alignment
+                                             (AWR.E, AWR.P, True) =
+                                               Known_Compatible))
             then
                Delete_Warning_And_Continuations (AWR.W);
             end if;

diff --git a/gcc/ada/checks.ads b/gcc/ada/checks.ads
index 9bf29081764078840d7947df71f92e46dea03a80..a1538a3f48fa74df505dadf3ac1ce5740b03302f 100644 (file)
--- a/gcc/ada/checks.ads
+++ b/gcc/ada/checks.ads
@@ -90,7 +90,7 @@ package Checks is
    --  When we have address clauses, there is an issue of whether the address
    --  specified is appropriate to the alignment. In the general case where the
    --  address is dynamic, we generate a check and a possible warning (this
-   --  warning occurs for example if we have a restricted run time with the
+   --  warning occurs for example if we have a restricted runtime with the
    --  restriction No_Exception_Propagation). We also issue this warning in
    --  the case where the address is static, but we don't know the alignment
    --  at the time we process the address clause. In such a case, we issue the
@@ -98,7 +98,7 @@ package Checks is
    --  annotated the actual alignment chosen) that the warning was not needed.
 
    --  To deal with deleting these potentially annoying warnings, we save the
-   --  warning information in a table, and then delete the waranings in the
+   --  warning information in a table, and then delete the warnings in the
    --  post compilation validation stage if we can tell that the check would
    --  never fail (in general the back end will also optimize away the check
    --  in such cases).
@@ -113,6 +113,9 @@ package Checks is
       --  Compile time known value of address clause for which the alignment
       --  is to be checked once we know the alignment.
 
+      P : Node_Id;
+      --  Prefix of address clause when it is of the form X'Address
+
       W : Error_Msg_Id;
       --  Id of warning message we might delete
    end record;

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 7cfdc4cbb2aa04340f077fb9aec8f2dc3d3ab58b..dc84ed95055ffc019340e37c2e2a51374f862b50 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,7 @@
+2019-09-18  Eric Botcazou  <ebotcazou@adacore.com>
+
+       * gnat.dg/warn31.adb, gnat.dg/warn31.ads: New testcase.
+
 2019-09-18  Ed Schonberg  <schonberg@adacore.com>
 
        * gnat.dg/fixedpnt8.adb: New testcase.

diff --git a/gcc/testsuite/gnat.dg/warn31.adb b/gcc/testsuite/gnat.dg/warn31.adb
new file mode 100644 (file)
index 0000000..136c84f
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/warn31.adb
@@ -0,0 +1,5 @@
+--  { dg-do compile }
+--  { dg-options "-gnatw.x -gnatd.a" }
+package body Warn31 is
+    procedure Dummy is null;
+end Warn31;

diff --git a/gcc/testsuite/gnat.dg/warn31.ads b/gcc/testsuite/gnat.dg/warn31.ads
new file mode 100644 (file)
index 0000000..5311079
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/warn31.ads
@@ -0,0 +1,20 @@
+pragma Restrictions (No_Exception_Propagation);
+
+package Warn31 is
+
+   type U16 is mod 2 ** 16;
+   type U32 is mod 2 ** 32;
+
+   type Pair is record
+      X, Y : U16;
+   end record;
+   for Pair'Alignment use U32'Alignment;
+
+   Blob : array (1 .. 2) of Pair;
+
+   Sum : array (1 .. 2) of U32;
+   for Sum'Address use Blob'Address;
+
+   procedure Dummy;
+
+end Warn31;
\ No newline at end of file