[multiple changes]

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.

From-SVN: r177438
This commit is contained in:
Arnaud Charlet 2011-08-05 16:03:20 +02:00
parent 00332244ee
commit d34cd27401
9 changed files with 73 additions and 28 deletions

View File

@ -1,3 +1,15 @@
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> 2011-08-05 Arnaud Charlet <charlet@adacore.com>
* make.adb (Linking_Phase): No longer need to set source search path * make.adb (Linking_Phase): No longer need to set source search path

View File

@ -43,8 +43,13 @@ with System.Storage_Pools; use System.Storage_Pools;
package body Ada.Finalization.Heap_Management is package body Ada.Finalization.Heap_Management is
Header_Size : constant Storage_Count := Node'Size / Storage_Unit; 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; 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 function Address_To_Node_Ptr is
new Ada.Unchecked_Conversion (Address, Node_Ptr); new Ada.Unchecked_Conversion (Address, Node_Ptr);
@ -81,7 +86,7 @@ package body Ada.Finalization.Heap_Management is
Needs_Header : Boolean := True) Needs_Header : Boolean := True)
is is
begin begin
-- Allocation of a controlled object -- Allocation of an object with controlled parts
if Needs_Header then if Needs_Header then
@ -99,7 +104,8 @@ package body Ada.Finalization.Heap_Management is
begin begin
-- Use the underlying pool to allocate enough space for the object -- Use the underlying pool to allocate enough space for the object
-- and the list header. The returned address points to the list -- 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 Allocate
(Collection.Base_Pool.all, (Collection.Base_Pool.all,
@ -174,7 +180,7 @@ package body Ada.Finalization.Heap_Management is
Has_Header : Boolean := True) Has_Header : Boolean := True)
is is
begin begin
-- Deallocation of a controlled object -- Deallocation of an object with controlled parts
if Has_Header then if Has_Header then
declare declare
@ -246,7 +252,7 @@ package body Ada.Finalization.Heap_Management is
(Collection : in out Finalization_Collection) (Collection : in out Finalization_Collection)
is is
function Head (L : Node_Ptr) return Node_Ptr; 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; function Is_Dummy_Head (N : Node_Ptr) return Boolean;
-- Determine whether a node acts as a dummy head. Such nodes do not -- Determine whether a node acts as a dummy head. Such nodes do not
@ -310,9 +316,10 @@ package body Ada.Finalization.Heap_Management is
-- Start of processing for Finalize -- Start of processing for Finalize
begin begin
-- Lock the collection to prevent any allocations while the objects are -- Set Finalization_Started to prevent any allocations of objects with
-- being finalized. The collection remains locked because the associated -- controlled parts during finalization. The associated access type is
-- access type is about to go out of scope. -- about to go out of scope; Finalization_Started is never again
-- modified.
Collection.Finalization_Started := True; Collection.Finalization_Started := True;
@ -457,8 +464,8 @@ package body Ada.Finalization.Heap_Management is
end if; end if;
end if; end if;
-- The current element points back to null. This should never happen -- The current element is null. This should never happen since the
-- since the list is circular. -- list is circular.
if N_Ptr.Prev = null then if N_Ptr.Prev = null then
Put_Line ("null (ERROR)"); Put_Line ("null (ERROR)");
@ -468,7 +475,7 @@ package body Ada.Finalization.Heap_Management is
elsif N_Ptr.Prev.Next = N_Ptr then elsif N_Ptr.Prev.Next = N_Ptr then
Put_Line ("^"); Put_Line ("^");
-- The current element points back to an erroneous element -- The current element points to an erroneous element
else else
Put_Line ("? (ERROR)"); Put_Line ("? (ERROR)");

View File

