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, 87 insertions, 4 deletions

diff --git a/gcc/ada/a-convec.adb b/gcc/ada/a-convec.adb
index 729fead732c..709e1fe7e90 100644
--- a/gcc/ada/a-convec.adb
+++ b/gcc/ada/a-convec.adb
@@ -396,6 +396,20 @@ package body Ada.Containers.Vectors is
       end;
    end Adjust;
 
+   procedure Adjust (Control : in out Reference_Control_Type) is
+   begin
+      if Control.Container /= null then
+         declare
+            C : Vector 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;
+
    ------------
    -- Append --
    ------------
@@ -499,7 +513,21 @@ package body Ada.Containers.Vectors is
          raise Constraint_Error with "Position cursor is out of range";
       end if;
 
-      return (Element => Container.Elements.EA (Position.Index)'Access);
+      declare
+         C : Vector renames Position.Container.all;
+         B : Natural renames C.Busy;
+         L : Natural renames C.Lock;
+      begin
+         return R : constant Constant_Reference_Type :=
+                      (Element =>
+                         Container.Elements.EA (Position.Index)'Access,
+                       Control =>
+                         (Controlled with Container'Unrestricted_Access))
+         do
+            B := B + 1;
+            L := L + 1;
+         end return;
+      end;
    end Constant_Reference;
 
    function Constant_Reference
@@ -510,7 +538,20 @@ package body Ada.Containers.Vectors is
       if Index > Container.Last then
          raise Constraint_Error with "Index is out of range";
       else
-         return (Element => Container.Elements.EA (Index)'Access);
+         declare
+            C : Vector renames Container'Unrestricted_Access.all;
+            B : Natural renames C.Busy;
+            L : Natural renames C.Lock;
+         begin
+            return R : constant Constant_Reference_Type :=
+                         (Element => Container.Elements.EA (Index)'Access,
+                          Control =>
+                            (Controlled with Container'Unrestricted_Access))
+            do
+               B := B + 1;
+               L := L + 1;
+            end return;
+         end;
       end if;
    end Constant_Reference;
 
@@ -825,6 +866,22 @@ package body Ada.Containers.Vectors is
       B := B - 1;
    end Finalize;
 
+   procedure Finalize (Control : in out Reference_Control_Type) is
+   begin
+      if Control.Container /= null then
+         declare
+            C : Vector 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 --
    ----------
@@ -2601,7 +2658,20 @@ package body Ada.Containers.Vectors is
          raise Constraint_Error with "Position cursor is out of range";
       end if;
 
-      return (Element => Container.Elements.EA (Position.Index)'Access);
+      declare
+         C : Vector renames Position.Container.all;
+         B : Natural renames C.Busy;
+         L : Natural renames C.Lock;
+      begin
+         return R : constant Reference_Type :=
+                      (Element =>
+                         Container.Elements.EA (Position.Index)'Access,
+                       Control => (Controlled with Position.Container))
+         do
+            B := B + 1;
+            L := L + 1;
+         end return;
+      end;
    end Reference;
 
    function Reference
@@ -2612,7 +2682,20 @@ package body Ada.Containers.Vectors is
       if Index > Container.Last then
          raise Constraint_Error with "Index is out of range";
       else
-         return (Element => Container.Elements.EA (Index)'Access);
+         declare
+            C : Vector renames Container'Unrestricted_Access.all;
+            B : Natural renames C.Busy;
+            L : Natural renames C.Lock;
+         begin
+            return R : constant Reference_Type :=
+                         (Element => Container.Elements.EA (Index)'Access,
+                          Control =>
+                            (Controlled with Container'Unrestricted_Access))
+            do
+               B := B + 1;
+               L := L + 1;
+            end return;
+         end;
       end if;
    end Reference;