[Ada] Warn on buffer overrun with complex overlay

Arnaud Charlet charlet@adacore.com
Thu Jun 16 10:22:00 GMT 2016


This change improves the warning issued for buffer overruns caused by overlays
where the underlying object is too small, by taking into account the offset
of the overlaid object from the first bit of the underlying object.

The effect is visible on the following package:

     1. with Interfaces; use Interfaces;
     2.
     3. package P is
     4.
     5.   type Arr1 is array (Positive range <>) of Unsigned_16;
     6.
     7.   type Rec1 is record
     8.     I : Integer;
     9.     A : Arr1 (1 .. 4);
    10.   end record;
    11.
    12.   type Arr2 is array (Positive range <>) of Rec1;
    13.
    14.   type Rec2 is record
    15.     I : Integer;
    16.     A : Arr2 (1 .. 2);
    17.   end record;
    18.
    19.   R : Rec2;
    20.
    21.   Obj1 : Arr1 (1 .. 13);
    22.   for Obj1'Address use R.A(1).I'Address;  -- warning
          |
        >>> warning: "Obj1" overlays smaller object
        >>> warning: program execution may be erroneous
        >>> warning: size of "Obj1" is 208
        >>> warning: size of "R" is 224
        >>> warning: and offset of "Obj1" is 32

    23.
    24.   Obj2 : Arr1 (1 .. 7);
    25.   for Obj2'Address use R.A(2).I'Address;  -- warning
          |
        >>> warning: "Obj2" overlays smaller object
        >>> warning: program execution may be erroneous
        >>> warning: size of "Obj2" is 112
        >>> warning: size of "R" is 224
        >>> warning: and offset of "Obj2" is 128

    26.
    27.   Obj3 : Arr1 (1 .. 10);
    28.   for Obj3'Address use R.A(1).A(2)'Address;  -- warning
          |
        >>> warning: "Obj3" overlays smaller object
        >>> warning: program execution may be erroneous
        >>> warning: size of "Obj3" is 160
        >>> warning: size of "R" is 224
        >>> warning: and offset of "Obj3" is 80

    29.
    30.   Obj4 : Arr1 (1 .. 2);
    31.   for Obj4'Address use R.A(2).A(4)'Address;  -- warning
          |
        >>> warning: "Obj4" overlays smaller object
        >>> warning: program execution may be erroneous
        >>> warning: size of "Obj4" is 32
        >>> warning: size of "R" is 224
        >>> warning: and offset of "Obj4" is 208

    32.
    33.   Obj5 : Unsigned_16;
    34.   for Obj5'Address use R.A(2).A(4)'Address;  -- no warning
    35.
    36. end P;

Tested on x86_64-pc-linux-gnu, committed on trunk

2016-06-16  Eric Botcazou  <ebotcazou@adacore.com>

	* sem_util.ads (Indexed_Component_Bit_Offset): Declare.
	* sem_util.adb (Indexed_Component_Bit_Offset): New
	function returning the offset of an indexed component.
	(Has_Compatible_Alignment_Internal): Call it.
	* sem_ch13.adb (Offset_Value): New function returning the offset of an
	Address attribute reference from the underlying entity.
	(Validate_Address_Clauses): Call it and take the offset into
	account for the size warning.

-------------- next part --------------
Index: sem_util.adb
===================================================================
--- sem_util.adb	(revision 237510)
+++ sem_util.adb	(working copy)
@@ -8780,7 +8780,6 @@
          elsif Nkind (Expr) = N_Indexed_Component then
             declare
                Typ : constant Entity_Id := Etype (Prefix (Expr));
-               Ind : constant Node_Id   := First_Index (Typ);
 
             begin
                --  Packing generates unknown alignment if layout is not done
@@ -8789,22 +8788,12 @@
                   Set_Result (Unknown);
                end if;
 
-               --  Check prefix and component offset
+               --  Check prefix and component offset (or at least size)
 
                Check_Prefix;
-               Offs := Component_Size (Typ);
-
-               --  Small optimization: compute the full offset when possible
-
-               if Offs /= No_Uint
-                 and then Offs > Uint_0
-                 and then Present (Ind)
-                 and then Nkind (Ind) = N_Range
-                 and then Compile_Time_Known_Value (Low_Bound (Ind))
-                 and then Compile_Time_Known_Value (First (Expressions (Expr)))
-               then
-                  Offs := Offs * (Expr_Value (First (Expressions (Expr)))
-                                    - Expr_Value (Low_Bound ((Ind))));
+               Offs := Indexed_Component_Bit_Offset (Expr);
+               if Offs = No_Uint then
+                  Offs := Component_Size (Typ);
                end if;
             end;
          end if;
@@ -11064,6 +11053,59 @@
       return Empty;
    end Incomplete_Or_Partial_View;
 
