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:
Bob Duff 2006-10-31 18:48:46 +01:00 committed by Arnaud Charlet
parent 18f2228492
commit 498a5a8414
4 changed files with 49 additions and 4 deletions

View File

@ -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;

View File

@ -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;

View File

@ -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.

View File

@ -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.