+2011-08-05 Ed Schonberg <schonberg@adacore.com>
+
+ * sem_ch12.adb (Analyze_Formal_Package_Declaration): reject a formal
+ package whose name is the same as that of the generic unit, or its
+ ultimate prefix.
+
+2011-08-05 Bob Duff <duff@adacore.com>
+
+ * a-fihema.adb, a-fihema.ads: Minor comment improvements.
+ * sem_ch3.adb, exp_ch5.adb, exp_ch7.adb, exp_ch7.ads, exp_util.adb:
+ Minor comment fixes.
+
2011-08-05 Arnaud Charlet <charlet@adacore.com>
* make.adb (Linking_Phase): No longer need to set source search path
package body Ada.Finalization.Heap_Management is
Header_Size : constant Storage_Count := Node'Size / Storage_Unit;
+ -- Size of the header in bytes. Added to Storage_Size requested by
+ -- Allocate/Deallocate to determine the Storage_Size passed to the
+ -- underlying pool.
+
Header_Offset : constant Storage_Offset := Header_Size;
- -- Comments needed???
+ -- Offset from the header to the actual object. Used to get from the
+ -- address of a header to the address of the actual object, and vice-versa.
function Address_To_Node_Ptr is
new Ada.Unchecked_Conversion (Address, Node_Ptr);
Needs_Header : Boolean := True)
is
begin
- -- Allocation of a controlled object
+ -- Allocation of an object with controlled parts
if Needs_Header then
begin
-- Use the underlying pool to allocate enough space for the object
-- and the list header. The returned address points to the list
- -- header.
+ -- header. If locking is necessary, it will be done by the
+ -- underlying pool.
Allocate
(Collection.Base_Pool.all,
Has_Header : Boolean := True)
is
begin
- -- Deallocation of a controlled object
+ -- Deallocation of an object with controlled parts
if Has_Header then
declare
(Collection : in out Finalization_Collection)
is
function Head (L : Node_Ptr) return Node_Ptr;
- -- Return the node which comes after the dummy head
+ -- Return the node that comes after the dummy head
function Is_Dummy_Head (N : Node_Ptr) return Boolean;
-- Determine whether a node acts as a dummy head. Such nodes do not
-- Start of processing for Finalize
begin
- -- Lock the collection to prevent any allocations while the objects are
- -- being finalized. The collection remains locked because the associated
- -- access type is about to go out of scope.
+ -- Set Finalization_Started to prevent any allocations of objects with
+ -- controlled parts during finalization. The associated access type is
+ -- about to go out of scope; Finalization_Started is never again
+ -- modified.
Collection.Finalization_Started := True;
end if;
end if;
- -- The current element points back to null. This should never happen
- -- since the list is circular.
+ -- The current element is null. This should never happen since the
+ -- list is circular.
if N_Ptr.Prev = null then
Put_Line ("null (ERROR)");
elsif N_Ptr.Prev.Next = N_Ptr then
Put_Line ("^");
- -- The current element points back to an erroneous element
+ -- The current element points to an erroneous element
else
Put_Line ("? (ERROR)");
Needs_Header : Boolean := True);
-- Allocate a chunk of memory described by Storage_Size and Alignment on
-- Collection's underlying storage pool. Return the address of the chunk.
- -- The routine creates a list header which precedes the chunk of memory is
- -- flag Needs_Header is set. If allocated, the header is attached to the
+ -- The routine creates a list header which precedes the chunk of memory if
+ -- Needs_Header is True. If allocated, the header is attached to the
-- Collection's objects. The interface to this routine is provided by
-- Build_Allocate_Deallocate_Proc.
overriding procedure Finalize
(Collection : in out Finalization_Collection);
- -- Traverse the objects of Collection, invoking Finalize_Address on eanch
- -- of them. In the end, the routine destroys its dummy head and tail.
+ -- Traverse the objects of Collection, invoking Finalize_Address on each of
+ -- them. In the end, the routine destroys its dummy head and tail.
overriding procedure Initialize
(Collection : in out Finalization_Collection);
- -- Create a new Collection by allocating a dummy head and tal
+ -- Create a new Collection by allocating a dummy head and tail
procedure Set_Finalize_Address_Ptr
(Collection : in out Finalization_Collection;
new Ada.Finalization.Limited_Controlled with
record
Base_Pool : Any_Storage_Pool_Ptr;
- -- All objects and node headers are allocated on this underlying pool,
+ -- All objects and node headers are allocated on this underlying pool;
-- the collection is simply a wrapper around it.
Objects : Node_Ptr;
-- The head of a doubly linked list
Finalize_Address : Finalize_Address_Ptr;
- -- A reference to a routine which finalizes an object denoted by its
+ -- A reference to a routine that finalizes an object denoted by its
-- address. The collection must be homogeneous since the same routine
-- will be invoked for every allocated object when the pool is
-- finalized.
Finalization_Started : Boolean := False;
- -- When the finalization of a collection takes place, any allocations on
- -- the same collection are prohibited and the action must raise Program_
- -- Error.
+ pragma Atomic (Finalization_Started);
+ -- When the finalization of a collection takes place, any allocations of
+ -- objects with controlled or protected parts on the same collection are
+ -- prohibited and the action must raise Program_Error. This needs to be
+ -- atomic, because it is accessed without Lock_Task/Unlock_Task. See
+ -- RM-4.8(10.2/2).
end record;
procedure pcol (Collection : Finalization_Collection);
-- declare
-- Id : Element_Type := Pack.Element (Cursor);
-- begin
- -- <original loop statments>
+ -- <original loop statements>
-- end;
Stats := New_List (
Jump_Alts : List_Id := No_List;
-- Jump block alternatives. Depending on the value of the state counter,
- -- the control flow jumps to a sequence of finalization statments. This
+ -- the control flow jumps to a sequence of finalization statements. This
-- list contains the following:
--
-- when <counter value> =>
(Obj_Ref : Node_Id;
Ptr_Typ : Entity_Id) return Node_Id
is
+ pragma Assert (VM_Target /= No_VM);
+
Loc : constant Source_Ptr := Sloc (Obj_Ref);
begin
return
(Obj_Ref : Node_Id;
Ptr_Typ : Entity_Id) return Node_Id;
-- Create a call to prepend an object to a finalization collection. Obj_Ref
- -- is the object, Ptr_Typ is the access type that owns the collection.
+ -- is the object, Ptr_Typ is the access type that owns the collection. This
+ -- is used only for .NET/JVM, that is, when VM_Target /= No_VM.
-- Generate the following:
--
- -- Ada.Finalization.Heap_Managment.Attach
+ -- Ada.Finalization.Heap_Management.Attach
-- (<Ptr_Typ>FC,
-- System.Finalization_Root.Root_Controlled_Ptr (Obj_Ref));
if not Needs_Finalization (Desig_Typ) then
return;
- -- The allocator or free statmenet has already been expanded and already
+ -- The allocator or free statement has already been expanded and already
-- has a custom Allocate / Deallocate routine.
elsif Nkind (Expr) = N_Allocator
return Pack_Decl;
end Build_Local_Package;
- -- Start of processing for Analyze_Formal_Package
+ -- Start of processing for Analyze_Formal_Package_Declaration
begin
Text_IO_Kludge (Gen_Id);
end if;
end if;
+ -- Check that name of formal package does not hide name of generic,
+ -- or its leading prefix. This check must be done separately because
+ -- the name of the generic has already been analyzed.
+
+ declare
+ Gen_Name : Entity_Id;
+
+ begin
+ Gen_Name := Gen_Id;
+ while Nkind (Gen_Name) = N_Expanded_Name loop
+ Gen_Name := Prefix (Gen_Name);
+ end loop;
+ if Chars (Gen_Name) = Chars (Pack_Id) then
+ Error_Msg_NE
+ ("& is hidden within declaration of formal package",
+ Gen_Id, Gen_Name);
+ end if;
+ end;
+
if Box_Present (N)
or else No (Generic_Associations (N))
or else Nkind (First (Generic_Associations (N))) = N_Others_Choice
-- GNAT allow its own definition of Limited_Controlled to disobey
-- this rule in order in ease the implementation. This test is safe
- -- because Root_Controlled is defined in a private system child.
+ -- because Root_Controlled is defined in a child of System that
+ -- normal programs are not supposed to use.
elsif Is_RTE (Etype (Full_T), RE_Root_Controlled) then
Set_Is_Limited_Composite (Full_T);
projects / platform / upstream / gcc.git / commitdiff