Index: a-filico.adb =================================================================== --- a-filico.adb (revision 118179) +++ a-filico.adb (working copy) @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2004 Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2006, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -46,6 +46,17 @@ package body Ada.Finalization.List_Contr Last_Ptr : constant SFR.Finalizable_Ptr := Object.Last'Unchecked_Access; begin + -- First take note of the fact that finalization of this collection has + -- started. + + Object.F := SFI.Collection_Finalization_Started; + + -- Then finalize all the objects. Note that finalization can call + -- Unchecked_Deallocation on other objects in the same collection, + -- which will cause them to be removed from the list if we have not + -- gotten to them yet. However, allocation in the collection will raise + -- Program_Error, due to the above Collection_Finalization_Started. + while Object.First.Next /= Last_Ptr loop SFI.Finalize_One (Object.First.Next.all); end loop; Index: s-finimp.adb =================================================================== --- s-finimp.adb (revision 118179) +++ s-finimp.adb (working copy) @@ -34,7 +34,6 @@ with Ada.Exceptions; with Ada.Tags; -with System.Storage_Elements; with System.Soft_Links; with Unchecked_Conversion; @@ -47,7 +46,6 @@ package body System.Finalization_Impleme package SSL renames System.Soft_Links; - package SSE renames System.Storage_Elements; use type SSE.Storage_Offset; ----------------------- @@ -183,6 +181,14 @@ package body System.Finalization_Impleme elsif Nb_Link = 2 then + -- Raise Program_Error if we're trying to allocate an object in a + -- collection whose finalization has already started. + + if L = Collection_Finalization_Started then + raise Program_Error with + "allocation after collection finalization started"; + end if; + Locked_Processing : begin SSL.Lock_Task.all; Obj.Next := L.Next; Index: s-finimp.ads =================================================================== --- s-finimp.ads (revision 118179) +++ s-finimp.ads (working copy) @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2005 Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2006 Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -31,17 +31,36 @@ -- -- ------------------------------------------------------------------------------ +with Ada.Unchecked_Conversion; + +with System.Storage_Elements; with System.Finalization_Root; package System.Finalization_Implementation is pragma Elaborate_Body; + package SSE renames System.Storage_Elements; package SFR renames System.Finalization_Root; ------------------------------------------------ -- Finalization Management Abstract Interface -- ------------------------------------------------ + function To_Finalizable_Ptr is new Ada.Unchecked_Conversion + (Source => System.Address, Target => SFR.Finalizable_Ptr); + + Collection_Finalization_Started : constant SFR.Finalizable_Ptr := + To_Finalizable_Ptr (SSE.To_Address (1)); + -- This is used to implement the rule in RM-4.8(10.2/2) that requires an + -- allocator to raise Program_Error if the collection finalization has + -- already started. See also Ada.Finalization.List_Controller. Finalize on + -- List_Controller first sets the list to Collection_Finalization_Started, + -- to indicate that finalization has started. An allocator will call + -- Attach_To_Final_List, which checks for the special value and raises + -- Program_Error if appropriate. The value of + -- Collection_Finalization_Started must be different from 'Access of any + -- finalizable object, and different from null. See AI-280. + Global_Final_List : SFR.Finalizable_Ptr; -- This list stores the controlled objects defined in library-level -- packages. They will be finalized after the main program completion. Index: s-tassta.adb =================================================================== --- s-tassta.adb (revision 118179) +++ s-tassta.adb (working copy) @@ -518,6 +518,15 @@ package body System.Tasking.Stages is Len : Natural; begin + -- If Master is greater than the current master, it means that Master + -- has already awaited its dependent tasks. This raises Program_Error, + -- by 4.8(10.3/2). See AI-280. + + if Master > Self_ID.Master_Within then + raise Program_Error with + "create task after awaiting termination"; + end if; + -- If pragma Detect_Blocking is active must be checked whether -- this potentially blocking operation is called from a -- protected action.