.. index:: Finalization_Size
The prefix of attribute ``Finalization_Size`` must be an object or
-a non-class-wide type. This attribute returns the size of any hidden data
+a type. This attribute returns the size of any hidden data
reserved by the compiler to handle finalization-related actions. The type of
the attribute is *universal_integer*.
``Finalization_Size`` yields a value of zero for a type with no controlled
parts, an object whose type has no controlled parts, or an object of a
class-wide type whose tag denotes a type with no controlled parts.
+For a class-wide type, ``Finalization_Size`` yields a non-zero value except
+if a No_Finalization restriction is in effect, in which case it yields zero.
Note that only heap-allocated objects contain finalization data.
with Einfo.Entities; use Einfo.Entities;
with Einfo.Utils; use Einfo.Utils;
with Elists; use Elists;
+with Errout; use Errout;
with Exp_Atag; use Exp_Atag;
with Exp_Ch3; use Exp_Ch3;
with Exp_Ch6; use Exp_Ch6;
--
-- and the attribute reference is replaced with a reference to Size.
- elsif Is_Class_Wide_Type (Ptyp) then
+ elsif Is_Class_Wide_Type (Ptyp) and then Is_Object_Prefix (Pref) then
Size := Make_Temporary (Loc, 'S');
Insert_Actions (N, New_List (
end if;
end if;
- -- If the prefix is X'Class, transform it into a direct reference
- -- to the class-wide type, because the back end must not see a
- -- 'Class reference.
+ -- If the prefix is X'Class, transform it into a
+ -- raise of Constraint_Error.
if Is_Entity_Name (Pref)
and then Is_Class_Wide_Type (Entity (Pref))
then
- Rewrite (Prefix (N), New_Occurrence_Of (Entity (Pref), Loc));
+ pragma Assert (not Is_Mutably_Tagged_Type (Entity (Pref)));
+ -- In the Mutably_Tagged_Case, this attribute reference
+ -- should have been transformed into an integer literal
+ -- (in Eval_Attribute) before we get here.
+ -- If this assertion ever fails, the thing to do here
+ -- is generate a literal equal to the specified
+ -- T'Size'Class [sic] aspect value.
+
+ Error_Msg_N
+ ("Constraint_Error will be raised at run time??", N);
+ Rewrite (N, Make_Raise_Constraint_Error
+ (Loc, Reason => CE_Range_Check_Failed));
+ Set_Etype (N, Etype (Original_Node (N)));
return;
-- For X'Size applied to an object of a class-wide type, transform
-- Start of processing for Expand_Image_Attribute
begin
- if Is_Object_Image (Pref) then
+ if Is_Object_Prefix (Pref) then
Rewrite_Object_Image (N, Pref, Name_Image, Standard_String);
return;
end if;
Rtyp : Entity_Id;
begin
- if Is_Object_Image (Pref) then
+ if Is_Object_Prefix (Pref) then
Rewrite_Object_Image (N, Pref, Name_Wide_Image, Standard_Wide_String);
return;
end if;
Rtyp : Entity_Id;
begin
- if Is_Object_Image (Pref) then
+ if Is_Object_Prefix (Pref) then
Rewrite_Object_Image
(N, Pref, Name_Wide_Wide_Image, Standard_Wide_Wide_String);
return;
Storage_Count'Max (System.Address'Alignment,
Element_Type'Alignment));
- -- Convert Element_Type'Size from bits to bytes, rounding up
- Element_Size_In_Storage_Elements : constant Long_Integer :=
- Long_Integer ((Element_Type'Size / System.Storage_Unit) +
- Boolean'Pos (Element_Type'Size mod System.Storage_Unit /= 0));
-
-- An upper bound on additional storage required for an allocator for data
-- other than the allocated object itself. This includes things like
-- array bounds (if Element_Type is an unconstrained array subtype),
-- overhead except for aforementioned possibility of an alignment-related
-- gap between some prefix data and the object itself.
- pragma Warnings (Off); -- avoid warnings for exceptions raised in dead code
-
- function Max_Allocation_Overhead_In_Storage_Elements return Storage_Count is
- (if Element_Size_In_Storage_Elements >= Long_Integer (Integer'Last) then
- -- If the more precise computation in the else-arm (below) could
- -- overflow or return the wrong answer then return a guess.
- -- We get a multiplier of 6 by adding 2 for finalization-linkage
- -- and 4 for array bounds. If we have an unconstrained array subtype
- -- with a controlled element type and with multiple dimensions each
- -- indexed by Long_Long_Integer, then this guess could be too small.
- System.Address'Max_Size_In_Storage_Elements * 6
- else
- Storage_Count (Element_Type'Max_Size_In_Storage_Elements -
- Element_Size_In_Storage_Elements));
- --
- -- ??? It would be helpful if GNAT provided this value as an attribute so
- -- that we would not have to deal with the "huge" case here. Instead, we
- -- use a very imprecise "hugeness" test; in the "huge" case, we return an
- -- estimate. If the estimate turns out to be too small, then it is
- -- possible for the size check in Allocate_From_Subpool to fail even
- -- though the earlier (earlier at run-time) size check in Replace_Element
- -- passed. A GNAT-defined attribute could eliminate this issue.
-
- pragma Warnings (On);
-
-- Compute extra amount needed for space requested for an allocator
-- (specifically, in a call to Allocate_From_Subpool) in addition to
-- the space required for the allocated object itself.
Extra_Storage : constant Storage_Count :=
Holder_Subpool'Max_Size_In_Storage_Elements +
Worst_Case_Alignment * 2 +
- Max_Allocation_Overhead_In_Storage_Elements;
+ (Element_Type'Descriptor_Size / System.Storage_Unit) +
+ (Element_Type'Finalization_Size / System.Storage_Unit);
subtype Bound_Range is Storage_Count range
0 .. Max_Element_Size_In_Storage_Elements + Extra_Storage;
-- scalar types, so that the prefix can be an object, a named value,
-- or a type. If the prefix is an object, there is no argument.
- if Is_Object_Image (P) then
+ if Is_Object_Prefix (P) then
Check_E0;
Set_Etype (N, Str_Typ);
Check_Image_Type (Etype (P));
Check_Type;
Check_Not_Incomplete_Type;
- -- Attribute 'Finalization_Size is not defined for class-wide
- -- types because it is not possible to know statically whether
- -- a definite type will have controlled components or not.
-
- if Is_Class_Wide_Type (Etype (P)) then
- Error_Attr_P
- ("prefix of % attribute cannot denote a class-wide type");
- end if;
-
-- The prefix denotes an illegal construct
else
-----------------------
Attribute_Finalization_Size => True,
- -- For every object or non-class-wide-type, Finalization_Size returns
- -- the size of the hidden header used for finalization purposes as if
+ -- For every object or type, Finalization_Size returns the (possibly
+ -- zero) size of the hidden header used for finalization purposes as if
-- the object or type was allocated on the heap. The size of the header
-- does take into account any extra padding due to alignment issues.
+ -- See Sem_Util.Needs_Finalization for treatment of class-wide types.
-----------------
-- Fixed_Value --
end case;
end Is_Null_Record_Type;
- ---------------------
- -- Is_Object_Image --
- ---------------------
+ ----------------------
+ -- Is_Object_Prefix --
+ ----------------------
- function Is_Object_Image (Prefix : Node_Id) return Boolean is
+ function Is_Object_Prefix (Prefix : Node_Id) return Boolean is
begin
-- Here we test for the case that the prefix is not a type and assume
-- if it is not then it must be a named value or an object reference.
return not (Is_Entity_Name (Prefix)
and then Is_Type (Entity (Prefix))
and then not Is_Current_Instance (Prefix));
- end Is_Object_Image;
+ end Is_Object_Prefix;
-------------------------
-- Is_Object_Reference --
-- (with a null extension if tagged). Returns True for interface types,
-- False for discriminated types.
- function Is_Object_Image (Prefix : Node_Id) return Boolean;
- -- Returns True if an 'Img, 'Image, 'Wide_Image, or 'Wide_Wide_Image
- -- attribute is applied to an object.
+ function Is_Object_Prefix (Prefix : Node_Id) return Boolean;
+ -- Returns True if the given prefix of an attribute reference denotes
+ -- an object. Useful for attributes such as 'Img, 'Image, 'Wide_Image,
+ -- or 'Wide_Wide_Image, where the prefix may denote either an object or
+ -- a type/subtype.
function Is_Object_Reference (N : Node_Id) return Boolean;
-- Determines if the tree referenced by N represents an object. Both
projects / thirdparty / gcc.git / commitdiff
