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.



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

1 files changed, 58 insertions, 3 deletions

diff --git a/gcc/ada/a-comutr.adb b/gcc/ada/a-comutr.adb
index a923871b148..4933bcf54a9 100644
--- a/gcc/ada/a-comutr.adb
+++ b/gcc/ada/a-comutr.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- --
@@ -206,6 +206,20 @@ package body Ada.Containers.Multiway_Trees is
       Container.Count := Source_Count;
    end Adjust;
 
+   procedure Adjust (Control : in out Reference_Control_Type) is
+   begin
+      if Control.Container /= null then
+         declare
+            C : Tree renames Control.Container.all;
+            B : Natural renames C.Busy;
+            L : Natural renames C.Lock;
+         begin
+            B := B + 1;
+            L := L + 1;
+         end;
+      end if;
+   end Adjust;
+
    -------------------
    -- Ancestor_Find --
    -------------------
@@ -464,7 +478,20 @@ package body Ada.Containers.Multiway_Trees is
       --  pragma Assert (Vet (Position),
       --                 "Position cursor in Constant_Reference is bad");
 
-      return (Element => Position.Node.Element'Access);
+      declare
+         C : Tree renames Position.Container.all;
+         B : Natural renames C.Busy;
+         L : Natural renames C.Lock;
+      begin
+         return R : constant Constant_Reference_Type :=
+                      (Element => Position.Node.Element'Access,
+                       Control =>
+                         (Controlled with Container'Unrestricted_Access))
+         do
+            B := B + 1;
+            L := L + 1;
+         end return;
+      end;
    end Constant_Reference;
 
    --------------
@@ -957,6 +984,22 @@ package body Ada.Containers.Multiway_Trees is
       B := B - 1;
    end Finalize;
 
+   procedure Finalize (Control : in out Reference_Control_Type) is
+   begin
+      if Control.Container /= null then
+         declare
+            C : Tree renames Control.Container.all;
+            B : Natural renames C.Busy;
+            L : Natural renames C.Lock;
+         begin
+            B := B - 1;
+            L := L - 1;
+         end;
+
+         Control.Container := null;
+      end if;
+   end Finalize;
+
    ----------
    -- Find --
    ----------
@@ -2053,7 +2096,19 @@ package body Ada.Containers.Multiway_Trees is
       --  pragma Assert (Vet (Position),
       --                 "Position cursor in Constant_Reference is bad");
 
-      return (Element => Position.Node.Element'Access);
+      declare
+         C : Tree renames Position.Container.all;
+         B : Natural renames C.Busy;
+         L : Natural renames C.Lock;
+      begin
+         return R : constant Reference_Type :=
+                      (Element => Position.Node.Element'Access,
+                       Control => (Controlled with Position.Container))
+         do
+            B := B + 1;
+            L := L + 1;
+         end return;
+      end;
    end Reference;
 
    --------------------