-- initialized. Typ is the expected type of Ref, which is a controlled
-- type (Is_Controlled) or a type with controlled components
-- (Has_Controlled). With_Attach is an integer expression representing
- -- the level of attachment, see Attach_To_Final_Lists' NB_Link param
+ -- the level of attachment, see Attach_To_Final_List's Nb_Link param
-- documentation in s-finimp.ads.
--
-- This function will generate the appropriate calls to make
-- adjusted. Typ is the expected type of Ref, which is a controlled
-- type (Is_Controlled) or a type with controlled components
-- (Has_Controlled). With_Attach is an integer expression representing
- -- the level of attachment, see Attach_To_Final_Lists' NB_Link param
+ -- the level of attachment, see Attach_To_Final_List's Nb_Link param
-- documentation in s-finimp.ads.
--
-- This function will generate the appropriate calls to make
-- to have been previously analyzed) that references the object to
-- be Finalized. Typ is the expected type of Ref, which is a
-- controlled type (Is_Controlled) or a type with controlled
- -- components (Has_Controlled). With_Attach is an integer
- -- expression representing the level of attachment, see
- -- Attach_To_Final_Lists' NB_Link param documentation in
- -- s-finimp.ads.
+ -- components (Has_Controlled). With_Detach is a boolean expression
+ -- indicating whether to detach the controlled object from whatever
+ -- finalization list it is currently attached to.
--
-- This function will generate the appropriate calls to make
-- sure that the objects referenced by Ref are finalized. The generated
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2003, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2004, 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- --
-- be outside the range of a 32-bit signed integer, so this must be
-- treated as 32-bit unsigned.
- -- Similarly, if we have
+ -- Similarly, the representation is also unsigned if we have:
-- type W is range -1 .. +254;
-- for W'Size use 8;
- -- then the representation is also unsigned.
-
elsif not Is_Unsigned_Type (FST)
and then
(Is_Fixed_Point_Type (U_Type)
Decl : out Node_Id;
Pnam : out Entity_Id)
is
- Stms : List_Id;
- Disc : Entity_Id;
- Comp : Node_Id;
+ Stms : List_Id;
+ -- Statements for the 'Read body
+
+ Tmp : constant Entity_Id := Make_Defining_Identifier (Loc, Name_V);
+ -- Temporary, must hide formal (assignments to components of the
+ -- record are always generated with V as the identifier for the record).
+
+ Cstr : List_Id;
+ -- List of constraints to be applied on temporary
+
+ Disc : Entity_Id;
+ Disc_Ref : Node_Id;
+ Block : Node_Id;
begin
Stms := New_List;
+ Cstr := New_List;
Disc := First_Discriminant (Typ);
- -- Generate Reads for the discriminants of the type.
+ -- A mutable type cannot be a tagged type, so we generate a new name
+ -- for the stream procedure.
+
+ Pnam :=
+ Make_Defining_Identifier (Loc,
+ Chars => Make_TSS_Name_Local (Typ, TSS_Stream_Read));
+
+ -- Generate Reads for the discriminants of the type. The discriminants
+ -- need to be read before the rest of the components, so that
+ -- variants are initialized correctly.
while Present (Disc) loop
- Comp :=
+ Disc_Ref :=
Make_Selected_Component (Loc,
- Prefix => Make_Identifier (Loc, Name_V),
+ Prefix => Make_Selected_Component (Loc,
+ Prefix => New_Occurrence_Of (Pnam, Loc),
+ Selector_Name =>
+ Make_Identifier (Loc, Name_V)),
Selector_Name => New_Occurrence_Of (Disc, Loc));
- Set_Assignment_OK (Comp);
+ Set_Assignment_OK (Disc_Ref);
Append_To (Stms,
Make_Attribute_Reference (Loc,
Attribute_Name => Name_Read,
Expressions => New_List (
Make_Identifier (Loc, Name_S),
- Comp)));
+ Disc_Ref)));
+ Append_To (Cstr,
+ Make_Discriminant_Association (Loc,
+ Selector_Names => New_List (New_Occurrence_Of (Disc, Loc)),
+ Expression => New_Copy_Tree (Disc_Ref)));
Next_Discriminant (Disc);
end loop;
- -- A mutable type cannot be a tagged type, so we generate a new name
- -- for the stream procedure.
+ -- Generate reads for the components of the record (including
+ -- those that depend on discriminants).
- Pnam :=
- Make_Defining_Identifier (Loc,
- Chars => Make_TSS_Name_Local (Typ, TSS_Stream_Read));
Build_Record_Read_Write_Procedure (Loc, Typ, Decl, Pnam, Name_Read);
- -- Read the discriminants before the rest of the components, so
- -- that discriminant values are properly set of variants, etc.
- -- If this is an empty record with discriminants, there are no
- -- previous statements. If this is an unchecked union, the stream
- -- procedure is erroneous, because there are no discriminants to read.
+ -- If Typ has controlled components (i.e. if it is classwide
+ -- or Has_Controlled), or components constrained using the discriminants
+ -- of Typ, then we need to ensure that all component assignments
+ -- are performed on an object that has been appropriately constrained
+ -- prior to being initialized. To this effect, we wrap the component
+ -- assignments in a block where V is a constrained temporary.
+
+ Block :=
+ Make_Block_Statement (Loc,
+ Declarations => New_List (
+ Make_Object_Declaration (Loc,
+ Defining_Identifier => Tmp,
+ Object_Definition =>
+ Make_Subtype_Indication (Loc,
+ Subtype_Mark => New_Occurrence_Of (Typ, Loc),
+ Constraint =>
+ Make_Index_Or_Discriminant_Constraint (Loc,
+ Constraints => Cstr)))),
+ Handled_Statement_Sequence =>
+ Handled_Statement_Sequence (Decl));
+
+ Append_To (Stms, Block);
+
+ Append_To (Statements (Handled_Statement_Sequence (Block)),
+ Make_Assignment_Statement (Loc,
+ Name => Make_Selected_Component (Loc,
+ Prefix => New_Occurrence_Of (Pnam, Loc),
+ Selector_Name => Make_Identifier (Loc, Name_V)),
+ Expression => Make_Identifier (Loc, Name_V)));
if Is_Unchecked_Union (Typ) then
+
+ -- If this is an unchecked union, the stream procedure is erroneous,
+ -- because there are no discriminants to read.
+
+ -- This should generate a warning ???
+
Stms :=
New_List (
Make_Raise_Program_Error (Loc,
Reason => PE_Unchecked_Union_Restriction));
end if;
- if Is_Non_Empty_List (
- Statements (Handled_Statement_Sequence (Decl)))
- then
- Insert_List_Before
- (First (Statements (Handled_Statement_Sequence (Decl))), Stms);
- else
- Set_Statements (Handled_Statement_Sequence (Decl), Stms);
- end if;
+ Set_Handled_Statement_Sequence (Decl,
+ Make_Handled_Sequence_Of_Statements (Loc,
+ Statements => Stms));
end Build_Mutable_Record_Read_Procedure;
------------------------------------------
Stms := New_List;
Disc := First_Discriminant (Typ);
- -- Generate Writes for the discriminants of the type.
+ -- Generate Writes for the discriminants of the type
while Present (Disc) loop
projects / thirdparty / gcc.git / commitdiff
