Patchwork [Ada] Diagnose unsupported bit packed arrays

login
register
mail settings
Submitter Arnaud Charlet
Date April 23, 2013, 9:40 a.m.
Message ID <20130423094056.GA28794@adacore.com>
Download mbox | patch
Permalink /patch/238840/
State New
Headers show

Comments

Arnaud Charlet - April 23, 2013, 9:40 a.m.
This change adds circuitry to identify some bit packed arrays that are
known at compile time to exceed the maximum size supported by the
implementation.

The following compilation must be rejected with the indicated error message:
$ gcc large_bit_packed_array.ads
large_bit_packed_array.ads:2:09: bit packed array type may not have more than
  Integer'Last+1 elements

package Large_Bit_Packed_Array is
   type A is array (Integer) of Boolean;
   pragma Pack (A);
end Large_Bit_Packed_Array;

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

2013-04-23  Thomas Quinot  <quinot@adacore.com>

	* freeze.adb (Freeze_Entity): For the case of a bit-packed
	array time that is known at compile time to have more that
	Integer'Last+1 elements, issue an error, since such arrays are
	not supported.

Patch

Index: freeze.adb
===================================================================
--- freeze.adb	(revision 198175)
+++ freeze.adb	(working copy)
@@ -3913,27 +3913,92 @@ 
                   end if;
                end if;
 
-               --  For bit-packed arrays, check the size
+               --  Specific checks for bit-packed arrays
 
-               if Is_Bit_Packed_Array (E) and then Known_RM_Size (E) then
-                  declare
-                     SizC : constant Node_Id := Size_Clause (E);
+               if Is_Bit_Packed_Array (E) then
 
-                     Discard : Boolean;
-                     pragma Warnings (Off, Discard);
+                  --  Check number of elements for bit packed arrays that come
+                  --  from source and have compile time known ranges. The
+                  --  bit-packed arrays circuitry does not support arrays
+                  --  with more than Integer'Last + 1 elements, and when this
+                  --  restriction is violated, causes incorrect data access.
 
-                  begin
-                     --  It is not clear if it is possible to have no size
-                     --  clause at this stage, but it is not worth worrying
-                     --  about. Post error on the entity name in the size
-                     --  clause if present, else on the type entity itself.
+                  --  For the case where this is not compile time known, a
+                  --  run-time check should be generated???
 
-                     if Present (SizC) then
-                        Check_Size (Name (SizC), E, RM_Size (E), Discard);
-                     else
-                        Check_Size (E, E, RM_Size (E), Discard);
-                     end if;
-                  end;
+                  if Comes_From_Source (E) and then Is_Constrained (E) then
+                     declare
+                        Elmts : Uint;
+                        Index : Node_Id;
+                        Ilen  : Node_Id;
+                        Ityp  : Entity_Id;
+
+                     begin
+                        Elmts := Uint_1;
+                        Index := First_Index (E);
+                        while Present (Index) loop
+                           Ityp := Etype (Index);
+
+                           --  Never generate an error if any index is of a
+                           --  generic type. We will check this in instances.
+
+                           if Is_Generic_Type (Ityp) then
+                              Elmts := Uint_0;
+                              exit;
+                           end if;
+
+                           Ilen :=
+                             Make_Attribute_Reference (Loc,
+                               Prefix         =>
+                                 New_Occurrence_Of (Ityp, Loc),
+                               Attribute_Name => Name_Range_Length);
+                           Analyze_And_Resolve (Ilen);
+
+                           --  No attempt is made to check number of elements
+                           --  if not compile time known.
+
+                           if Nkind (Ilen) /= N_Integer_Literal then
+                              Elmts := Uint_0;
+                              exit;
+                           end if;
+
+                           Elmts := Elmts * Intval (Ilen);
+                           Next_Index (Index);
+                        end loop;
+
+                        if Elmts > Intval (High_Bound
+                                             (Scalar_Range
+                                                (Standard_Integer))) + 1
+                        then
+                           Error_Msg_N
+                             ("bit packed array type may not have "
+                              & "more than Integer''Last+1 elements", E);
+                        end if;
+                     end;
+                  end if;
+
+                  --  Check size
+
+                  if Known_RM_Size (E) then
+                     declare
+                        SizC : constant Node_Id := Size_Clause (E);
+
+                        Discard : Boolean;
+                        pragma Warnings (Off, Discard);
+
+                     begin
+                        --  It is not clear if it is possible to have no size
+                        --  clause at this stage, but it is not worth worrying
+                        --  about. Post error on the entity name in the size
+                        --  clause if present, else on the type entity itself.
+
+                        if Present (SizC) then
+                           Check_Size (Name (SizC), E, RM_Size (E), Discard);
+                        else
+                           Check_Size (E, E, RM_Size (E), Discard);
+                        end if;
+                     end;
+                  end if;
                end if;
 
                --  If any of the index types was an enumeration type with a