From: Eric Botcazou Date: Wed, 18 Sep 2019 08:33:44 +0000 (+0000) Subject: [Ada] Fix spurious alignment warning on simple address clause X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=5c13a04e0dcb6e6c07708dc6796968ee89b4560b;p=gcc.git [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 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 2a5ca047355..240bc087a66 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,12 @@ +2019-09-18 Eric Botcazou + + * 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 * sem_res.adb (Set_Mixed_Node_Expression): If a conditional diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb index caee9ad7fd5..9ca1cf0cdce 100644 --- 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 9bf29081764..a1538a3f48f 100644 --- 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 7cfdc4cbb2a..dc84ed95055 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,7 @@ +2019-09-18 Eric Botcazou + + * gnat.dg/warn31.adb, gnat.dg/warn31.ads: New testcase. + 2019-09-18 Ed Schonberg * 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 index 00000000000..136c84f6298 --- /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 index 00000000000..5311079a69e --- /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