+2017-01-23 Hristian Kirtchev <kirtchev@adacore.com>
+
+ * exp_ch9.adb (Expand_N_Protected_Type_Declaration): Remove extra
+ spaces from error messages.
+
+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.
+
+2017-01-23 Justin Squirek <squirek@adacore.com>
+
+ * a-wtenau.adb, par-endh.adb, sem_prag.adb,
+ sem_type.adb: Code cleanups.
+
2017-01-23 Bob Duff <duff@adacore.com>
* sem_res.adb (Resolve_Call): In the part of the code where
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2012, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2016, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
exit when
Is_Character (WC)
- and then
- not Is_Letter (To_Character (WC))
and then
not Is_Letter (To_Character (WC))
and then
-- 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.
end if;
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 --
-------------------------------
Build_Master_Entity (Def_Id);
end if;
+ Check_Large_Modular_Array;
+
-- Default initialization required, and no expression present
if No (Expr) then
& "violate restriction "
& "No_Implicit_Heap_Allocations??", Priv, Prot_Typ);
else
-
-- Object will be non-static if discriminants are
Error_Msg_NE
("creation of protected object of type& with "
- & "non-static discriminants will violate"
- & " restriction No_Implicit_Heap_Allocations??",
+ & "non-static discriminants will violate "
+ & "restriction No_Implicit_Heap_Allocations??",
Priv, Prot_Typ);
end if;
Error_Msg_NE
("creation of protected object of type& with "
- & "non-static discriminants will violate "
+ & "non-static discriminants will violate "
& "restriction "
& "No_Implicit_Protected_Object_Allocations??",
Priv, Prot_Typ);
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2014, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2016, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
-- Cases of normal tokens following an END
(Token = Tok_Case or else
- Token = Tok_For or else
Token = Tok_If or else
Token = Tok_Loop or else
Token = Tok_Record or else
-- Attribute 'Result matches attribute 'Result
elsif Is_Attribute_Result (Dep_Item)
- and then Is_Attribute_Result (Dep_Item)
+ and then Is_Attribute_Result (Ref_Item)
then
Matched := True;
loop
if Present (Interfaces (E))
- and then Present (Interfaces (E))
and then not Is_Empty_Elmt_List (Interfaces (E))
then
Elmt := First_Elmt (Interfaces (E));
projects / gcc.git / commitdiff