+   ----------------------------------
+   -- Indexed_Component_Bit_Offset --
+   ----------------------------------
+
+   function Indexed_Component_Bit_Offset (N : Node_Id) return Uint is
+      Exp : constant Node_Id   := First (Expressions (N));
+      Typ : constant Entity_Id := Etype (Prefix (N));
+      Off : constant Uint      := Component_Size (Typ);
+      Ind : Node_Id;
+
+   begin
+      --  Return early if the component size is not known or variable
+
+      if Off = No_Uint or else Off < Uint_0 then
+         return No_Uint;
+      end if;
+
+      --  Deal with the degenerate case of an empty component
+
+      if Off = Uint_0 then
+         return Off;
+      end if;
+
+      --  Check that both the index value and the low bound are known
+
+      if not Compile_Time_Known_Value (Exp) then
+         return No_Uint;
+      end if;
+
+      Ind := First_Index (Typ);
+      if No (Ind) then
+         return No_Uint;
+      end if;
+
+      if Nkind (Ind) = N_Subtype_Indication then
+         Ind := Constraint (Ind);
+
+         if Nkind (Ind) = N_Range_Constraint then
+            Ind := Range_Expression (Ind);
+         end if;
+      end if;
+
+      if Nkind (Ind) /= N_Range
+        or else not Compile_Time_Known_Value (Low_Bound (Ind))
+      then
+         return No_Uint;
+      end if;
+
+      --  Return the scaled offset
+
+      return Off * (Expr_Value (Exp) - Expr_Value (Low_Bound ((Ind))));
+   end Indexed_Component_Bit_Offset;
+
    -----------------------------------------
    -- Inherit_Default_Init_Cond_Procedure --
    -----------------------------------------
Index: sem_util.ads
===================================================================
--- sem_util.ads	(revision 237509)
+++ sem_util.ads	(working copy)
@@ -1232,6 +1232,12 @@
    --  partial view of the same entity. Note that Id may not have a partial
    --  view in which case the function returns Empty.
 
+   function Indexed_Component_Bit_Offset (N : Node_Id) return Uint;
+   --  Given an N_Indexed_Component node, return the first bit position of the
+   --  component if it is known at compile time. A value of No_Uint means that
+   --  either the value is not yet known before back-end processing or it is
+   --  not known at compile time after back-end processing.
+
    procedure Inherit_Default_Init_Cond_Procedure (Typ : Entity_Id);
    --  Inherit the default initial condition procedure from the parent type of
    --  derived type Typ.
Index: sem_ch13.adb
===================================================================
--- sem_ch13.adb	(revision 237429)
+++ sem_ch13.adb	(working copy)
@@ -13626,6 +13626,53 @@
    ------------------------------
 
    procedure Validate_Address_Clauses is
+      function Offset_Value (Expr : Node_Id) return Uint;
+      --  Given an Address attribute reference, return the value in bits of its
+      --  offset from the first bit of the underlying entity, or 0 if it is not
+      --  known at compile time.
+
+      ------------------
+      -- Offset_Value --
+      ------------------
+
+      function Offset_Value (Expr : Node_Id) return Uint is
+         N   : Node_Id := Prefix (Expr);
+         Off : Uint;
+         Val : Uint := Uint_0;
+
+      begin
+         --  Climb the prefix chain and compute the cumulative offset
+
+         loop
+            if Is_Entity_Name (N) then
+               return Val;
+
+            elsif Nkind (N) = N_Selected_Component then
+               Off := Component_Bit_Offset (Entity (Selector_Name (N)));
+               if Off /= No_Uint and then Off >= Uint_0 then
+                  Val := Val + Off;
+                  N   := Prefix (N);
+               else
+                  return Uint_0;
+               end if;
+
+            elsif Nkind (N) = N_Indexed_Component then
+               Off := Indexed_Component_Bit_Offset (N);
+               if Off /= No_Uint then
+                  Val := Val + Off;
+                  N   := Prefix (N);
+               else
+                  return Uint_0;
+               end if;
+
+            else
+               return Uint_0;
+            end if;
+         end loop;
+      end Offset_Value;
+
+   --  Start of processing for Validate_Address_Clauses
+
    begin
       for J in Address_Clause_Checks.First .. Address_Clause_Checks.Last loop
          declare
@@ -13640,6 +13687,8 @@
             X_Size : Uint;
             Y_Size : Uint;
 
+            X_Offs : Uint;
+
          begin
             --  Skip processing of this entry if warning already posted
 
@@ -13651,16 +13700,25 @@
                X_Alignment := Alignment (ACCR.X);
                Y_Alignment := Alignment (ACCR.Y);
 
-               --  Similarly obtain sizes
+               --  Similarly obtain sizes and offset
 
                X_Size := Esize (ACCR.X);
                Y_Size := Esize (ACCR.Y);
 
+               if ACCR.Off
+                 and then Nkind (Expr) = N_Attribute_Reference
+                 and then Attribute_Name (Expr) = Name_Address
+               then
+                  X_Offs := Offset_Value (Expr);
+               else
+                  X_Offs := Uint_0;
+               end if;
+
                --  Check for large object overlaying smaller one
 
                if Y_Size > Uint_0
                  and then X_Size > Uint_0
-                 and then X_Size > Y_Size
+                 and then X_Offs + X_Size > Y_Size
                then
                   Error_Msg_NE ("??& overlays smaller object", ACCR.N, ACCR.X);
                   Error_Msg_N
@@ -13672,6 +13730,11 @@
                   Error_Msg_Uint_1 := Y_Size;
                   Error_Msg_NE ("\??size of & is ^", ACCR.N, ACCR.Y);
 
+                  if X_Offs /= Uint_0 then
+                     Error_Msg_Uint_1 := X_Offs;
+                     Error_Msg_NE ("\??and offset of & is ^", ACCR.N, ACCR.X);
+                  end if;
+
                --  Check for inadequate alignment, both of the base object
                --  and of the offset, if any. We only do this check if the
                --  run-time Alignment_Check is active. No point in warning


More information about the Gcc-patches mailing list