mirror of
git://gcc.gnu.org/git/gcc.git
synced 2025-03-22 03:30:29 +08:00
a-filico.adb (Finalize(List_Controller)): Mark the finalization list as finalization-started...
2006-10-31 Bob Duff <duff@adacore.com> * 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. From-SVN: r118241
This commit is contained in:
parent
18f2228492
commit
498a5a8414
@ -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_Controller is
|
||||
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;
|
||||
|
@ -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_Implementation is
|
||||
|
||||
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_Implementation is
|
||||
|
||||
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;
|
||||
|
@ -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.
|
||||
|
@ -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.
|
||||
|
Loading…
x
Reference in New Issue
Block a user