On platforms that require strict alignment of memory accesses, the per-object
form of pragma Suppress (Alignment_Check) also disables the alignment warning
associated with the check. That's not the case for the global form and this
change fixes the inconsistency.
Here's an example on a small package compiled with -gnatl:
Compiling: p.ads
Source file time stamp: 2017-08-07 10:41:19
Compiled at: 2017-08-07 15:19:52
1. package P is
2.
3. type Arr is array (1 .. 16) of Short_Integer;
4.
5. A : Arr;
6.
7. pragma Suppress (Alignment_Check);
8.
9. F1 : Float;
10. for F1 use at A'Address; -- no warning
11.
12. F2 : Float;
13. for F2 use at A'Address; -- warning
|
>>> warning: specified address for "F2" may be inconsistent with
alignment
>>> warning: program execution may be erroneous (RM 13.3(27))
>>> warning: alignment of "F2" is 4
>>> warning: alignment of "A" is 2
14. pragma Unsuppress (Alignment_Check, F2);
15.
16. pragma Unsuppress (Alignment_Check);
17.
18. F3 : Float;
19. for F3 use at A'Address; -- warning
|
>>> warning: specified address for "F3" may be inconsistent with
alignment
>>> warning: program execution may be erroneous (RM 13.3(27))
>>> warning: alignment of "F3" is 4
>>> warning: alignment of "A" is 2
20.
21. F4 : Float;
22. for F4 use at A'Address; -- no warning
23. pragma Suppress (Alignment_Check, F4);
24.
25. end P;
25 lines: No errors, 8 warnings
Tested on x86_64-pc-linux-gnu, committed on trunk
2017-09-13 Eric Botcazou <ebotca...@adacore.com>
* sem_ch13.adb (Register_Address_Clause_Check): New procedure to save
the suppression status of Alignment_Check on the current scope.
(Alignment_Checks_Suppressed): New function to use the saved instead of
the current suppression status of Alignment_Check.
(Address_Clause_Check_Record): Add Alignment_Checks_Suppressed field.
(Analyze_Attribute_Definition_Clause): Instead of manually appending to
the table, call Register_Address_Clause_Check.
(Validate_Address_Clauses): Call Alignment_Checks_Suppressed on the
recorded address clause instead of its entity.
Index: sem_ch13.adb
===================================================================
--- sem_ch13.adb (revision 252075)
+++ sem_ch13.adb (working copy)
@@ -203,6 +203,15 @@
-- renaming_as_body. For tagged types, the specification is one of the
-- primitive specs.
+ procedure Register_Address_Clause_Check
+ (N : Node_Id;
+ X : Entity_Id;
+ A : Uint;
+ Y : Entity_Id;
+ Off : Boolean);
+ -- Register a check for the address clause N. The rest of the parameters
+ -- are in keeping with the components of Address_Clause_Check_Record below.
+
procedure Resolve_Iterable_Operation
(N : Node_Id;
Cursor : Entity_Id;
@@ -318,6 +327,11 @@
Off : Boolean;
-- Whether the address is offset within Y in the second case
+
+ Alignment_Checks_Suppressed : Boolean;
+ -- Whether alignment checks are suppressed by an active scope suppress
+ -- setting. We need to save the value in order to be able to reuse it
+ -- after the back end has been run.
end record;
package Address_Clause_Checks is new Table.Table (
@@ -328,6 +342,26 @@
Table_Increment => 200,
Table_Name => "Address_Clause_Checks");
+ function Alignment_Checks_Suppressed
+ (ACCR : Address_Clause_Check_Record) return Boolean;
+ -- Return whether the alignment check generated for the address clause
+ -- is suppressed.
+
+ ---------------------------------
+ -- Alignment_Checks_Suppressed --
+ ---------------------------------
+
+ function Alignment_Checks_Suppressed
+ (ACCR : Address_Clause_Check_Record) return Boolean
+ is
+ begin
+ if Checks_May_Be_Suppressed (ACCR.X) then
+ return Is_Check_Suppressed (ACCR.X, Alignment_Check);
+ else
+ return ACCR.Alignment_Checks_Suppressed;
+ end if;
+ end Alignment_Checks_Suppressed;
+
-----------------------------------------
-- Adjust_Record_For_Reverse_Bit_Order --
-----------------------------------------
@@ -5047,8 +5081,8 @@
and then not Is_Generic_Type (Etype (U_Ent))
and then Address_Clause_Overlay_Warnings
then
- Address_Clause_Checks.Append
- ((N, U_Ent, No_Uint, O_Ent, Off));
+ Register_Address_Clause_Check
+ (N, U_Ent, No_Uint, O_Ent, Off);
end if;
else
-- If this is not an overlay, mark a variable as being
@@ -5073,8 +5107,8 @@
if Compile_Time_Known_Value (Addr)
and then Address_Clause_Overlay_Warnings
then
- Address_Clause_Checks.Append
- ((N, U_Ent, Expr_Value (Addr), Empty, False));
+ Register_Address_Clause_Check
+ (N, U_Ent, Expr_Value (Addr), Empty, False);
end if;
end;
end if;
@@ -12254,6 +12288,22 @@
end if;
end Push_Scope_And_Install_Discriminants;
+ -----------------------------------
+ -- Register_Address_Clause_Check --
+ -----------------------------------
+
+ procedure Register_Address_Clause_Check
+ (N : Node_Id;
+ X : Entity_Id;
+ A : Uint;
+ Y : Entity_Id;
+ Off : Boolean)
+ is
+ ACS : constant Boolean := Scope_Suppress.Suppress (Alignment_Check);
+ begin
+ Address_Clause_Checks.Append ((N, X, A, Y, Off, ACS));
+ end Register_Address_Clause_Check;
+
------------------------
-- Rep_Item_Too_Early --
------------------------
@@ -13465,7 +13515,7 @@
-- Check for known value not multiple of alignment
if No (ACCR.Y) then
- if not Alignment_Checks_Suppressed (ACCR.X)
+ if not Alignment_Checks_Suppressed (ACCR)
and then X_Alignment /= 0
and then ACCR.A mod X_Alignment /= 0
then
@@ -13510,7 +13560,7 @@
-- Note: we do not check the alignment if we gave a size
-- warning, since it would likely be redundant.
- elsif not Alignment_Checks_Suppressed (ACCR.X)
+ elsif not Alignment_Checks_Suppressed (ACCR)
and then Y_Alignment /= Uint_0
and then
(Y_Alignment < X_Alignment
