Commit 5c13a04e by Eric Botcazou Committed by Pierre-Marie de Rodat

[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
parent 1784b1eb
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
......
......@@ -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;
......
......@@ -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;
......
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.
......
-- { dg-do compile }
-- { dg-options "-gnatw.x -gnatd.a" }
package body Warn31 is
procedure Dummy is null;
end Warn31;
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
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment