[multiple changes]

2011-09-05  Hristian Kirtchev  <kirtchev@adacore.com>

	* s-finmas.adb (Set_Finalize_Address): Explain the reason
	for the synchronization. Move the test for null from
	s-stposu.Allocate_Any_Controlled to this routine since the check
	needs to be protected too.
	(Set_Heterogeneous_Finalize_Address): Explain the reason for the
	synchronization code.
	* s-finmas.ads (Set_Heterogeneous_Finalize_Address): Add comment
	explaining the context in which this routine is used.
	* s-stposu.adb (Allocate_Any_Controlled): Move the test for null
	to s-finmas.Set_Finalize_Address.

2011-09-05  Ed Schonberg  <schonberg@adacore.com>

	* einfo.ads: Document that itypes have no parent field.

2011-09-05  Robert Dewar  <dewar@adacore.com>

	* rtsfind.adb (Check_CRT): Check for overloaded entity
	* rtsfind.ads: Document that entities to be found by rtsfind
	cannot be overloaded
	* s-taenca.adb, s-tasren.adb, s-tpobop.adb, s-tpoben.ads, s-tpoben.adb
	(Lock_Entries_With_Status): New name for Lock_Entries with two
	arguments (changed to meet rtsfind no overloading rule).

From-SVN: r178551

gcc/ada/ChangeLog

 2011-09-05  Hristian Kirtchev  <kirtchev@adacore.com>
 
