[multiple changes]

2012-02-17  Yannick Moy  <moy@adacore.com>

	* gnat_rm.texi: Minor shuffling.

2012-02-17  Ed Schonberg  <schonberg@adacore.com>

	* aspects.adb: Expression functions can carry pre/postconditions.
	* par-ch6.adb (P_Subprogram): look for optional pre/postconditions
	in an expression function.
	* sem_prag (Check_Precondition_Postcondition): legal on expression
	functions.

2012-02-17  Vincent Pucci  <pucci@adacore.com>

	* a-cdlili.adb, a-cidlli.adb, a-cihama.adb, a-cimutr.adb,
	* a-ciorma.adb, a-cohama.adb, a-coinve.adb, a-comutr.adb,
	* a-convec.adb, a-coorma.adb (Adjust): New routine.
	(Constant_Reference): Increment Busy and Lock counters.
	(Reference): Increase Busy and Lock counters.
	(Finalize): New routine.
	* a-cihase.adb, a-ciorse.adb, a-cohase.adb, a-coorse.adb:
	(Adjust): New routine.	(Constant_Reference): Increment Busy
	and Lock counters.
	(Finalize): New routine.
	* a-cdlili.ads, a-cidlli.ads, a-cihama.ads, a-cihase.ads,
	* a-cimutr.ads, a-ciorma.ads, a-ciorse.ads, a-cohama.ads,
	* a-cohase.ads, a-coinve.ads, a-comutr.ads, a-convec.ads,
	* a-coorma.ads, a-coorse: Controlled component added to the
	reference types.

2012-02-17  Robert Dewar  <dewar@adacore.com>

	* restrict.adb (Check_Restriction): Add special handling for
	No_Obsolescent_Features.

2012-02-17  Hristian Kirtchev  <kirtchev@adacore.com>

	* exp_util.adb (Find_Finalize_Address): When dealing with an
	internally built full view for a type with unknown discriminants,
	use the original record type.

From-SVN: r184341

1 files changed, 86 insertions, 5 deletions

diff --git a/gcc/ada/a-ciorma.adb b/gcc/ada/a-ciorma.adb
index 15efbc7..b62b87b 100644
--- a/gcc/ada/a-ciorma.adb
+++ b/gcc/ada/a-ciorma.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 2004-2011, Free Software Foundation, Inc.         --
+--          Copyright (C) 2004-2012, 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- --
@@ -291,6 +291,20 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
       Adjust (Container.Tree);
    end Adjust;
 
+   procedure Adjust (Control : in out Reference_Control_Type) is
+   begin
+      if Control.Container /= null then
+         declare
+            T : Tree_Type renames Control.Container.all.Tree;
+            B : Natural renames T.Busy;
+            L : Natural renames T.Lock;
+         begin
+            B := B + 1;
+            L := L + 1;
+         end;
+      end if;
+   end Adjust;
+
    ------------
    -- Assign --
    ------------
@@ -379,7 +393,20 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
       pragma Assert (Vet (Container.Tree, Position.Node),
                      "Position cursor in Constant_Reference is bad");
 
-      return (Element => Position.Node.Element.all'Access);
+      declare
+         T : Tree_Type renames Container'Unrestricted_Access.all.Tree;
+         B : Natural renames T.Busy;
+         L : Natural renames T.Lock;
+      begin
+         return R : constant Constant_Reference_Type :=
+                      (Element => Position.Node.Element.all'Access,
+                       Control =>
+                         (Controlled with Container'Unrestricted_Access))
+         do
+            B := B + 1;
+            L := L + 1;
+         end return;
+      end;
    end Constant_Reference;
 
    function Constant_Reference
@@ -397,7 +424,20 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
          raise Program_Error with "Node has no element";
       end if;
 
-      return (Element => Node.Element.all'Access);
+      declare
+         T : Tree_Type renames Container'Unrestricted_Access.all.Tree;
+         B : Natural renames T.Busy;
+         L : Natural renames T.Lock;
+      begin
+         return R : constant Constant_Reference_Type :=
+                      (Element => Node.Element.all'Access,
+                       Control =>
+                         (Controlled with Container'Unrestricted_Access))
+         do
+            B := B + 1;
+            L := L + 1;
+         end return;
+      end;
    end Constant_Reference;
 
    --------------
@@ -586,6 +626,22 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
       end if;
    end Finalize;
 
+   procedure Finalize (Control : in out Reference_Control_Type) is
+   begin
+      if Control.Container /= null then
+         declare
+            T : Tree_Type renames Control.Container.all.Tree;
+            B : Natural renames T.Busy;
+            L : Natural renames T.Lock;
+         begin
+            B := B - 1;
+            L := L - 1;
+         end;
+
+         Control.Container := null;
+      end if;
+   end Finalize;
+
    ----------
    -- Find --
    ----------
@@ -1360,7 +1416,19 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
       pragma Assert (Vet (Container.Tree, Position.Node),
                      "Position cursor in function Reference is bad");
 
-      return (Element => Position.Node.Element.all'Access);
+      declare
+         T : Tree_Type renames Container'Unrestricted_Access.all.Tree;
+         B : Natural renames T.Busy;
+         L : Natural renames T.Lock;
+      begin
+         return R : constant Reference_Type :=
+                      (Element => Position.Node.Element.all'Access,
+                       Control => (Controlled with Position.Container))
+         do
+            B := B + 1;
+            L := L + 1;
+         end return;
+      end;
    end Reference;
 
    function Reference
@@ -1378,7 +1446,20 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
          raise Program_Error with "Node has no element";
       end if;
 
-      return (Element => Node.Element.all'Access);
+      declare
+         T : Tree_Type renames Container'Unrestricted_Access.all.Tree;
+         B : Natural renames T.Busy;
+         L : Natural renames T.Lock;
+      begin
+         return R : constant Reference_Type :=
+                      (Element => Node.Element.all'Access,
+                       Control =>
+                         (Controlled with Container'Unrestricted_Access))
+         do
+            B := B + 1;
+            L := L + 1;
+         end return;
+      end;
    end Reference;
 
    -------------