===================================================================
@@ -5465,6 +5465,13 @@
-- value, it may be possible to build an equivalent aggregate instead,
-- and prevent an actual call to the initialization procedure.
+ procedure Check_Large_Modular_Array;
+ -- Check that the size of the array can be computed without overflow,
+ -- and generate a Storage_Error otherwise. This is only relevant for
+ -- array types whose index in a (mod 2**64) type, where wrap-around
+ -- arithmetic might yield a meaningless value for the length of the
+ -- array, or its corresponding attribute.
+
procedure Default_Initialize_Object (After : Node_Id);
-- Generate all default initialization actions for object Def_Id. Any
-- new code is inserted after node After.
@@ -5603,6 +5610,58 @@
end Build_Equivalent_Aggregate;
-------------------------------
+ -- Check_Large_Modular_Array --
+ -------------------------------
+
+ procedure Check_Large_Modular_Array is
+ Index_Typ : Entity_Id;
+
+ begin
+ if Is_Array_Type (Typ)
+ and then Is_Modular_Integer_Type (Etype (First_Index (Typ)))
+ then
+ -- To prevent arithmetic overflow with large values, we
+ -- raise Storage_Error under the following guard:
+ --
+ -- (Arr'Last / 2 - Arr'First / 2) > (Typ'Last - 1) / 2
+
+ -- This takes care of the boundary case, but it is preferable
+ -- to use a smaller limit, because even on 64-bit architectures
+ -- an array of more than 2 ** 30 bytes is likely to raise
+ -- Storage_Error.
+
+ Index_Typ := Etype (First_Index (Typ));
+ if RM_Size (Index_Typ) = RM_Size (Standard_Long_Long_Integer) then
+ Insert_Action (N,
+ Make_Raise_Storage_Error (Loc,
+ Condition =>
+ Make_Op_Ge (Loc,
+ Left_Opnd =>
+ Make_Op_Subtract (Loc,
+ Left_Opnd =>
+ Make_Op_Divide (Loc,
+ Left_Opnd =>
+ Make_Attribute_Reference (Loc,
+ Prefix => New_Occurrence_Of (Typ, Loc),
+ Attribute_Name => Name_Last),
+ Right_Opnd =>
+ Make_Integer_Literal (Loc, Uint_2)),
+ Right_Opnd =>
+ Make_Op_Divide (Loc,
+ Left_Opnd =>
+ Make_Attribute_Reference (Loc,
+ Prefix => New_Occurrence_Of (Typ, Loc),
+ Attribute_Name => Name_First),
+ Right_Opnd =>
+ Make_Integer_Literal (Loc, Uint_2))),
+ Right_Opnd =>
+ Make_Integer_Literal (Loc, (Uint_2 ** 30))),
+ Reason => SE_Object_Too_Large));
+ end if;
+ end if;
+ end Check_Large_Modular_Array;
+
+ -------------------------------
-- Default_Initialize_Object --
-------------------------------
@@ -6012,6 +6071,8 @@
Build_Master_Entity (Def_Id);
end if;
+ Check_Large_Modular_Array;
+
-- Default initialization required, and no expression present
if No (Expr) then
This patch computes a guard for a storage error on an object declaration for an array type with a modular index type with the size of Long_Long_Integer. Special processing is needed in this case to compute reliably the size of the object, and eventually to raise Storage_Error, when wrap-around arithmetic might compute a meangingless size for the object. Executing: gnatmake -q -gnatws -fstack-check fail fail must yield: raised STORAGE_ERROR : fail.adb:6 object too large --- with Mod_Array; use Mod_Array; procedure Fail is Str : String (1 .. 2014); function Create (Last : My_Index) return A is R : A (0 .. Last); for R'Address use Str'Address; pragma Import (Ada, R); begin return R; end Create; function Create2 (Last : My_Index) return A is R : A (0 .. Last); begin return R; end Create2; C : constant A := Create (My_Index'Last); begin if C'Length = 0 then raise Program_Error; end if; if Create2 (My_Index'Last)'Length = 0 then raise Program_Error; end if; end Fail; --- package Mod_Array with SPARK_mode is type My_Index is mod 2 ** 64; type redundant is new Long_Long_Integer; type A is array (My_Index range <>) of Boolean with Pack; function My_Length (X : A) return My_Index is (X'Length); end Mod_Array; Tested on x86_64-pc-linux-gnu, committed on trunk 2017-01-23 Ed Schonberg <schonberg@adacore.com> * exp_ch3.adb (Check_Large_Modular_Array): New procedure, subsidiary to Expand_N_Object_ Declaration, to compute a guard on an object declaration for an array type with a modular index type with the size of Long_Long_Integer. Special processing is needed in this case to compute reliably the size of the object, and eventually to raise Storage_Error, when wrap-around arithmetic might compute a meangingless size for the object.