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.



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@118241 138bc75d-0d04-0410-961f-82ee72b054a4

4 files changed, 49 insertions, 4 deletions

diff --git a/gcc/ada/a-filico.adb b/gcc/ada/a-filico.adb
index 780dbba08f4..c18f852500b 100644
--- a/gcc/ada/a-filico.adb
+++ b/gcc/ada/a-filico.adb
@@ -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;
diff --git a/gcc/ada/s-finimp.adb b/gcc/ada/s-finimp.adb
index 133c47ca285..518c9984900 100644
--- a/gcc/ada/s-finimp.adb
+++ b/gcc/ada/s-finimp.adb
@@ -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;
diff --git a/gcc/ada/s-finimp.ads b/gcc/ada/s-finimp.ads
index 83d1709b6a8..8366e956c99 100644
--- a/gcc/ada/s-finimp.ads
+++ b/gcc/ada/s-finimp.ads
@@ -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.
diff --git a/gcc/ada/s-tassta.adb b/gcc/ada/s-tassta.adb
index 38c1fca70ed..e0a6c946348 100644
--- a/gcc/ada/s-tassta.adb
+++ b/gcc/ada/s-tassta.adb
@@ -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.