OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

[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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
gcc/ada/ChangeLog
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>
* make.adb (Linking_Phase): No longer need to set source search path

29
gcc/ada/a-fihema.adb
View File

@ -43,8 +43,13 @@ with System.Storage_Pools; use System.Storage_Pools;
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);
@ -81,7 +86,7 @@ package body Ada.Finalization.Heap_Management is
Needs_Header : Boolean := True)
is
begin
-- Allocation of a controlled object
-- Allocation of an object with controlled parts
if Needs_Header then
@ -99,7 +104,8 @@ package body Ada.Finalization.Heap_Management is
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,
@ -174,7 +180,7 @@ package body Ada.Finalization.Heap_Management is
Has_Header : Boolean := True)
is
begin
-- Deallocation of a controlled object
-- Deallocation of an object with controlled parts
if Has_Header then
declare
@ -246,7 +252,7 @@ package body Ada.Finalization.Heap_Management is
(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
@ -310,9 +316,10 @@ package body Ada.Finalization.Heap_Management is
-- 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;
@ -457,8 +464,8 @@ package body Ada.Finalization.Heap_Management is
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)");
@ -468,7 +475,7 @@ package body Ada.Finalization.Heap_Management is
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)");

23
gcc/ada/a-fihema.ads
View File

@ -69,8 +69,8 @@ package Ada.Finalization.Heap_Management is
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.
@ -92,12 +92,12 @@ package Ada.Finalization.Heap_Management is
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;
@ -125,22 +125,25 @@ private
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);

2
gcc/ada/exp_ch5.adb
View File

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

4
gcc/ada/exp_ch7.adb
View File

@ -1138,7 +1138,7 @@ package body Exp_Ch7 is
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> =>
@ -4623,6 +4623,8 @@ package body Exp_Ch7 is
(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

5
gcc/ada/exp_ch7.ads
View File

@ -122,10 +122,11 @@ package Exp_Ch7 is
(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));

2
gcc/ada/exp_util.adb
View File

@ -418,7 +418,7 @@ package body Exp_Util is
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

21
gcc/ada/sem_ch12.adb
View File

@ -2124,7 +2124,7 @@ package body Sem_Ch12 is
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);
@ -2182,6 +2182,25 @@ package body Sem_Ch12 is
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

3
gcc/ada/sem_ch3.adb
View File

@ -17382,7 +17382,8 @@ package body Sem_Ch3 is
-- 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);