From d34cd27401917a9b85e7ad5ac2cbca62bbc458cc Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Fri, 5 Aug 2011 16:03:20 +0200 Subject: [PATCH] [multiple changes] 2011-08-05 Ed Schonberg * 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 * 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 --- gcc/ada/ChangeLog | 12 ++++++++++++ gcc/ada/a-fihema.adb | 29 ++++++++++++++++++----------- gcc/ada/a-fihema.ads | 23 +++++++++++++---------- gcc/ada/exp_ch5.adb | 2 +- gcc/ada/exp_ch7.adb | 4 +++- gcc/ada/exp_ch7.ads | 5 +++-- gcc/ada/exp_util.adb | 2 +- gcc/ada/sem_ch12.adb | 21 ++++++++++++++++++++- gcc/ada/sem_ch3.adb | 3 ++- 9 files changed, 73 insertions(+), 28 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 13f0ada39ac..da95e8c5a48 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,15 @@ +2011-08-05 Ed Schonberg + + * 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 + + * 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 * make.adb (Linking_Phase): No longer need to set source search path diff --git a/gcc/ada/a-fihema.adb b/gcc/ada/a-fihema.adb index 0383de0170e..9faa9a1b831 100644 --- a/gcc/ada/a-fihema.adb +++ b/gcc/ada/a-fihema.adb @@ -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)"); diff --git a/gcc/ada/a-fihema.ads b/gcc/ada/a-fihema.ads index df0afa20639..c5273c35b64 100644 --- a/gcc/ada/a-fihema.ads +++ b/gcc/ada/a-fihema.ads @@ -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); diff --git a/gcc/ada/exp_ch5.adb b/gcc/ada/exp_ch5.adb index 6bf52463244..165f9ae8a09 100644 --- a/gcc/ada/exp_ch5.adb +++ b/gcc/ada/exp_ch5.adb @@ -2923,7 +2923,7 @@ package body Exp_Ch5 is -- declare -- Id : Element_Type := Pack.Element (Cursor); -- begin - -- + -- -- end; Stats := New_List ( diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb index 1c84e6b94f7..0d81df24be7 100644 --- a/gcc/ada/exp_ch7.adb +++ b/gcc/ada/exp_ch7.adb @@ -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 => @@ -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 diff --git a/gcc/ada/exp_ch7.ads b/gcc/ada/exp_ch7.ads index 4b937d8a7c6..bcc5526897a 100644 --- a/gcc/ada/exp_ch7.ads +++ b/gcc/ada/exp_ch7.ads @@ -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 -- (FC, -- System.Finalization_Root.Root_Controlled_Ptr (Obj_Ref)); diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb index fbf7fe92038..07cc44c8d48 100644 --- a/gcc/ada/exp_util.adb +++ b/gcc/ada/exp_util.adb @@ -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 diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb index db1f2e707b5..8e45449c81a 100644 --- a/gcc/ada/sem_ch12.adb +++ b/gcc/ada/sem_ch12.adb @@ -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 diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index 653d9dfa328..459cb1b2174 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -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);