2011-12-02 Robert Dewar <dewar@adacore.com>

	* sem_ch6.adb: Minor change in error message.

2011-12-02  Robert Dewar  <dewar@adacore.com>

	* sem_ch9.adb, prj-part.adb, vms_data.ads, sem_ch8.adb: Minor
	reformatting.

2011-12-02  Javier Miranda  <miranda@adacore.com>

	* sem_ch3.adb (Constrain_Access): Enable on Ada 2005 mode the
	static check of the rule of general access types whose designated
	type has discriminants.
	* sem_util.ads, sem_util.adb
	(Effectively_Has_Constrained_Partial_View): New subprogram.
	(In_Generic_Body): New subprogram.
	* einfo.ads (Has_Constrained_Partial_View): Adding documentation.
	* sem_prag.adb (Inside_Generic_Body): Removed. Replaced by new
	subprogram In_Generic_Body.
	* exp_attr.adb, checks.adb, sem_attr.adb, exp_ch4.adb,
	sem_ch4.adb: In addition, this patch replaces the occurrences of
	Has_Constrained_Partial_View by
	Effectively_Has_Constrained_Partial_View.

2011-12-02  Matthew Heaney  <heaney@adacore.com>

	* a-comutr.adb, a-cimutr.adb, a-cbmutr.adb (Iterator): Rename
	Position component.
	(Finalize): Remove unnecessary access check.
	(First): Forward to First_Child.
	(Last): Forward to Last_Child.
	(Iterate): Check preconditions for parent node parameter.
	(Next): Forward to Next_Sibling.
	(Previous): Forward to Previous_Sibling.



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

1 files changed, 35 insertions, 32 deletions

diff --git a/gcc/ada/a-cimutr.adb b/gcc/ada/a-cimutr.adb
index 08bfbaebaa4..01929bbf373 100644
--- a/gcc/ada/a-cimutr.adb
+++ b/gcc/ada/a-cimutr.adb
@@ -45,7 +45,7 @@ package body Ada.Containers.Indefinite_Multiway_Trees is
      Tree_Iterator_Interfaces.Reversible_Iterator with
    record
       Container : Tree_Access;
-      Position  : Cursor;
+      Parent    : Tree_Node_Access;
    end record;
 
    overriding procedure Finalize (Object : in out Iterator);
@@ -937,25 +937,15 @@ package body Ada.Containers.Indefinite_Multiway_Trees is
    --------------
 
    procedure Finalize (Object : in out Iterator) is
+      B : Natural renames Object.Container.Busy;
    begin
-      if Object.Container /= null then
-         declare
-            B : Natural renames Object.Container.all.Busy;
-         begin
-            B := B - 1;
-         end;
-      end if;
+      B := B - 1;
    end Finalize;
 
    procedure Finalize (Object : in out Child_Iterator) is
+      B : Natural renames Object.Container.Busy;
    begin
-      if Object.Container /= null then
-         declare
-            B : Natural renames Object.Container.all.Busy;
-         begin
-            B := B - 1;
-         end;
-      end if;
+      B := B - 1;
    end Finalize;
 
    ----------
@@ -988,7 +978,7 @@ package body Ada.Containers.Indefinite_Multiway_Trees is
 
    function First (Object : Child_Iterator) return Cursor is
    begin
-      return (Object.Container, Object.Position.Node.Children.First);
+      return First_Child (Cursor'(Object.Container, Object.Parent));
    end First;
 
    -----------------
@@ -1433,13 +1423,22 @@ package body Ada.Containers.Indefinite_Multiway_Trees is
       Parent    : Cursor)
      return Tree_Iterator_Interfaces.Reversible_Iterator'Class
    is
-      B : Natural renames Container'Unrestricted_Access.all.Busy;
+      C : constant Tree_Access := Container'Unrestricted_Access;
+      B : Natural renames C.Busy;
 
    begin
+      if Parent = No_Element then
+         raise Constraint_Error with "Parent cursor has no element";
+      end if;
+
+      if Parent.Container /= C then
+         raise Program_Error with "Parent cursor not in container";
+      end if;
+
       return It : constant Child_Iterator :=
                     Child_Iterator'(Limited_Controlled with
-                                      Container => Parent.Container,
-                                      Position  => Parent)
+                                      Container => C,
+                                      Parent    => Parent.Node)
       do
          B := B + 1;
       end return;
@@ -1516,7 +1515,7 @@ package body Ada.Containers.Indefinite_Multiway_Trees is
 
    overriding function Last (Object : Child_Iterator) return Cursor is
    begin
-      return (Object.Container, Object.Position.Node.Children.Last);
+      return Last_Child (Cursor'(Object.Container, Object.Parent));
    end Last;
 
    ----------------
@@ -1646,18 +1645,20 @@ package body Ada.Containers.Indefinite_Multiway_Trees is
    end Next;
 
    function Next
-     (Object : Child_Iterator;
+     (Object   : Child_Iterator;
       Position : Cursor) return Cursor
    is
-      C : constant Tree_Node_Access := Position.Node.Next;
-
    begin
-      if C = null then
+      if Position.Container = null then
          return No_Element;
+      end if;
 
-      else
-         return (Object.Container, C);
+      if Position.Container /= Object.Container then
+         raise Program_Error with
+           "Position cursor of Next designates wrong tree";
       end if;
+
+      return Next_Sibling (Position);
    end Next;
 
    ------------------
@@ -1787,18 +1788,20 @@ package body Ada.Containers.Indefinite_Multiway_Trees is
    --------------
 
    overriding function Previous
-     (Object : Child_Iterator;
+     (Object   : Child_Iterator;
       Position : Cursor) return Cursor
    is
-      C : constant Tree_Node_Access := Position.Node.Prev;
-
    begin
-      if C = null then
+      if Position.Container = null then
          return No_Element;
+      end if;
 
-      else
-         return (Object.Container, C);
+      if Position.Container /= Object.Container then
+         raise Program_Error with
+           "Position cursor of Previous designates wrong tree";
       end if;
+
+      return Previous_Sibling (Position);
    end Previous;
 
    ----------------------