+	* s-finmas.adb (Set_Finalize_Address): Explain the reason
+	for the synchronization. Move the test for null from
+	s-stposu.Allocate_Any_Controlled to this routine since the check
+	needs to be protected too.
+	(Set_Heterogeneous_Finalize_Address): Explain the reason for the
+	synchronization code.
+	* s-finmas.ads (Set_Heterogeneous_Finalize_Address): Add comment
+	explaining the context in which this routine is used.
+	* s-stposu.adb (Allocate_Any_Controlled): Move the test for null
+	to s-finmas.Set_Finalize_Address.
+
+2011-09-05  Ed Schonberg  <schonberg@adacore.com>
+
+	* einfo.ads: Document that itypes have no parent field.
+
+2011-09-05  Robert Dewar  <dewar@adacore.com>
+
+	* rtsfind.adb (Check_CRT): Check for overloaded entity
+	* rtsfind.ads: Document that entities to be found by rtsfind
+	cannot be overloaded
+	* s-taenca.adb, s-tasren.adb, s-tpobop.adb, s-tpoben.ads, s-tpoben.adb
+	(Lock_Entries_With_Status): New name for Lock_Entries with two
+	arguments (changed to meet rtsfind no overloading rule).
+
+2011-09-05  Hristian Kirtchev  <kirtchev@adacore.com>
+
 	* s-finmas.adb (Set_Finalize_Address (Address,
 	Finalize_Address_Ptr)): Renamed to Set_Heterogeneous_Finalize_Address.
 	(Set_Finalize_Address (in out Finalization_Master,

gcc/ada/einfo.ads

@@ -442,6 +442,11 @@ package Einfo is
 --       declaration, the associated_node_for_itype is the discriminant
 --       specification. For an access parameter it is the enclosing subprogram
 --       declaration.
+--
+--       Itypes have no explicit declaration, and therefore are not attached to
+--       the tree: their Parent field is always empty. The Associated_Node_For_
+--       Itype is the only way to determine the construct that leads to the
+--       creation of a given itype entity.
 
 --    Associated_Storage_Pool (Node22) [root type only]
 --       Present in simple and general access type entities. References the

gcc/ada/rtsfind.adb

@@ -135,7 +135,7 @@ package body Rtsfind is
    --  Check entity Eid to ensure that configurable run-time restrictions are
    --  met. May generate an error message (if RTE_Available_Call is false) and
    --  raise RE_Not_Available if entity E does not exist (e.g. Eid is Empty).
-   --  Above documentation not clear ???
+   --  Also check that entity is not overloaded.
 
    procedure Entity_Not_Defined (Id : RE_Id);
    --  Outputs error messages for an entity that is not defined in the run-time
@@ -233,6 +233,22 @@ package body Rtsfind is
             raise RE_Not_Available;
          end if;
 
+         --  Check entity is not overloaded, checking for special exceptions
+
+         if Has_Homonym (Eid)
+           and then E /= RE_Save_Occurrence
+         then
+            Set_Standard_Error;
+            Write_Str ("Run-time configuration error (");
+            Write_Str ("rtsfind entity """);
+            Get_Decoded_Name_String (Chars (Eid));
+            Set_Casing (Mixed_Case);
+            Write_Str (Name_Buffer (1 .. Name_Len));
+            Write_Str (""" is overloaded)");
+            Write_Eol;
+            raise Unrecoverable_Error;
+         end if;
+
          --  Otherwise entity is accessible
 
          return Eid;
@@ -414,8 +430,8 @@ package body Rtsfind is
          return E1 = E2;
       end if;
 
-      --  If the unit containing E is not loaded, we already know that
-      --  the entity we have cannot have come from this unit.
+      --  If the unit containing E is not loaded, we already know that the
+      --  entity we have cannot have come from this unit.
 
       E_Unit_Name := Get_Unit_Name (RE_Unit_Table (E));
 

gcc/ada/rtsfind.ads

@@ -498,6 +498,14 @@ package Rtsfind is
    --  value is required syntactically, but no real entry is required or
    --  needed. Use of this value will cause a fatal error in an RTE call.
 
+   --  Note that under no circumstances can any of these entities be defined
+   --  more than once in a given package, i.e. no overloading is allowed for
+   --  any entity that is found using rtsfind. A fatal error is given if this
+   --  rule is violated. The one exception is for Save_Occurrence, where the
+   --  RM mandates the overloading. In this case, the compiler only uses the
+   --  procedure, not the function, and the procedure must come first so that
+   --  the compiler finds it and not the function.
+
    type RE_Id is (
 
      RE_Null,

gcc/ada/s-finmas.adb

@@ -463,8 +463,17 @@ package body System.Finalization_Masters is
       Fin_Addr_Ptr : Finalize_Address_Ptr)
    is
    begin
+      --  TSS primitive Finalize_Address is set at the point of allocation,
+      --  either through Allocate_Any_Controlled or through this routine.
+      --  Since multiple tasks can allocate on the same finalization master,
+      --  access to this attribute must be protected.
+
       Lock_Task.all;
-      Master.Finalize_Address := Fin_Addr_Ptr;
+
+      if Master.Finalize_Address = null then
+         Master.Finalize_Address := Fin_Addr_Ptr;
+      end if;
+
       Unlock_Task.all;
    end Set_Finalize_Address;
 
@@ -477,6 +486,9 @@ package body System.Finalization_Masters is
       Fin_Addr_Ptr : Finalize_Address_Ptr)
    is
    begin
+      --  Protected access is required in this case because
+      --  Finalize_Address_Table is a global data structure.
+
       Lock_Task.all;
       Finalize_Address_Table.Set (Obj, Fin_Addr_Ptr);
       Unlock_Task.all;

gcc/ada/s-finmas.ads

@@ -124,7 +124,10 @@ package System.Finalization_Masters is
    procedure Set_Heterogeneous_Finalize_Address
      (Obj          : System.Address;
       Fin_Addr_Ptr : Finalize_Address_Ptr);
-   --  Add a relation pair object - Finalize_Address to the internal hash table
+   --  Add a relation pair object - Finalize_Address to the internal hash
+   --  table. This is done in the context of allocation on a heterogeneous
+   --  finalization master where a single master services multiple anonymous
+   --  access-to-controlled types.
 
    procedure Set_Is_Heterogeneous (Master : in out Finalization_Master);
    --  Mark the master as being a heterogeneous collection of objects

gcc/ada/s-stposu.adb

@@ -276,9 +276,7 @@ package body System.Storage_Pools.Subpools is
          --    3) Most cases of anonymous access types usage
 
          if Master.Is_Homogeneous then
-            if Finalize_Address (Master.all) = null then
-               Set_Finalize_Address (Master.all, Fin_Address);
-            end if;
+            Set_Finalize_Address (Master.all, Fin_Address);
 
          --  Heterogeneous masters service the following:
 

gcc/ada/s-taenca.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                  B o d y                                 --
 --                                                                          --
---         Copyright (C) 1992-2010, Free Software Foundation, Inc.          --
+--         Copyright (C) 1992-2011, Free Software Foundation, Inc.          --
 --                                                                          --
 -- GNARL 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- --
@@ -216,7 +216,7 @@ package body System.Tasking.Entry_Calls is
                   STPO.Unlock_RTS;
                end if;
 
-               Lock_Entries (Test_PO, Ceiling_Violation);
+               Lock_Entries_With_Status (Test_PO, Ceiling_Violation);
 
                --  ???
 

gcc/ada/s-tasren.adb

@@ -628,7 +628,7 @@ package body System.Tasking.Rendezvous is
                --  Requeue to a protected entry
 
                Called_PO := POE.To_Protection (Entry_Call.Called_PO);
-               STPE.Lock_Entries (Called_PO, Ceiling_Violation);
+               STPE.Lock_Entries_With_Status (Called_PO, Ceiling_Violation);
 
                if Ceiling_Violation then
                   pragma Assert (Ex = Ada.Exceptions.Null_Id);

gcc/ada/s-tpoben.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                               B o d y                                    --
 --                                                                          --
---          Copyright (C) 1998-2010, Free Software Foundation, Inc.         --
+--          Copyright (C) 1998-2011, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNARL 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- --
@@ -261,7 +261,22 @@ package body System.Tasking.Protected_Objects.Entries is
    -- Lock_Entries --
    ------------------
 
-   procedure Lock_Entries
+   procedure Lock_Entries (Object : Protection_Entries_Access) is
+      Ceiling_Violation : Boolean;
+
+   begin
+      Lock_Entries_With_Status (Object, Ceiling_Violation);
+
+      if Ceiling_Violation then
+         raise Program_Error with "Ceiling Violation";
+      end if;
+   end Lock_Entries;
+
+   ------------------------------
+   -- Lock_Entries_With_Status --
+   ------------------------------
+
+   procedure Lock_Entries_With_Status
      (Object            : Protection_Entries_Access;
       Ceiling_Violation : out Boolean)
    is
@@ -316,19 +331,7 @@ package body System.Tasking.Protected_Objects.Entries is
               Self_Id.Common.Protected_Action_Nesting + 1;
          end;
       end if;
-
-   end Lock_Entries;
-
-   procedure Lock_Entries (Object : Protection_Entries_Access) is
-      Ceiling_Violation : Boolean;
-
-   begin
-      Lock_Entries (Object, Ceiling_Violation);
-
-      if Ceiling_Violation then
-         raise Program_Error with "Ceiling Violation";
-      end if;
-   end Lock_Entries;
+   end Lock_Entries_With_Status;
 
    ----------------------------
    -- Lock_Read_Only_Entries --

gcc/ada/s-tpoben.ads

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                  S p e c                                 --
 --                                                                          --
---          Copyright (C) 1992-2009, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2011, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNARL 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- --
@@ -183,7 +183,7 @@ package System.Tasking.Protected_Objects.Entries is
    --  Unlock has been made by the caller. Program_Error is raised in case of
    --  ceiling violation.
 
-   procedure Lock_Entries
+   procedure Lock_Entries_With_Status
      (Object            : Protection_Entries_Access;
       Ceiling_Violation : out Boolean);
    --  Same as above, but return the ceiling violation status instead of

gcc/ada/s-tpobop.adb

@@ -568,7 +568,7 @@ package body System.Tasking.Protected_Objects.Operations is
       --  where abort is already deferred.
 
       Initialization.Defer_Abort_Nestable (Self_ID);
-      Lock_Entries (Object, Ceiling_Violation);
+      Lock_Entries_With_Status (Object, Ceiling_Violation);
 
       if Ceiling_Violation then
 
@@ -722,7 +722,7 @@ package body System.Tasking.Protected_Objects.Operations is
 
             --  Requeue is to different PO
 
-            Lock_Entries (New_Object, Ceiling_Violation);
+            Lock_Entries_With_Status (New_Object, Ceiling_Violation);
 
             if Ceiling_Violation then
                Object.Call_In_Progress := null;
@@ -966,7 +966,7 @@ package body System.Tasking.Protected_Objects.Operations is
       end if;
 
       Initialization.Defer_Abort_Nestable (Self_Id);
-      Lock_Entries (Object, Ceiling_Violation);
+      Lock_Entries_With_Status (Object, Ceiling_Violation);
 
       if Ceiling_Violation then
          Initialization.Undefer_Abort (Self_Id);