@ -69,8 +69,8 @@ package Ada.Finalization.Heap_Management is
Needs_Header : Boolean := True); Needs_Header : Boolean := True);
-- Allocate a chunk of memory described by Storage_Size and Alignment on -- Allocate a chunk of memory described by Storage_Size and Alignment on
-- Collection's underlying storage pool. Return the address of the chunk. -- Collection's underlying storage pool. Return the address of the chunk.
-- The routine creates a list header which precedes the chunk of memory is -- The routine creates a list header which precedes the chunk of memory if
-- flag Needs_Header is set. If allocated, the header is attached to the -- Needs_Header is True. If allocated, the header is attached to the
-- Collection's objects. The interface to this routine is provided by -- Collection's objects. The interface to this routine is provided by
-- Build_Allocate_Deallocate_Proc. -- Build_Allocate_Deallocate_Proc.
@ -92,12 +92,12 @@ package Ada.Finalization.Heap_Management is
overriding procedure Finalize overriding procedure Finalize
(Collection : in out Finalization_Collection); (Collection : in out Finalization_Collection);
-- Traverse the objects of Collection, invoking Finalize_Address on eanch -- Traverse the objects of Collection, invoking Finalize_Address on each of
-- of them. In the end, the routine destroys its dummy head and tail. -- them. In the end, the routine destroys its dummy head and tail.
overriding procedure Initialize overriding procedure Initialize
(Collection : in out Finalization_Collection); (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 procedure Set_Finalize_Address_Ptr
(Collection : in out Finalization_Collection; (Collection : in out Finalization_Collection;
@ -125,22 +125,25 @@ private
new Ada.Finalization.Limited_Controlled with new Ada.Finalization.Limited_Controlled with
record record
Base_Pool : Any_Storage_Pool_Ptr; 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. -- the collection is simply a wrapper around it.
Objects : Node_Ptr; Objects : Node_Ptr;
-- The head of a doubly linked list -- The head of a doubly linked list
Finalize_Address : Finalize_Address_Ptr; 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 -- address. The collection must be homogeneous since the same routine
-- will be invoked for every allocated object when the pool is -- will be invoked for every allocated object when the pool is
-- finalized. -- finalized.
Finalization_Started : Boolean := False; Finalization_Started : Boolean := False;
-- When the finalization of a collection takes place, any allocations on pragma Atomic (Finalization_Started);
-- the same collection are prohibited and the action must raise Program_ -- When the finalization of a collection takes place, any allocations of
-- Error. -- 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; end record;
procedure pcol (Collection : Finalization_Collection); procedure pcol (Collection : Finalization_Collection);

View File

@ -2923,7 +2923,7 @@ package body Exp_Ch5 is
-- declare -- declare
-- Id : Element_Type := Pack.Element (Cursor); -- Id : Element_Type := Pack.Element (Cursor);
-- begin -- begin
-- <original loop statments> -- <original loop statements>
-- end; -- end;
Stats := New_List ( Stats := New_List (

View File

@ -1138,7 +1138,7 @@ package body Exp_Ch7 is
Jump_Alts : List_Id := No_List; Jump_Alts : List_Id := No_List;
-- Jump block alternatives. Depending on the value of the state counter, -- 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: -- list contains the following:
-- --
-- when <counter value> => -- when <counter value> =>
@ -4623,6 +4623,8 @@ package body Exp_Ch7 is
(Obj_Ref : Node_Id; (Obj_Ref : Node_Id;
Ptr_Typ : Entity_Id) return Node_Id Ptr_Typ : Entity_Id) return Node_Id
is is
pragma Assert (VM_Target /= No_VM);
Loc : constant Source_Ptr := Sloc (Obj_Ref); Loc : constant Source_Ptr := Sloc (Obj_Ref);
begin begin
return return

View File

@ -122,10 +122,11 @@ package Exp_Ch7 is
(Obj_Ref : Node_Id; (Obj_Ref : Node_Id;
Ptr_Typ : Entity_Id) return Node_Id; Ptr_Typ : Entity_Id) return Node_Id;
-- Create a call to prepend an object to a finalization collection. Obj_Ref -- 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: -- Generate the following:
-- --
-- Ada.Finalization.Heap_Managment.Attach -- Ada.Finalization.Heap_Management.Attach
-- (<Ptr_Typ>FC, -- (<Ptr_Typ>FC,
-- System.Finalization_Root.Root_Controlled_Ptr (Obj_Ref)); -- System.Finalization_Root.Root_Controlled_Ptr (Obj_Ref));

View File

@ -418,7 +418,7 @@ package body Exp_Util is
if not Needs_Finalization (Desig_Typ) then if not Needs_Finalization (Desig_Typ) then
return; 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. -- has a custom Allocate / Deallocate routine.
elsif Nkind (Expr) = N_Allocator elsif Nkind (Expr) = N_Allocator

View File

@ -2124,7 +2124,7 @@ package body Sem_Ch12 is
return Pack_Decl; return Pack_Decl;
end Build_Local_Package; end Build_Local_Package;
-- Start of processing for Analyze_Formal_Package -- Start of processing for Analyze_Formal_Package_Declaration
begin begin
Text_IO_Kludge (Gen_Id); Text_IO_Kludge (Gen_Id);
@ -2182,6 +2182,25 @@ package body Sem_Ch12 is
end if; end if;
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) if Box_Present (N)
or else No (Generic_Associations (N)) or else No (Generic_Associations (N))
or else Nkind (First (Generic_Associations (N))) = N_Others_Choice or else Nkind (First (Generic_Associations (N))) = N_Others_Choice

View File

@ -17382,7 +17382,8 @@ package body Sem_Ch3 is
-- GNAT allow its own definition of Limited_Controlled to disobey -- GNAT allow its own definition of Limited_Controlled to disobey
-- this rule in order in ease the implementation. This test is safe -- 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 elsif Is_RTE (Etype (Full_T), RE_Root_Controlled) then
Set_Is_Limited_Composite (Full_T); Set_Is_Limited_Composite (Full_T);