* a-filico.adb (Finalize(List_Controller)): Mark the finalization list
as finalization-started, so we can raise Program_Error on 'new'.
* s-finimp.adb: Raise Program_Error on 'new' if finalization of the
collection has already started.
* s-finimp.ads (Collection_Finalization_Started): Added new special
flag value for indicating that a collection's finalization has started.
* s-tassta.adb (Create_Task): Raise Program_Error on an attempt to
create a task whose master has already waited for dependent tasks.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@118241
138bc75d-0d04-0410-961f-
82ee72b054a4
-- --
-- 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- --
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;
with Ada.Exceptions;
with Ada.Tags;
-with System.Storage_Elements;
with System.Soft_Links;
with Unchecked_Conversion;
package SSL renames System.Soft_Links;
- package SSE renames System.Storage_Elements;
use type SSE.Storage_Offset;
-----------------------
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;
-- --
-- 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- --
-- --
------------------------------------------------------------------------------
+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.
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.
OSDN Git Service
