[Ada] Ineffective pragma Suppress (Alignment_Check) on warning

Message ID 20170913103509.GA129511@adacore.com
State New
Headers show
Series
  • [Ada] Ineffective pragma Suppress (Alignment_Check) on warning
Related show

Commit Message

Pierre-Marie de Rodat Sept. 13, 2017, 10:35 a.m.
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  <ebotcazou@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.

Patch

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