[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:
parent
00332244ee
commit
d34cd27401
|
@ -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
|
||||||
|
|
|
@ -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)");
|
||||||
|
|
|
@ -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);
|
||||||
|
|
|
@ -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 (
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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));
|
||||||
|
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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);
|
||||||
|
|
Loading…
Reference in New Issue