Patchwork [Ada] Check for container tampering

login
register
mail settings
Submitter Arnaud Charlet
Date April 11, 2013, 12:54 p.m.
Message ID <20130411125404.GA7262@adacore.com>
Download mbox | patch
Permalink /patch/235732/
State New
Headers show

Comments

Arnaud Charlet - April 11, 2013, 12:54 p.m.
There are several operations that call the generic formal less-than
operator. In principle it is possible for the generic actual to tamper with the
elements of the container while the operation is in progress, but such behavior
would be undefined. AI05-0022 requires that the implementation detect when
container manipulation occurs through the generic formal operator, and to raise
Program_Error as necessary to prevent erroneous execution.

We do that here by incrementing the lock counters before any element
comparisons. If tamper-sensitive operations are called while the loop is
executing, the non-zero lock count will be detected and Program_Error raised.

The text of AI05-0022 can be found here:

http://www.ada-auth.org/cgi-bin/cvsweb.cgi/ai05s/ai05-0022-1.txt

Tested on x86_64-pc-linux-gnu, committed on trunk

2013-04-11  Matthew Heaney  <heaney@adacore.com>

	* a-crbtgk.adb (Ceiling, Find, Floor): Adjust locks
	before element comparisons.
	(Generic_Conditional_Insert, Generic_Conditional_Insert_With_Hint):
	Ditto.
	* a-crbtgo.adb, a-rbtgbo.adb (Generic_Equal): Adjust locks before
	element comparisons.
	* a-rbtgso.adb (Difference, Intersection): Adjust locks
	before element comparisons.
	(Is_Subset, Overlap): Ditto
	(Symmetric_Difference, Union): Ditto
	* a-btgbso.adb (Set_Difference, Set_Intersection): Adjust locks
	before element comparisons.
	(Set_Subset, Set_Overlap): Ditto
	(Set_Symmetric_Difference, Set_Union): Ditto
	* a-coorse.adb, a-ciorse.adb, a-cborse.adb
	(Update_Element_Preserving_Key): Adjust locks before element
	comparisons (Replace_Element): Ditto

Patch

Index: a-crbtgk.adb
===================================================================
--- a-crbtgk.adb	(revision 197743)
+++ a-crbtgk.adb	(working copy)
@@ -6,7 +6,7 @@ 
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 2004-2011, Free Software Foundation, Inc.         --
+--          Copyright (C) 2004-2013, 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- --
@@ -38,10 +38,19 @@ 
    --  AKA Lower_Bound
 
    function Ceiling (Tree : Tree_Type; Key : Key_Type) return Node_Access is
+      B : Natural renames Tree'Unrestricted_Access.Busy;
+      L : Natural renames Tree'Unrestricted_Access.Lock;
+
       Y : Node_Access;
       X : Node_Access;
 
    begin
+      --  Per AI05-0022, the container implementation is required to detect
+      --  element tampering by a generic actual subprogram.
+
+      B := B + 1;
+      L := L + 1;
+
       X := Tree.Root;
       while X /= null loop
          if Is_Greater_Key_Node (Key, X) then
@@ -52,18 +61,37 @@ 
          end if;
       end loop;
 
+      B := B - 1;
+      L := L - 1;
+
       return Y;
+   exception
+      when others =>
+         B := B - 1;
+         L := L - 1;
+         raise;
    end Ceiling;
 
    ----------
    -- Find --
    ----------
 
-   function Find (Tree : Tree_Type; Key  : Key_Type) return Node_Access is
+   function Find (Tree : Tree_Type; Key : Key_Type) return Node_Access is
+      B : Natural renames Tree'Unrestricted_Access.Busy;
+      L : Natural renames Tree'Unrestricted_Access.Lock;
+
       Y : Node_Access;
       X : Node_Access;
 
+      Result : Node_Access;
+
    begin
+      --  Per AI05-0022, the container implementation is required to detect
+      --  element tampering by a generic actual subprogram.
+
+      B := B + 1;
+      L := L + 1;
+
       X := Tree.Root;
       while X /= null loop
          if Is_Greater_Key_Node (Key, X) then
@@ -75,25 +103,44 @@ 
       end loop;
 
       if Y = null then
-         return null;
-      end if;
+         Result := null;
 
-      if Is_Less_Key_Node (Key, Y) then
-         return null;
+      elsif Is_Less_Key_Node (Key, Y) then
+         Result := null;
+
+      else
+         Result := Y;
       end if;
 
-      return Y;
+      B := B - 1;
+      L := L - 1;
+
+      return Result;
+   exception
+      when others =>
+         B := B - 1;
+         L := L - 1;
+         raise;
    end Find;
 
    -----------
    -- Floor --
    -----------
 
-   function Floor (Tree : Tree_Type; Key  : Key_Type) return Node_Access is
+   function Floor (Tree : Tree_Type; Key : Key_Type) return Node_Access is
+      B : Natural renames Tree'Unrestricted_Access.Busy;
+      L : Natural renames Tree'Unrestricted_Access.Lock;
+
       Y : Node_Access;
       X : Node_Access;
 
    begin
+      --  Per AI05-0022, the container implementation is required to detect
+      --  element tampering by a generic actual subprogram.
+
+      B := B + 1;
+      L := L + 1;
+
       X := Tree.Root;
       while X /= null loop
          if Is_Less_Key_Node (Key, X) then
@@ -104,7 +151,15 @@ 
          end if;
       end loop;
 
+      B := B - 1;
+      L := L - 1;
+
       return Y;
+   exception
+      when others =>
+         B := B - 1;
+         L := L - 1;
+         raise;
    end Floor;
 
    --------------------------------
@@ -117,9 +172,17 @@ 
       Node     : out Node_Access;
       Inserted : out Boolean)
    is
-      Y : Node_Access := null;
-      X : Node_Access := Tree.Root;
+      X : Node_Access;
+      Y : Node_Access;
 
+      --  Per AI05-0022, the container implementation is required to detect
+      --  element tampering by a generic actual subprogram.
+
+      B : Natural renames Tree.Busy;
+      L : Natural renames Tree.Lock;
+
+      Compare : Boolean;
+
    begin
       --  This is a "conditional" insertion, meaning that the insertion request
       --  can "fail" in the sense that no new node is created. If the Key is
@@ -136,13 +199,28 @@ 
       --  either the smallest node greater than Key (Inserted is True), or the
       --  largest node less or equivalent to Key (Inserted is False).
 
-      Inserted := True;
-      while X /= null loop
-         Y := X;
-         Inserted := Is_Less_Key_Node (Key, X);
-         X := (if Inserted then Ops.Left (X) else Ops.Right (X));
-      end loop;
+      begin
+         B := B + 1;
+         L := L + 1;
 
+         X := Tree.Root;
+         Y := null;
+         Inserted := True;
+         while X /= null loop
+            Y := X;
+            Inserted := Is_Less_Key_Node (Key, X);
+            X := (if Inserted then Ops.Left (X) else Ops.Right (X));
+         end loop;
+
+         L := L - 1;
+         B := B - 1;
+      exception
+         when others =>
+            L := L - 1;
+            B := B - 1;
+            raise;
+      end;
+
       if Inserted then
 
          --  Either Tree is empty, or Key is less than Y. If Y is the first
@@ -172,8 +250,23 @@ 
       --  Key is equivalent to or greater than Node. We must resolve which is
       --  the case, to determine whether the conditional insertion succeeds.
 
-      if Is_Greater_Key_Node (Key, Node) then
+      begin
+         B := B + 1;
+         L := L + 1;
 
+         Compare := Is_Greater_Key_Node (Key, Node);
+
+         L := L - 1;
+         B := B - 1;
+      exception
+         when others =>
+            L := L - 1;
+            B := B - 1;
+            raise;
+      end;
+
+      if Compare then
+
          --  Key is strictly greater than Node, which means that Key is not
          --  equivalent to Node. In this case, the insertion succeeds, and we
          --  insert a new node into the tree.
@@ -201,6 +294,15 @@ 
       Node      : out Node_Access;
       Inserted  : out Boolean)
    is
+      --  Per AI05-0022, the container implementation is required to detect
+      --  element tampering by a generic actual subprogram.
+
+      B : Natural renames Tree.Busy;
+      L : Natural renames Tree.Lock;
+
+      Test    : Node_Access;
+      Compare : Boolean;
+
    begin
       --  The purpose of a hint is to avoid a search from the root of
       --  tree. If we have it hint it means we only need to traverse the
@@ -215,9 +317,23 @@ 
       --  done; otherwise the hint was "wrong" and we must search.
 
       if Position = null then  -- largest
-         if Tree.Last = null
-           or else Is_Greater_Key_Node (Key, Tree.Last)
-         then
+         begin
+            B := B + 1;
+            L := L + 1;
+
+            Compare := Tree.Last = null
+                         or else Is_Greater_Key_Node (Key, Tree.Last);
+
+            L := L - 1;
+            B := B - 1;
+         exception
+            when others =>
+               L := L - 1;
+               B := B - 1;
+               raise;
+         end;
+
+         if Compare then
             Insert_Post (Tree, Tree.Last, False, Node);
             Inserted := True;
          else
@@ -246,29 +362,59 @@ 
       --  then its neighbor must be anterior and so we insert before the
       --  hint.
 
-      if Is_Less_Key_Node (Key, Position) then
-         declare
-            Before : constant Node_Access := Ops.Previous (Position);
+      begin
+         B := B + 1;
+         L := L + 1;
 
+         Compare := Is_Less_Key_Node (Key, Position);
+
+         L := L - 1;
+         B := B - 1;
+      exception
+         when others =>
+            L := L - 1;
+            B := B - 1;
+            raise;
+      end;
+
+      if Compare then
+         Test := Ops.Previous (Position);  -- "before"
+
+         if Test = null then  -- new first node
+            Insert_Post (Tree, Tree.First, True, Node);
+
+            Inserted := True;
+            return;
+         end if;
+
          begin
-            if Before = null then
-               Insert_Post (Tree, Tree.First, True, Node);
-               Inserted := True;
+            B := B + 1;
+            L := L + 1;
 
-            elsif Is_Greater_Key_Node (Key, Before) then
-               if Ops.Right (Before) = null then
-                  Insert_Post (Tree, Before, False, Node);
-               else
-                  Insert_Post (Tree, Position, True, Node);
-               end if;
+            Compare := Is_Greater_Key_Node (Key, Test);
 
-               Inserted := True;
+            L := L - 1;
+            B := B - 1;
+         exception
+            when others =>
+               L := L - 1;
+               B := B - 1;
+               raise;
+         end;
 
+         if Compare then
+            if Ops.Right (Test) = null then
+               Insert_Post (Tree, Test, False, Node);
             else
-               Conditional_Insert_Sans_Hint (Tree, Key, Node, Inserted);
+               Insert_Post (Tree, Position, True, Node);
             end if;
-         end;
 
+            Inserted := True;
+
+         else
+            Conditional_Insert_Sans_Hint (Tree, Key, Node, Inserted);
+         end if;
+
          return;
       end if;
 
@@ -278,29 +424,59 @@ 
       --  greater than the hint and less than the hint's next neighbor,
       --  then we're done; otherwise we must search.
 
-      if Is_Greater_Key_Node (Key, Position) then
-         declare
-            After : constant Node_Access := Ops.Next (Position);
+      begin
+         B := B + 1;
+         L := L + 1;
 
+         Compare := Is_Greater_Key_Node (Key, Position);
+
+         L := L - 1;
+         B := B - 1;
+      exception
+         when others =>
+            L := L - 1;
+            B := B - 1;
+            raise;
+      end;
+
+      if Compare then
+         Test := Ops.Next (Position);  -- "after"
+
+         if Test = null then  -- new last node
+            Insert_Post (Tree, Tree.Last, False, Node);
+
+            Inserted := True;
+            return;
+         end if;
+
          begin
-            if After = null then
-               Insert_Post (Tree, Tree.Last, False, Node);
-               Inserted := True;
+            B := B + 1;
+            L := L + 1;
 
-            elsif Is_Less_Key_Node (Key, After) then
-               if Ops.Right (Position) = null then
-                  Insert_Post (Tree, Position, False, Node);
-               else
-                  Insert_Post (Tree, After, True, Node);
-               end if;
+            Compare := Is_Less_Key_Node (Key, Test);
 
-               Inserted := True;
+            L := L - 1;
+            B := B - 1;
+         exception
+            when others =>
+               L := L - 1;
+               B := B - 1;
+               raise;
+         end;
 
+         if Compare then
+            if Ops.Right (Position) = null then
+               Insert_Post (Tree, Position, False, Node);
             else
-               Conditional_Insert_Sans_Hint (Tree, Key, Node, Inserted);
+               Insert_Post (Tree, Test, True, Node);
             end if;
-         end;
 
+            Inserted := True;
+
+         else
+            Conditional_Insert_Sans_Hint (Tree, Key, Node, Inserted);
+         end if;
+
          return;
       end if;
 
Index: a-ciorse.adb
===================================================================
--- a-ciorse.adb	(revision 197743)
+++ a-ciorse.adb	(working copy)
@@ -6,7 +6,7 @@ 
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 2004-2012, Free Software Foundation, Inc.         --
+--          Copyright (C) 2004-2013, 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- --
@@ -1088,12 +1088,15 @@ 
             B : Natural renames Tree.Busy;
             L : Natural renames Tree.Lock;
 
+            Eq : Boolean;
+
          begin
             B := B + 1;
             L := L + 1;
 
             begin
                Process (E);
+               Eq := Equivalent_Keys (K, Key (E));
             exception
                when others =>
                   L := L - 1;
@@ -1104,7 +1107,7 @@ 
             L := L - 1;
             B := B - 1;
 
-            if Equivalent_Keys (K, Key (E)) then
+            if Eq then
                return;
             end if;
          end;
@@ -1884,16 +1887,54 @@ 
       Hint     : Node_Access;
       Result   : Node_Access;
       Inserted : Boolean;
+      Compare  : Boolean;
 
       X : Element_Access := Node.Element;
 
-      --  Start of processing for Replace_Element
+      --  Per AI05-0022, the container implementation is required to detect
+      --  element tampering by a generic actual subprogram.
 
+      B : Natural renames Tree.Busy;
+      L : Natural renames Tree.Lock;
+
+   --  Start of processing for Replace_Element
+
    begin
-      if Item < Node.Element.all or else Node.Element.all < Item then
-         null;
+      --  Replace_Element assigns value Item to the element designated by Node,
+      --  per certain semantic constraints, described as follows.
 
-      else
+      --  If Item is equivalent to the element, then element is replaced and
+      --  there's nothing else to do. This is the easy case.
+
+      --  If Item is not equivalent, then the node will (possibly) have to move
+      --  to some other place in the tree. This is slighly more complicated,
+      --  because we must ensure that Item is not equivalent to some other
+      --  element in the tree (in which case, the replacement is not allowed).
+
+      --  Determine whether Item is equivalent to element on the specified
+      --  node.
+
+      begin
+         B := B + 1;
+         L := L + 1;
+
+         Compare := (if Item < Node.Element.all then False
+                     elsif Node.Element.all < Item then False
+                     else True);
+
+         L := L - 1;
+         B := B - 1;
+      exception
+         when others =>
+            L := L - 1;
+            B := B - 1;
+            raise;
+      end;
+
+      if Compare then
+         --  Item is equivalent to the node's element, so we will not have to
+         --  move the node.
+
          if Tree.Lock > 0 then
             raise Program_Error with
               "attempt to tamper with elements (set is locked)";
@@ -1914,12 +1955,62 @@ 
          return;
       end if;
 
+      --  The replacement Item is not equivalent to the element on the
+      --  specified node, which means that it will need to be re-inserted in a
+      --  different position in the tree. We must now determine whether Item is
+      --  equivalent to some other element in the tree (which would prohibit
+      --  the assignment and hence the move).
+
+      --  Ceiling returns the smallest element equivalent or greater than the
+      --  specified Item; if there is no such element, then it returns null.
+
       Hint := Element_Keys.Ceiling (Tree, Item);
 
-      if Hint = null then
-         null;
+      if Hint /= null then
+         begin
+            B := B + 1;
+            L := L + 1;
 
-      elsif Item < Hint.Element.all then
+            Compare := Item < Hint.Element.all;
+
+            L := L - 1;
+            B := B - 1;
+         exception
+            when others =>
+               L := L - 1;
+               B := B - 1;
+               raise;
+         end;
+
+         if not Compare then  -- Item >= Hint.Element
+            --  Ceiling returns an element that is equivalent or greater than
+            --  Item. If Item is "not less than" the element, then by
+            --  elimination we know that Item is equivalent to the element.
+
+            --  But this means that it is not possible to assign the value of
+            --  Item to the specified element (on Node), because a different
+            --  element (on Hint) equivalent to Item already exsits. (Were we
+            --  to change Node's element value, we would have to move Node, but
+            --  we would be unable to move the Node, because its new position
+            --  in the tree is already occupied by an equivalent element.)
+
+            raise Program_Error with "attempt to replace existing element";
+         end if;
+
+         --  Item is not equivalent to any other element in the tree, so it is
+         --  safe to assign the value of Item to Node.Element. This means that
+         --  the node will have to move to a different position in the tree
+         --  (because its element will have a different value).
+
+         --  The nearest (greater) neighbor of Item is Hint. This will be the
+         --  insertion position of Node (because its element will have Item as
+         --  its new value).
+
+         --  If Node equals Hint, the relative position of Node does not
+         --  change. This allows us to perform an optimization: we need not
+         --  remove Node from the tree and then reinsert it with its new value,
+         --  because it would only be placed in the exact same position.
+
          if Hint = Node then
             if Tree.Lock > 0 then
                raise Program_Error with
@@ -1940,12 +2031,15 @@ 
 
             return;
          end if;
-
-      else
-         pragma Assert (not (Hint.Element.all < Item));
-         raise Program_Error with "attempt to replace existing element";
       end if;
 
+      --  If we get here, it is because Item was greater than all elements in
+      --  the tree (Hint = null), or because Item was less than some element at
+      --  a different place in the tree (Item < Hint.Element.all). In either
+      --  case, we remove Node from the tree (without actually deallocating
+      --  it), and then insert Item into the tree, onto the same Node (so no
+      --  new node is actually allocated).
+
       Tree_Operations.Delete_Node_Sans_Free (Tree, Node);  -- Checks busy-bit
 
       Local_Insert_With_Hint
Index: a-crbtgo.adb
===================================================================
--- a-crbtgo.adb	(revision 197743)
+++ a-crbtgo.adb	(working copy)
@@ -6,7 +6,7 @@ 
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 2004-2009, Free Software Foundation, Inc.         --
+--          Copyright (C) 2004-2013, 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- --
@@ -626,9 +626,17 @@ 
    -------------------
 
    function Generic_Equal (Left, Right : Tree_Type) return Boolean is
+      BL : Natural renames Left'Unrestricted_Access.Busy;
+      LL : Natural renames Left'Unrestricted_Access.Lock;
+
+      BR : Natural renames Right'Unrestricted_Access.Busy;
+      LR : Natural renames Right'Unrestricted_Access.Lock;
+
       L_Node : Node_Access;
       R_Node : Node_Access;
 
+      Result : Boolean;
+
    begin
       if Left'Address = Right'Address then
          return True;
@@ -638,18 +646,44 @@ 
          return False;
       end if;
 
+      --  Per AI05-0022, the container implementation is required to detect
+      --  element tampering by a generic actual subprogram.
+
+      BL := BL + 1;
+      LL := LL + 1;
+
+      BR := BR + 1;
+      LR := LR + 1;
+
       L_Node := Left.First;
       R_Node := Right.First;
+      Result := True;
       while L_Node /= null loop
          if not Is_Equal (L_Node, R_Node) then
-            return False;
+            Result := False;
+            exit;
          end if;
 
          L_Node := Next (L_Node);
          R_Node := Next (R_Node);
       end loop;
 
-      return True;
+      BL := BL - 1;
+      LL := LL - 1;
+
+      BR := BR - 1;
+      LR := LR - 1;
+
+      return Result;
+   exception
+      when others =>
+         BL := BL - 1;
+         LL := LL - 1;
+
+         BR := BR - 1;
+         LR := LR - 1;
+
+         raise;
    end Generic_Equal;
 
    -----------------------
Index: a-coorse.adb
===================================================================
--- a-coorse.adb	(revision 197743)
+++ a-coorse.adb	(working copy)
@@ -6,7 +6,7 @@ 
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 2004-2012, Free Software Foundation, Inc.         --
+--          Copyright (C) 2004-2013, 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- --
@@ -987,12 +987,15 @@ 
             B : Natural renames Tree.Busy;
             L : Natural renames Tree.Lock;
 
+            Eq : Boolean;
+
          begin
             B := B + 1;
             L := L + 1;
 
             begin
                Process (E);
+               Eq := Equivalent_Keys (K, Key (E));
             exception
                when others =>
                   L := L - 1;
@@ -1003,7 +1006,7 @@ 
             L := L - 1;
             B := B - 1;
 
-            if Equivalent_Keys (K, Key (E)) then
+            if Eq then
                return;
             end if;
          end;
@@ -1716,17 +1719,55 @@ 
          return Node;
       end New_Node;
 
-      Hint      : Node_Access;
-      Result    : Node_Access;
-      Inserted  : Boolean;
+      Hint     : Node_Access;
+      Result   : Node_Access;
+      Inserted : Boolean;
+      Compare  : Boolean;
 
-      --  Start of processing for Replace_Element
+      --  Per AI05-0022, the container implementation is required to detect
+      --  element tampering by a generic actual subprogram.
 
+      B : Natural renames Tree.Busy;
+      L : Natural renames Tree.Lock;
+
+   --  Start of processing for Replace_Element
+
    begin
-      if Item < Node.Element or else Node.Element < Item then
-         null;
+      --  Replace_Element assigns value Item to the element designated by Node,
+      --  per certain semantic constraints.
 
-      else
+      --  If Item is equivalent to the element, then element is replaced and
+      --  there's nothing else to do. This is the easy case.
+
+      --  If Item is not equivalent, then the node will (possibly) have to move
+      --  to some other place in the tree. This is slighly more complicated,
+      --  because we must ensure that Item is not equivalent to some other
+      --  element in the tree (in which case, the replacement is not allowed).
+
+      --  Determine whether Item is equivalent to element on the specified
+      --  node.
+
+      begin
+         B := B + 1;
+         L := L + 1;
+
+         Compare := (if Item < Node.Element then False
+                     elsif Node.Element < Item then False
+                     else True);
+
+         L := L - 1;
+         B := B - 1;
+      exception
+         when others =>
+            L := L - 1;
+            B := B - 1;
+            raise;
+      end;
+
+      if Compare then
+         --  Item is equivalent to the node's element, so we will not have to
+         --  move the node.
+
          if Tree.Lock > 0 then
             raise Program_Error with
               "attempt to tamper with elements (set is locked)";
@@ -1736,12 +1777,62 @@ 
          return;
       end if;
 
+      --  The replacement Item is not equivalent to the element on the
+      --  specified node, which means that it will need to be re-inserted in a
+      --  different position in the tree. We must now determine whether Item is
+      --  equivalent to some other element in the tree (which would prohibit
+      --  the assignment and hence the move).
+
+      --  Ceiling returns the smallest element equivalent or greater than the
+      --  specified Item; if there is no such element, then it returns null.
+
       Hint := Element_Keys.Ceiling (Tree, Item);
 
-      if Hint = null then
-         null;
+      if Hint /= null then
+         begin
+            B := B + 1;
+            L := L + 1;
 
-      elsif Item < Hint.Element then
+            Compare := Item < Hint.Element;
+
+            L := L - 1;
+            B := B - 1;
+         exception
+            when others =>
+               L := L - 1;
+               B := B - 1;
+               raise;
+         end;
+
+         if not Compare then  -- Item >= Hint.Element
+            --  Ceiling returns an element that is equivalent or greater than
+            --  Item. If Item is "not less than" the element, then by
+            --  elimination we know that Item is equivalent to the element.
+
+            --  But this means that it is not possible to assign the value of
+            --  Item to the specified element (on Node), because a different
+            --  element (on Hint) equivalent to Item already exsits. (Were we
+            --  to change Node's element value, we would have to move Node, but
+            --  we would be unable to move the Node, because its new position
+            --  in the tree is already occupied by an equivalent element.)
+
+            raise Program_Error with "attempt to replace existing element";
+         end if;
+
+         --  Item is not equivalent to any other element in the tree, so it is
+         --  safe to assign the value of Item to Node.Element. This means that
+         --  the node will have to move to a different position in the tree
+         --  (because its element will have a different value).
+
+         --  The nearest (greater) neighbor of Item is Hint. This will be the
+         --  insertion position of Node (because its element will have Item as
+         --  its new value).
+
+         --  If Node equals Hint, the relative position of Node does not
+         --  change. This allows us to perform an optimization: we need not
+         --  remove Node from the tree and then reinsert it with its new value,
+         --  because it would only be placed in the exact same position.
+
          if Hint = Node then
             if Tree.Lock > 0 then
                raise Program_Error with
@@ -1751,15 +1842,18 @@ 
             Node.Element := Item;
             return;
          end if;
-
-      else
-         pragma Assert (not (Hint.Element < Item));
-         raise Program_Error with "attempt to replace existing element";
       end if;
 
+      --  If we get here, it is because Item was greater than all elements in
+      --  the tree (Hint = null), or because Item was less than some element at
+      --  a different place in the tree (Item < Hint.Element). In either case,
+      --  we remove Node from the tree (without actually deallocating it), and
+      --  then insert Item into the tree, onto the same Node (so no new node is
+      --  actually allocated).
+
       Tree_Operations.Delete_Node_Sans_Free (Tree, Node);  -- Checks busy-bit
 
-      Local_Insert_With_Hint
+      Local_Insert_With_Hint  -- use unconditional insert here instead???
         (Tree     => Tree,
          Position => Hint,
          Key      => Item,
Index: a-rbtgbo.adb
===================================================================
--- a-rbtgbo.adb	(revision 197743)
+++ a-rbtgbo.adb	(working copy)
@@ -6,7 +6,7 @@ 
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 2004-2011, Free Software Foundation, Inc.         --
+--          Copyright (C) 2004-2013, 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- --
@@ -606,9 +606,17 @@ 
    -------------------
 
    function Generic_Equal (Left, Right : Tree_Type'Class) return Boolean is
+      BL : Natural renames Left'Unrestricted_Access.Busy;
+      LL : Natural renames Left'Unrestricted_Access.Lock;
+
+      BR : Natural renames Right'Unrestricted_Access.Busy;
+      LR : Natural renames Right'Unrestricted_Access.Lock;
+
       L_Node : Count_Type;
       R_Node : Count_Type;
 
+      Result : Boolean;
+
    begin
       if Left'Address = Right'Address then
          return True;
@@ -618,18 +626,43 @@ 
          return False;
       end if;
 
+      --  Per AI05-0022, the container implementation is required to detect
+      --  element tampering by a generic actual subprogram.
+
+      BL := BL + 1;
+      LL := LL + 1;
+
+      BR := BR + 1;
+      LR := LR + 1;
+
       L_Node := Left.First;
       R_Node := Right.First;
       while L_Node /= 0 loop
          if not Is_Equal (Left.Nodes (L_Node), Right.Nodes (R_Node)) then
-            return False;
+            Result := False;
+            exit;
          end if;
 
          L_Node := Next (Left, L_Node);
          R_Node := Next (Right, R_Node);
       end loop;
 
-      return True;
+      BL := BL - 1;
+      LL := LL - 1;
+
+      BR := BR - 1;
+      LR := LR - 1;
+
+      return Result;
+   exception
+      when others =>
+         BL := BL - 1;
+         LL := LL - 1;
+
+         BR := BR - 1;
+         LR := LR - 1;
+
+         raise;
    end Generic_Equal;
 
    -----------------------
Index: a-cborse.adb
===================================================================
--- a-cborse.adb	(revision 197743)
+++ a-cborse.adb	(working copy)
@@ -6,7 +6,7 @@ 
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 2004-2012, Free Software Foundation, Inc.         --
+--          Copyright (C) 2004-2013, 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- --
@@ -979,6 +979,9 @@ 
          pragma Assert (Vet (Container, Position.Node),
                         "bad cursor in Update_Element_Preserving_Key");
 
+         --  Per AI05-0022, the container implementation is required to detect
+         --  element tampering by a generic actual subprogram.
+
          declare
             N : Node_Type renames Container.Nodes (Position.Node);
             E : Element_Type renames N.Element;
@@ -987,12 +990,15 @@ 
             B : Natural renames Container.Busy;
             L : Natural renames Container.Lock;
 
+            Eq : Boolean;
+
          begin
             B := B + 1;
             L := L + 1;
 
             begin
                Process (E);
+               Eq := Equivalent_Keys (K, Key (E));
             exception
                when others =>
                   L := L - 1;
@@ -1003,7 +1009,7 @@ 
             L := L - 1;
             B := B - 1;
 
-            if Equivalent_Keys (K, Key (E)) then
+            if Eq then
                return;
             end if;
          end;
@@ -1727,16 +1733,52 @@ 
       Hint      : Count_Type;
       Result    : Count_Type;
       Inserted  : Boolean;
+      Compare   : Boolean;
 
+      --  Per AI05-0022, the container implementation is required to detect
+      --  element tampering by a generic actual subprogram.
+
+      B : Natural renames Container.Busy;
+      L : Natural renames Container.Lock;
+
    --  Start of processing for Replace_Element
 
    begin
-      if Item < Node.Element
-        or else Node.Element < Item
-      then
-         null;
+      --  Replace_Element assigns value Item to the element designated by Node,
+      --  per certain semantic constraints, described as follows.
 
-      else
+      --  If Item is equivalent to the element, then element is replaced and
+      --  there's nothing else to do. This is the easy case.
+
+      --  If Item is not equivalent, then the node will (possibly) have to move
+      --  to some other place in the tree. This is slighly more complicated,
+      --  because we must ensure that Item is not equivalent to some other
+      --  element in the tree (in which case, the replacement is not allowed).
+
+      --  Determine whether Item is equivalent to element on the specified
+      --  node.
+
+      begin
+         B := B + 1;
+         L := L + 1;
+
+         Compare := (if Item < Node.Element then False
+                     elsif Node.Element < Item then False
+                     else True);
+
+         L := L - 1;
+         B := B - 1;
+      exception
+         when others =>
+            L := L - 1;
+            B := B - 1;
+            raise;
+      end;
+
+      if Compare then
+         --  Item is equivalent to the node's element, so we will not have to
+         --  move the node.
+
          if Container.Lock > 0 then
             raise Program_Error with
               "attempt to tamper with elements (set is locked)";
@@ -1746,12 +1788,63 @@ 
          return;
       end if;
 
+      --  The replacement Item is not equivalent to the element on the
+      --  specified node, which means that it will need to be re-inserted in a
+      --  different position in the tree. We must now determine whether Item is
+      --  equivalent to some other element in the tree (which would prohibit
+      --  the assignment and hence the move).
+
+      --  Ceiling returns the smallest element equivalent or greater than the
+      --  specified Item; if there is no such element, then it returns 0.
+
       Hint := Element_Keys.Ceiling (Container, Item);
 
-      if Hint = 0 then
-         null;
+      if Hint /= 0 then  -- Item <= Nodes (Hint).Element
+         begin
+            B := B + 1;
+            L := L + 1;
 
-      elsif Item < Nodes (Hint).Element then
+            Compare := Item < Nodes (Hint).Element;
+
+            L := L - 1;
+            B := B - 1;
+         exception
+            when others =>
+               L := L - 1;
+               B := B - 1;
+               raise;
+         end;
+
+         if not Compare then  -- Item is equivalent to Nodes (Hint).Element
+            --  Ceiling returns an element that is equivalent or greater than
+            --  Item. If Item is "not less than" the element, then by
+            --  elimination we know that Item is equivalent to the element.
+
+            --  But this means that it is not possible to assign the value of
+            --  Item to the specified element (on Node), because a different
+            --  element (on Hint) equivalent to Item already exsits. (Were we
+            --  to change Node's element value, we would have to move Node, but
+            --  we would be unable to move the Node, because its new position
+            --  in the tree is already occupied by an equivalent element.)
+
+            raise Program_Error with "attempt to replace existing element";
+         end if;
+
+         --  Item is not equivalent to any other element in the tree
+         --  (specifically, it is less then Nodes (Hint).Element), so it is
+         --  safe to assign the value of Item to Node.Element. This means that
+         --  the node will have to move to a different position in the tree
+         --  (because its element will have a different value).
+
+         --  The nearest (greater) neighbor of Item is Hint. This will be the
+         --  insertion position of Node (because its element will have Item as
+         --  its new value).
+
+         --  If Node equals Hint, the relative position of Node does not
+         --  change. This allows us to perform an optimization: we need not
+         --  remove Node from the tree and then reinsert it with its new value,
+         --  because it would only be placed in the exact same position.
+
          if Hint = Index then
             if Container.Lock > 0 then
                raise Program_Error with
@@ -1761,12 +1854,14 @@ 
             Node.Element := Item;
             return;
          end if;
-
-      else
-         pragma Assert (not (Nodes (Hint).Element < Item));
-         raise Program_Error with "attempt to replace existing element";
       end if;
 
+      --  If we get here, it is because Item was greater than all elements in
+      --  the tree (Hint = 0), or because Item was less than some element at a
+      --  different place in the tree (Item < Nodes (Hint).Element and Hint /=
+      --  Index). In either case, we remove Node from the tree and then insert
+      --  Item into the tree, onto the same Node.
+
       Tree_Operations.Delete_Node_Sans_Free (Container, Index);
 
       Local_Insert_With_Hint
Index: a-rbtgso.adb
===================================================================
--- a-rbtgso.adb	(revision 197743)
+++ a-rbtgso.adb	(working copy)
@@ -6,7 +6,7 @@ 
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 2004-2009, Free Software Foundation, Inc.         --
+--          Copyright (C) 2004-2013, 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- --
@@ -84,9 +84,17 @@ 
    ----------------
 
    procedure Difference (Target : in out Tree_Type; Source : Tree_Type) is
-      Tgt : Node_Access := Target.First;
-      Src : Node_Access := Source.First;
+      BT : Natural renames Target.Busy;
+      LT : Natural renames Target.Lock;
 
+      BS : Natural renames Source'Unrestricted_Access.Busy;
+      LS : Natural renames Source'Unrestricted_Access.Lock;
+
+      Tgt : Node_Access;
+      Src : Node_Access;
+
+      Compare : Integer;
+
    begin
       if Target'Address = Source'Address then
          if Target.Busy > 0 then
@@ -107,19 +115,55 @@ 
            "attempt to tamper with cursors (container is busy)";
       end if;
 
+      Tgt := Target.First;
+      Src := Source.First;
       loop
          if Tgt = null then
-            return;
+            exit;
          end if;
 
          if Src = null then
-            return;
+            exit;
          end if;
 
-         if Is_Less (Tgt, Src) then
+         --  Per AI05-0022, the container implementation is required to detect
+         --  element tampering by a generic actual subprogram.
+
+         begin
+            BT := BT + 1;
+            LT := LT + 1;
+
+            BS := BS + 1;
+            LS := LS + 1;
+
+            if Is_Less (Tgt, Src) then
+               Compare := -1;
+            elsif Is_Less (Src, Tgt) then
+               Compare := 1;
+            else
+               Compare := 0;
+            end if;
+
+            BT := BT - 1;
+            LT := LT - 1;
+
+            BS := BS - 1;
+            LS := LS - 1;
+         exception
+            when others =>
+               BT := BT - 1;
+               LT := LT - 1;
+
+               BS := BS - 1;
+               LS := LS - 1;
+
+               raise;
+         end;
+
+         if Compare < 0 then
             Tgt := Tree_Operations.Next (Tgt);
 
-         elsif Is_Less (Src, Tgt) then
+         elsif Compare > 0 then
             Src := Tree_Operations.Next (Src);
 
          else
@@ -137,34 +181,66 @@ 
    end Difference;
 
    function Difference (Left, Right : Tree_Type) return Tree_Type is
-      Tree : Tree_Type;
-
-      L_Node : Node_Access := Left.First;
-      R_Node : Node_Access := Right.First;
-
-      Dst_Node : Node_Access;
-      pragma Warnings (Off, Dst_Node);
-
    begin
       if Left'Address = Right'Address then
-         return Tree;  -- Empty set
+         return Tree_Type'(others => <>);  -- Empty set
       end if;
 
       if Left.Length = 0 then
-         return Tree;  -- Empty set
+         return Tree_Type'(others => <>);  -- Empty set
       end if;
 
       if Right.Length = 0 then
          return Copy (Left);
       end if;
 
-      loop
-         if L_Node = null then
-            return Tree;
-         end if;
+      --  Per AI05-0022, the container implementation is required to detect
+      --  element tampering by a generic actual subprogram.
 
-         if R_Node = null then
-            while L_Node /= null loop
+      declare
+         BL : Natural renames Left'Unrestricted_Access.Busy;
+         LL : Natural renames Left'Unrestricted_Access.Lock;
+
+         BR : Natural renames Right'Unrestricted_Access.Busy;
+         LR : Natural renames Right'Unrestricted_Access.Lock;
+
+         Tree : Tree_Type;
+
+         L_Node : Node_Access;
+         R_Node : Node_Access;
+
+         Dst_Node : Node_Access;
+         pragma Warnings (Off, Dst_Node);
+
+      begin
+         BL := BL + 1;
+         LL := LL + 1;
+
+         BR := BR + 1;
+         LR := LR + 1;
+
+         L_Node := Left.First;
+         R_Node := Right.First;
+         loop
+            if L_Node = null then
+               exit;
+            end if;
+
+            if R_Node = null then
+               while L_Node /= null loop
+                  Insert_With_Hint
+                    (Dst_Tree => Tree,
+                     Dst_Hint => null,
+                     Src_Node => L_Node,
+                     Dst_Node => Dst_Node);
+
+                  L_Node := Tree_Operations.Next (L_Node);
+               end loop;
+
+               exit;
+            end if;
+
+            if Is_Less (L_Node, R_Node) then
                Insert_With_Hint
                  (Dst_Tree => Tree,
                   Dst_Hint => null,
@@ -173,33 +249,33 @@ 
 
                L_Node := Tree_Operations.Next (L_Node);
 
-            end loop;
+            elsif Is_Less (R_Node, L_Node) then
+               R_Node := Tree_Operations.Next (R_Node);
 
-            return Tree;
-         end if;
+            else
+               L_Node := Tree_Operations.Next (L_Node);
+               R_Node := Tree_Operations.Next (R_Node);
+            end if;
+         end loop;
 
-         if Is_Less (L_Node, R_Node) then
-            Insert_With_Hint
-              (Dst_Tree => Tree,
-               Dst_Hint => null,
-               Src_Node => L_Node,
-               Dst_Node => Dst_Node);
+         BL := BL - 1;
+         LL := LL - 1;
 
-            L_Node := Tree_Operations.Next (L_Node);
+         BR := BR - 1;
+         LR := LR - 1;
 
-         elsif Is_Less (R_Node, L_Node) then
-            R_Node := Tree_Operations.Next (R_Node);
+         return Tree;
+      exception
+         when others =>
+            BL := BL - 1;
+            LL := LL - 1;
 
-         else
-            L_Node := Tree_Operations.Next (L_Node);
-            R_Node := Tree_Operations.Next (R_Node);
-         end if;
-      end loop;
+            BR := BR - 1;
+            LR := LR - 1;
 
-   exception
-      when others =>
-         Delete_Tree (Tree.Root);
-         raise;
+            Delete_Tree (Tree.Root);
+            raise;
+      end;
    end Difference;
 
    ------------------
@@ -210,9 +286,17 @@ 
      (Target : in out Tree_Type;
       Source : Tree_Type)
    is
-      Tgt : Node_Access := Target.First;
-      Src : Node_Access := Source.First;
+      BT : Natural renames Target.Busy;
+      LT : Natural renames Target.Lock;
 
+      BS : Natural renames Source'Unrestricted_Access.Busy;
+      LS : Natural renames Source'Unrestricted_Access.Lock;
+
+      Tgt : Node_Access;
+      Src : Node_Access;
+
+      Compare : Integer;
+
    begin
       if Target'Address = Source'Address then
          return;
@@ -228,10 +312,46 @@ 
          return;
       end if;
 
+      Tgt := Target.First;
+      Src := Source.First;
       while Tgt /= null
         and then Src /= null
       loop
-         if Is_Less (Tgt, Src) then
+         --  Per AI05-0022, the container implementation is required to detect
+         --  element tampering by a generic actual subprogram.
+
+         begin
+            BT := BT + 1;
+            LT := LT + 1;
+
+            BS := BS + 1;
+            LS := LS + 1;
+
+            if Is_Less (Tgt, Src) then
+               Compare := -1;
+            elsif Is_Less (Src, Tgt) then
+               Compare := 1;
+            else
+               Compare := 0;
+            end if;
+
+            BT := BT - 1;
+            LT := LT - 1;
+
+            BS := BS - 1;
+            LS := LS - 1;
+         exception
+            when others =>
+               BT := BT - 1;
+               LT := LT - 1;
+
+               BS := BS - 1;
+               LS := LS - 1;
+
+               raise;
+         end;
+
+         if Compare < 0 then
             declare
                X : Node_Access := Tgt;
             begin
@@ -240,7 +360,7 @@ 
                Free (X);
             end;
 
-         elsif Is_Less (Src, Tgt) then
+         elsif Compare > 0 then
             Src := Tree_Operations.Next (Src);
 
          else
@@ -261,50 +381,83 @@ 
    end Intersection;
 
    function Intersection (Left, Right : Tree_Type) return Tree_Type is
-      Tree : Tree_Type;
-
-      L_Node : Node_Access := Left.First;
-      R_Node : Node_Access := Right.First;
-
-      Dst_Node : Node_Access;
-      pragma Warnings (Off, Dst_Node);
-
    begin
       if Left'Address = Right'Address then
          return Copy (Left);
       end if;
 
-      loop
-         if L_Node = null then
-            return Tree;
-         end if;
+      --  Per AI05-0022, the container implementation is required to detect
+      --  element tampering by a generic actual subprogram.
 
-         if R_Node = null then
-            return Tree;
-         end if;
+      declare
+         BL : Natural renames Left'Unrestricted_Access.Busy;
+         LL : Natural renames Left'Unrestricted_Access.Lock;
 
-         if Is_Less (L_Node, R_Node) then
-            L_Node := Tree_Operations.Next (L_Node);
+         BR : Natural renames Right'Unrestricted_Access.Busy;
+         LR : Natural renames Right'Unrestricted_Access.Lock;
 
-         elsif Is_Less (R_Node, L_Node) then
-            R_Node := Tree_Operations.Next (R_Node);
+         Tree : Tree_Type;
 
-         else
-            Insert_With_Hint
-              (Dst_Tree => Tree,
-               Dst_Hint => null,
-               Src_Node => L_Node,
-               Dst_Node => Dst_Node);
+         L_Node : Node_Access;
+         R_Node : Node_Access;
 
-            L_Node := Tree_Operations.Next (L_Node);
-            R_Node := Tree_Operations.Next (R_Node);
-         end if;
-      end loop;
+         Dst_Node : Node_Access;
+         pragma Warnings (Off, Dst_Node);
 
-   exception
-      when others =>
-         Delete_Tree (Tree.Root);
-         raise;
+      begin
+         BL := BL + 1;
+         LL := LL + 1;
+
+         BR := BR + 1;
+         LR := LR + 1;
+
+         L_Node := Left.First;
+         R_Node := Right.First;
+         loop
+            if L_Node = null then
+               exit;
+            end if;
+
+            if R_Node = null then
+               exit;
+            end if;
+
+            if Is_Less (L_Node, R_Node) then
+               L_Node := Tree_Operations.Next (L_Node);
+
+            elsif Is_Less (R_Node, L_Node) then
+               R_Node := Tree_Operations.Next (R_Node);
+
+            else
+               Insert_With_Hint
+                 (Dst_Tree => Tree,
+                  Dst_Hint => null,
+                  Src_Node => L_Node,
+                  Dst_Node => Dst_Node);
+
+               L_Node := Tree_Operations.Next (L_Node);
+               R_Node := Tree_Operations.Next (R_Node);
+            end if;
+         end loop;
+
+         BL := BL - 1;
+         LL := LL - 1;
+
+         BR := BR - 1;
+         LR := LR - 1;
+
+         return Tree;
+      exception
+         when others =>
+            BL := BL - 1;
+            LL := LL - 1;
+
+            BR := BR - 1;
+            LR := LR - 1;
+
+            Delete_Tree (Tree.Root);
+            raise;
+      end;
    end Intersection;
 
    ---------------
@@ -324,22 +477,44 @@ 
          return False;
       end if;
 
+      --  Per AI05-0022, the container implementation is required to detect
+      --  element tampering by a generic actual subprogram.
+
       declare
-         Subset_Node : Node_Access := Subset.First;
-         Set_Node    : Node_Access := Of_Set.First;
+         BL : Natural renames Subset'Unrestricted_Access.Busy;
+         LL : Natural renames Subset'Unrestricted_Access.Lock;
 
+         BR : Natural renames Of_Set'Unrestricted_Access.Busy;
+         LR : Natural renames Of_Set'Unrestricted_Access.Lock;
+
+         Subset_Node : Node_Access;
+         Set_Node    : Node_Access;
+
+         Result : Boolean;
+
       begin
+         BL := BL + 1;
+         LL := LL + 1;
+
+         BR := BR + 1;
+         LR := LR + 1;
+
+         Subset_Node := Subset.First;
+         Set_Node    := Of_Set.First;
          loop
             if Set_Node = null then
-               return Subset_Node = null;
+               Result := Subset_Node = null;
+               exit;
             end if;
 
             if Subset_Node = null then
-               return True;
+               Result := True;
+               exit;
             end if;
 
             if Is_Less (Subset_Node, Set_Node) then
-               return False;
+               Result := False;
+               exit;
             end if;
 
             if Is_Less (Set_Node, Subset_Node) then
@@ -349,6 +524,23 @@ 
                Subset_Node := Tree_Operations.Next (Subset_Node);
             end if;
          end loop;
+
+         BL := BL - 1;
+         LL := LL - 1;
+
+         BR := BR - 1;
+         LR := LR - 1;
+
+         return Result;
+      exception
+         when others =>
+            BL := BL - 1;
+            LL := LL - 1;
+
+            BR := BR - 1;
+            LR := LR - 1;
+
+            raise;
       end;
    end Is_Subset;
 
@@ -357,31 +549,72 @@ 
    -------------
 
    function Overlap (Left, Right : Tree_Type) return Boolean is
-      L_Node : Node_Access := Left.First;
-      R_Node : Node_Access := Right.First;
-
    begin
       if Left'Address = Right'Address then
          return Left.Length /= 0;
       end if;
 
-      loop
-         if L_Node = null
-           or else R_Node = null
-         then
-            return False;
-         end if;
+      --  Per AI05-0022, the container implementation is required to detect
+      --  element tampering by a generic actual subprogram.
 
-         if Is_Less (L_Node, R_Node) then
-            L_Node := Tree_Operations.Next (L_Node);
+      declare
+         BL : Natural renames Left'Unrestricted_Access.Busy;
+         LL : Natural renames Left'Unrestricted_Access.Lock;
 
-         elsif Is_Less (R_Node, L_Node) then
-            R_Node := Tree_Operations.Next (R_Node);
+         BR : Natural renames Right'Unrestricted_Access.Busy;
+         LR : Natural renames Right'Unrestricted_Access.Lock;
 
-         else
-            return True;
-         end if;
-      end loop;
+         L_Node : Node_Access;
+         R_Node : Node_Access;
+
+         Result : Boolean;
+
+      begin
+         BL := BL + 1;
+         LL := LL + 1;
+
+         BR := BR + 1;
+         LR := LR + 1;
+
+         L_Node := Left.First;
+         R_Node := Right.First;
+         loop
+            if L_Node = null
+              or else R_Node = null
+            then
+               Result := False;
+               exit;
+            end if;
+
+            if Is_Less (L_Node, R_Node) then
+               L_Node := Tree_Operations.Next (L_Node);
+
+            elsif Is_Less (R_Node, L_Node) then
+               R_Node := Tree_Operations.Next (R_Node);
+
+            else
+               Result := True;
+               exit;
+            end if;
+         end loop;
+
+         BL := BL - 1;
+         LL := LL - 1;
+
+         BR := BR - 1;
+         LR := LR - 1;
+
+         return Result;
+      exception
+         when others =>
+            BL := BL - 1;
+            LL := LL - 1;
+
+            BR := BR - 1;
+            LR := LR - 1;
+
+            raise;
+      end;
    end Overlap;
 
    --------------------------
@@ -392,23 +625,28 @@ 
      (Target : in out Tree_Type;
       Source : Tree_Type)
    is
-      Tgt : Node_Access := Target.First;
-      Src : Node_Access := Source.First;
+      BT : Natural renames Target.Busy;
+      LT : Natural renames Target.Lock;
 
+      BS : Natural renames Source'Unrestricted_Access.Busy;
+      LS : Natural renames Source'Unrestricted_Access.Lock;
+
+      Tgt : Node_Access;
+      Src : Node_Access;
+
       New_Tgt_Node : Node_Access;
       pragma Warnings (Off, New_Tgt_Node);
 
+      Compare : Integer;
+
    begin
-      if Target.Busy > 0 then
-         raise Program_Error with
-           "attempt to tamper with cursors (container is busy)";
-      end if;
-
       if Target'Address = Source'Address then
          Clear (Target);
          return;
       end if;
 
+      Tgt := Target.First;
+      Src := Source.First;
       loop
          if Tgt = null then
             while Src /= null loop
@@ -428,10 +666,44 @@ 
             return;
          end if;
 
-         if Is_Less (Tgt, Src) then
+         --  Per AI05-0022, the container implementation is required to detect
+         --  element tampering by a generic actual subprogram.
+
+         begin
+            BT := BT + 1;
+            LT := LT + 1;
+
+            BS := BS + 1;
+            LS := LS + 1;
+
+            if Is_Less (Tgt, Src) then
+               Compare := -1;
+            elsif Is_Less (Src, Tgt) then
+               Compare := 1;
+            else
+               Compare := 0;
+            end if;
+
+            BT := BT - 1;
+            LT := LT - 1;
+
+            BS := BS - 1;
+            LS := LS - 1;
+         exception
+            when others =>
+               BT := BT - 1;
+               LT := LT - 1;
+
+               BS := BS - 1;
+               LS := LS - 1;
+
+               raise;
+         end;
+
+         if Compare < 0 then
             Tgt := Tree_Operations.Next (Tgt);
 
-         elsif Is_Less (Src, Tgt) then
+         elsif Compare > 0 then
             Insert_With_Hint
               (Dst_Tree => Target,
                Dst_Hint => Tgt,
@@ -455,17 +727,9 @@ 
    end Symmetric_Difference;
 
    function Symmetric_Difference (Left, Right : Tree_Type) return Tree_Type is
-      Tree : Tree_Type;
-
-      L_Node : Node_Access := Left.First;
-      R_Node : Node_Access := Right.First;
-
-      Dst_Node : Node_Access;
-      pragma Warnings (Off, Dst_Node);
-
    begin
       if Left'Address = Right'Address then
-         return Tree;  -- Empty set
+         return Tree_Type'(others => <>);  -- Empty set
       end if;
 
       if Right.Length = 0 then
@@ -476,70 +740,110 @@ 
          return Copy (Right);
       end if;
 
-      loop
-         if L_Node = null then
-            while R_Node /= null loop
+      --  Per AI05-0022, the container implementation is required to detect
+      --  element tampering by a generic actual subprogram.
+
+      declare
+         BL : Natural renames Left'Unrestricted_Access.Busy;
+         LL : Natural renames Left'Unrestricted_Access.Lock;
+
+         BR : Natural renames Right'Unrestricted_Access.Busy;
+         LR : Natural renames Right'Unrestricted_Access.Lock;
+
+         Tree : Tree_Type;
+
+         L_Node : Node_Access;
+         R_Node : Node_Access;
+
+         Dst_Node : Node_Access;
+         pragma Warnings (Off, Dst_Node);
+
+      begin
+         BL := BL + 1;
+         LL := LL + 1;
+
+         BR := BR + 1;
+         LR := LR + 1;
+
+         L_Node := Left.First;
+         R_Node := Right.First;
+         loop
+            if L_Node = null then
+               while R_Node /= null loop
+                  Insert_With_Hint
+                    (Dst_Tree => Tree,
+                     Dst_Hint => null,
+                     Src_Node => R_Node,
+                     Dst_Node => Dst_Node);
+                  R_Node := Tree_Operations.Next (R_Node);
+               end loop;
+
+               exit;
+            end if;
+
+            if R_Node = null then
+               while L_Node /= null loop
+                  Insert_With_Hint
+                    (Dst_Tree => Tree,
+                     Dst_Hint => null,
+                     Src_Node => L_Node,
+                     Dst_Node => Dst_Node);
+
+                  L_Node := Tree_Operations.Next (L_Node);
+               end loop;
+
+               exit;
+            end if;
+
+            if Is_Less (L_Node, R_Node) then
                Insert_With_Hint
                  (Dst_Tree => Tree,
                   Dst_Hint => null,
-                  Src_Node => R_Node,
+                  Src_Node => L_Node,
                   Dst_Node => Dst_Node);
-               R_Node := Tree_Operations.Next (R_Node);
-            end loop;
 
-            return Tree;
-         end if;
+               L_Node := Tree_Operations.Next (L_Node);
 
-         if R_Node = null then
-            while L_Node /= null loop
+            elsif Is_Less (R_Node, L_Node) then
                Insert_With_Hint
                  (Dst_Tree => Tree,
                   Dst_Hint => null,
-                  Src_Node => L_Node,
+                  Src_Node => R_Node,
                   Dst_Node => Dst_Node);
 
+               R_Node := Tree_Operations.Next (R_Node);
+
+            else
                L_Node := Tree_Operations.Next (L_Node);
-            end loop;
+               R_Node := Tree_Operations.Next (R_Node);
+            end if;
+         end loop;
 
-            return Tree;
-         end if;
+         BL := BL - 1;
+         LL := LL - 1;
 
-         if Is_Less (L_Node, R_Node) then
-            Insert_With_Hint
-              (Dst_Tree => Tree,
-               Dst_Hint => null,
-               Src_Node => L_Node,
-               Dst_Node => Dst_Node);
+         BR := BR - 1;
+         LR := LR - 1;
 
-            L_Node := Tree_Operations.Next (L_Node);
+         return Tree;
+      exception
+         when others =>
+            BL := BL - 1;
+            LL := LL - 1;
 
-         elsif Is_Less (R_Node, L_Node) then
-            Insert_With_Hint
-              (Dst_Tree => Tree,
-               Dst_Hint => null,
-               Src_Node => R_Node,
-               Dst_Node => Dst_Node);
+            BR := BR - 1;
+            LR := LR - 1;
 
-            R_Node := Tree_Operations.Next (R_Node);
-
-         else
-            L_Node := Tree_Operations.Next (L_Node);
-            R_Node := Tree_Operations.Next (R_Node);
-         end if;
-      end loop;
-
-   exception
-      when others =>
-         Delete_Tree (Tree.Root);
-         raise;
+            Delete_Tree (Tree.Root);
+            raise;
+      end;
    end Symmetric_Difference;
 
    -----------
    -- Union --
    -----------
 
-   procedure Union (Target : in out Tree_Type; Source : Tree_Type)
-   is
+   procedure Union (Target : in out Tree_Type; Source : Tree_Type) is
       Hint : Node_Access;
 
       procedure Process (Node : Node_Access);
@@ -555,7 +859,7 @@ 
       begin
          Insert_With_Hint
            (Dst_Tree => Target,
-            Dst_Hint => Hint,
+            Dst_Hint => Hint,  -- use node most recently inserted as hint
             Src_Node => Node,
             Dst_Node => Hint);
       end Process;
@@ -567,12 +871,28 @@ 
          return;
       end if;
 
-      if Target.Busy > 0 then
-         raise Program_Error with
-           "attempt to tamper with cursors (container is busy)";
-      end if;
+      --  Per AI05-0022, the container implementation is required to detect
+      --  element tampering by a generic actual subprogram.
 
-      Iterate (Source);
+      declare
+         BS : Natural renames Source'Unrestricted_Access.Busy;
+         LS : Natural renames Source'Unrestricted_Access.Lock;
+
+      begin
+         BS := BS + 1;
+         LS := LS + 1;
+
+         Iterate (Source);
+
+         BS := BS - 1;
+         LS := LS - 1;
+      exception
+         when others =>
+            BS := BS - 1;
+            LS := LS - 1;
+
+            raise;
+      end;
    end Union;
 
    function Union (Left, Right : Tree_Type) return Tree_Type is
@@ -590,6 +910,12 @@ 
       end if;
 
       declare
+         BL : Natural renames Left'Unrestricted_Access.Busy;
+         LL : Natural renames Left'Unrestricted_Access.Lock;
+
+         BR : Natural renames Right'Unrestricted_Access.Busy;
+         LR : Natural renames Right'Unrestricted_Access.Lock;
+
          Tree : Tree_Type := Copy (Left);
 
          Hint : Node_Access;
@@ -608,7 +934,7 @@ 
          begin
             Insert_With_Hint
               (Dst_Tree => Tree,
-               Dst_Hint => Hint,
+               Dst_Hint => Hint,  -- use node most recently inserted as hint
                Src_Node => Node,
                Dst_Node => Hint);
          end Process;
@@ -616,15 +942,32 @@ 
       --  Start of processing for Union
 
       begin
+         BL := BL + 1;
+         LL := LL + 1;
+
+         BR := BR + 1;
+         LR := LR + 1;
+
          Iterate (Right);
+
+         BL := BL - 1;
+         LL := LL - 1;
+
+         BR := BR - 1;
+         LR := LR - 1;
+
          return Tree;
-
       exception
          when others =>
+            BL := BL - 1;
+            LL := LL - 1;
+
+            BR := BR - 1;
+            LR := LR - 1;
+
             Delete_Tree (Tree.Root);
             raise;
       end;
-
    end Union;
 
 end Ada.Containers.Red_Black_Trees.Generic_Set_Operations;
Index: a-btgbso.adb
===================================================================
--- a-btgbso.adb	(revision 197743)
+++ a-btgbso.adb	(working copy)
@@ -6,7 +6,7 @@ 
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 2004-2011, Free Software Foundation, Inc.         --
+--          Copyright (C) 2004-2013, 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- --
@@ -53,11 +53,19 @@ 
    ----------------
 
    procedure Set_Difference (Target : in out Set_Type; Source : Set_Type) is
+      BT : Natural renames Target.Busy;
+      LT : Natural renames Target.Lock;
+
+      BS : Natural renames Source'Unrestricted_Access.Busy;
+      LS : Natural renames Source'Unrestricted_Access.Lock;
+
       Tgt, Src : Count_Type;
 
       TN : Nodes_Type renames Target.Nodes;
       SN : Nodes_Type renames Source.Nodes;
 
+      Compare : Integer;
+
    begin
       if Target'Address = Source'Address then
          if Target.Busy > 0 then
@@ -82,17 +90,51 @@ 
       Src := Source.First;
       loop
          if Tgt = 0 then
-            return;
+            exit;
          end if;
 
          if Src = 0 then
-            return;
+            exit;
          end if;
 
-         if Is_Less (TN (Tgt), SN (Src)) then
+         --  Per AI05-0022, the container implementation is required to detect
+         --  element tampering by a generic actual subprogram.
+
+         begin
+            BT := BT + 1;
+            LT := LT + 1;
+
+            BS := BS + 1;
+            LS := LS + 1;
+
+            if Is_Less (TN (Tgt), SN (Src)) then
+               Compare := -1;
+            elsif Is_Less (SN (Src), TN (Tgt)) then
+               Compare := 1;
+            else
+               Compare := 0;
+            end if;
+
+            BT := BT - 1;
+            LT := LT - 1;
+
+            BS := BS - 1;
+            LS := LS - 1;
+         exception
+            when others =>
+               BT := BT - 1;
+               LT := LT - 1;
+
+               BS := BS - 1;
+               LS := LS - 1;
+
+               raise;
+         end;
+
+         if Compare < 0 then
             Tgt := Tree_Operations.Next (Target, Tgt);
 
-         elsif Is_Less (SN (Src), TN (Tgt)) then
+         elsif Compare > 0 then
             Src := Tree_Operations.Next (Source, Src);
 
          else
@@ -111,12 +153,6 @@ 
    end Set_Difference;
 
    function Set_Difference (Left, Right : Set_Type) return Set_Type is
-      L_Node : Count_Type;
-      R_Node : Count_Type;
-
-      Dst_Node : Count_Type;
-      pragma Warnings (Off, Dst_Node);
-
    begin
       if Left'Address = Right'Address then
          return S : Set_Type (0);  -- Empty set
@@ -131,15 +167,51 @@ 
       end if;
 
       return Result : Set_Type (Left.Length) do
-         L_Node := Left.First;
-         R_Node := Right.First;
-         loop
-            if L_Node = 0 then
-               return;
-            end if;
+         --  Per AI05-0022, the container implementation is required to detect
+         --  element tampering by a generic actual subprogram.
 
-            if R_Node = 0 then
-               while L_Node /= 0 loop
+         declare
+            BL : Natural renames Left'Unrestricted_Access.Busy;
+            LL : Natural renames Left'Unrestricted_Access.Lock;
+
+            BR : Natural renames Right'Unrestricted_Access.Busy;
+            LR : Natural renames Right'Unrestricted_Access.Lock;
+
+            L_Node : Count_Type;
+            R_Node : Count_Type;
+
+            Dst_Node : Count_Type;
+            pragma Warnings (Off, Dst_Node);
+
+         begin
+            BL := BL + 1;
+            LL := LL + 1;
+
+            BR := BR + 1;
+            LR := LR + 1;
+
+            L_Node := Left.First;
+            R_Node := Right.First;
+            loop
+               if L_Node = 0 then
+                  exit;
+               end if;
+
+               if R_Node = 0 then
+                  while L_Node /= 0 loop
+                     Insert_With_Hint
+                       (Dst_Set  => Result,
+                        Dst_Hint => 0,
+                        Src_Node => Left.Nodes (L_Node),
+                        Dst_Node => Dst_Node);
+
+                     L_Node := Tree_Operations.Next (Left, L_Node);
+                  end loop;
+
+                  exit;
+               end if;
+
+               if Is_Less (Left.Nodes (L_Node), Right.Nodes (R_Node)) then
                   Insert_With_Hint
                     (Dst_Set  => Result,
                      Dst_Hint => 0,
@@ -147,28 +219,31 @@ 
                      Dst_Node => Dst_Node);
 
                   L_Node := Tree_Operations.Next (Left, L_Node);
-               end loop;
 
-               return;
-            end if;
+               elsif Is_Less (Right.Nodes (R_Node), Left.Nodes (L_Node)) then
+                  R_Node := Tree_Operations.Next (Right, R_Node);
 
-            if Is_Less (Left.Nodes (L_Node), Right.Nodes (R_Node)) then
-               Insert_With_Hint
-                 (Dst_Set  => Result,
-                  Dst_Hint => 0,
-                  Src_Node => Left.Nodes (L_Node),
-                  Dst_Node => Dst_Node);
+               else
+                  L_Node := Tree_Operations.Next (Left, L_Node);
+                  R_Node := Tree_Operations.Next (Right, R_Node);
+               end if;
+            end loop;
 
-               L_Node := Tree_Operations.Next (Left, L_Node);
+            BL := BL - 1;
+            LL := LL - 1;
 
-            elsif Is_Less (Right.Nodes (R_Node), Left.Nodes (L_Node)) then
-               R_Node := Tree_Operations.Next (Right, R_Node);
+            BR := BR - 1;
+            LR := LR - 1;
+         exception
+            when others =>
+               BL := BL - 1;
+               LL := LL - 1;
 
-            else
-               L_Node := Tree_Operations.Next (Left, L_Node);
-               R_Node := Tree_Operations.Next (Right, R_Node);
-            end if;
-         end loop;
+               BR := BR - 1;
+               LR := LR - 1;
+
+               raise;
+         end;
       end return;
    end Set_Difference;
 
@@ -180,9 +255,17 @@ 
      (Target : in out Set_Type;
       Source : Set_Type)
    is
+      BT : Natural renames Target.Busy;
+      LT : Natural renames Target.Lock;
+
+      BS : Natural renames Source'Unrestricted_Access.Busy;
+      LS : Natural renames Source'Unrestricted_Access.Lock;
+
       Tgt : Count_Type;
       Src : Count_Type;
 
+      Compare : Integer;
+
    begin
       if Target'Address = Source'Address then
          return;
@@ -203,7 +286,41 @@ 
       while Tgt /= 0
         and then Src /= 0
       loop
-         if Is_Less (Target.Nodes (Tgt), Source.Nodes (Src)) then
+         --  Per AI05-0022, the container implementation is required to detect
+         --  element tampering by a generic actual subprogram.
+
+         begin
+            BT := BT + 1;
+            LT := LT + 1;
+
+            BS := BS + 1;
+            LS := LS + 1;
+
+            if Is_Less (Target.Nodes (Tgt), Source.Nodes (Src)) then
+               Compare := -1;
+            elsif Is_Less (Source.Nodes (Src), Target.Nodes (Tgt)) then
+               Compare := 1;
+            else
+               Compare := 0;
+            end if;
+
+            BT := BT - 1;
+            LT := LT - 1;
+
+            BS := BS - 1;
+            LS := LS - 1;
+         exception
+            when others =>
+               BT := BT - 1;
+               LT := LT - 1;
+
+               BS := BS - 1;
+               LS := LS - 1;
+
+               raise;
+         end;
+
+         if Compare < 0 then
             declare
                X : constant Count_Type := Tgt;
             begin
@@ -213,7 +330,7 @@ 
                Tree_Operations.Free (Target, X);
             end;
 
-         elsif Is_Less (Source.Nodes (Src), Target.Nodes (Tgt)) then
+         elsif Compare > 0 then
             Src := Tree_Operations.Next (Source, Src);
 
          else
@@ -235,46 +352,80 @@ 
    end Set_Intersection;
 
    function Set_Intersection (Left, Right : Set_Type) return Set_Type is
-      L_Node : Count_Type;
-      R_Node : Count_Type;
-
-      Dst_Node : Count_Type;
-      pragma Warnings (Off, Dst_Node);
-
    begin
       if Left'Address = Right'Address then
          return Copy (Left);
       end if;
 
       return Result : Set_Type (Count_Type'Min (Left.Length, Right.Length)) do
-         L_Node := Left.First;
-         R_Node := Right.First;
-         loop
-            if L_Node = 0 then
-               return;
-            end if;
 
-            if R_Node = 0 then
-               return;
-            end if;
+         --  Per AI05-0022, the container implementation is required to detect
+         --  element tampering by a generic actual subprogram.
 
-            if Is_Less (Left.Nodes (L_Node), Right.Nodes (R_Node)) then
-               L_Node := Tree_Operations.Next (Left, L_Node);
+         declare
+            BL : Natural renames Left'Unrestricted_Access.Busy;
+            LL : Natural renames Left'Unrestricted_Access.Lock;
 
-            elsif Is_Less (Right.Nodes (R_Node), Left.Nodes (L_Node)) then
-               R_Node := Tree_Operations.Next (Right, R_Node);
+            BR : Natural renames Right'Unrestricted_Access.Busy;
+            LR : Natural renames Right'Unrestricted_Access.Lock;
 
-            else
-               Insert_With_Hint
-                 (Dst_Set  => Result,
-                  Dst_Hint => 0,
-                  Src_Node => Left.Nodes (L_Node),
-                  Dst_Node => Dst_Node);
+            L_Node : Count_Type;
+            R_Node : Count_Type;
 
-               L_Node := Tree_Operations.Next (Left, L_Node);
-               R_Node := Tree_Operations.Next (Right, R_Node);
-            end if;
-         end loop;
+            Dst_Node : Count_Type;
+            pragma Warnings (Off, Dst_Node);
+
+         begin
+            BL := BL + 1;
+            LL := LL + 1;
+
+            BR := BR + 1;
+            LR := LR + 1;
+
+            L_Node := Left.First;
+            R_Node := Right.First;
+            loop
+               if L_Node = 0 then
+                  exit;
+               end if;
+
+               if R_Node = 0 then
+                  exit;
+               end if;
+
+               if Is_Less (Left.Nodes (L_Node), Right.Nodes (R_Node)) then
+                  L_Node := Tree_Operations.Next (Left, L_Node);
+
+               elsif Is_Less (Right.Nodes (R_Node), Left.Nodes (L_Node)) then
+                  R_Node := Tree_Operations.Next (Right, R_Node);
+
+               else
+                  Insert_With_Hint
+                    (Dst_Set  => Result,
+                     Dst_Hint => 0,
+                     Src_Node => Left.Nodes (L_Node),
+                     Dst_Node => Dst_Node);
+
+                  L_Node := Tree_Operations.Next (Left, L_Node);
+                  R_Node := Tree_Operations.Next (Right, R_Node);
+               end if;
+            end loop;
+
+            BL := BL - 1;
+            LL := LL - 1;
+
+            BR := BR - 1;
+            LR := LR - 1;
+         exception
+            when others =>
+               BL := BL - 1;
+               LL := LL - 1;
+
+               BR := BR - 1;
+               LR := LR - 1;
+
+               raise;
+         end;
       end return;
    end Set_Intersection;
 
@@ -286,9 +437,6 @@ 
      (Subset : Set_Type;
       Of_Set : Set_Type) return Boolean
    is
-      Subset_Node : Count_Type;
-      Set_Node    : Count_Type;
-
    begin
       if Subset'Address = Of_Set'Address then
          return True;
@@ -298,28 +446,75 @@ 
          return False;
       end if;
 
-      Subset_Node := Subset.First;
-      Set_Node    := Of_Set.First;
-      loop
-         if Set_Node = 0 then
-            return Subset_Node = 0;
-         end if;
+      --  Per AI05-0022, the container implementation is required to detect
+      --  element tampering by a generic actual subprogram.
 
-         if Subset_Node = 0 then
-            return True;
-         end if;
+      declare
+         BL : Natural renames Subset'Unrestricted_Access.Busy;
+         LL : Natural renames Subset'Unrestricted_Access.Lock;
 
-         if Is_Less (Subset.Nodes (Subset_Node), Of_Set.Nodes (Set_Node)) then
-            return False;
-         end if;
+         BR : Natural renames Of_Set'Unrestricted_Access.Busy;
+         LR : Natural renames Of_Set'Unrestricted_Access.Lock;
 
-         if Is_Less (Of_Set.Nodes (Set_Node), Subset.Nodes (Subset_Node)) then
-            Set_Node := Tree_Operations.Next (Of_Set, Set_Node);
-         else
-            Set_Node := Tree_Operations.Next (Of_Set, Set_Node);
-            Subset_Node := Tree_Operations.Next (Subset, Subset_Node);
-         end if;
-      end loop;
+         Subset_Node : Count_Type;
+         Set_Node    : Count_Type;
+
+         Result : Boolean;
+
+      begin
+         BL := BL + 1;
+         LL := LL + 1;
+
+         BR := BR + 1;
+         LR := LR + 1;
+
+         Subset_Node := Subset.First;
+         Set_Node    := Of_Set.First;
+         loop
+            if Set_Node = 0 then
+               Result := Subset_Node = 0;
+               exit;
+            end if;
+
+            if Subset_Node = 0 then
+               Result := True;
+               exit;
+            end if;
+
+            if Is_Less (Subset.Nodes (Subset_Node),
+                        Of_Set.Nodes (Set_Node))
+            then
+               Result := False;
+               exit;
+            end if;
+
+            if Is_Less (Of_Set.Nodes (Set_Node),
+                        Subset.Nodes (Subset_Node))
+            then
+               Set_Node := Tree_Operations.Next (Of_Set, Set_Node);
+            else
+               Set_Node := Tree_Operations.Next (Of_Set, Set_Node);
+               Subset_Node := Tree_Operations.Next (Subset, Subset_Node);
+            end if;
+         end loop;
+
+         BL := BL - 1;
+         LL := LL - 1;
+
+         BR := BR - 1;
+         LR := LR - 1;
+
+         return Result;
+      exception
+         when others =>
+            BL := BL - 1;
+            LL := LL - 1;
+
+            BR := BR - 1;
+            LR := LR - 1;
+
+            raise;
+      end;
    end Set_Subset;
 
    -------------
@@ -327,33 +522,72 @@ 
    -------------
 
    function Set_Overlap (Left, Right : Set_Type) return Boolean is
-      L_Node : Count_Type;
-      R_Node : Count_Type;
-
    begin
       if Left'Address = Right'Address then
          return Left.Length /= 0;
       end if;
 
-      L_Node := Left.First;
-      R_Node := Right.First;
-      loop
-         if L_Node = 0
-           or else R_Node = 0
-         then
-            return False;
-         end if;
+      --  Per AI05-0022, the container implementation is required to detect
+      --  element tampering by a generic actual subprogram.
 
-         if Is_Less (Left.Nodes (L_Node), Right.Nodes (R_Node)) then
-            L_Node := Tree_Operations.Next (Left, L_Node);
+      declare
+         BL : Natural renames Left'Unrestricted_Access.Busy;
+         LL : Natural renames Left'Unrestricted_Access.Lock;
 
-         elsif Is_Less (Right.Nodes (R_Node), Left.Nodes (L_Node)) then
-            R_Node := Tree_Operations.Next (Right, R_Node);
+         BR : Natural renames Right'Unrestricted_Access.Busy;
+         LR : Natural renames Right'Unrestricted_Access.Lock;
 
-         else
-            return True;
-         end if;
-      end loop;
+         L_Node : Count_Type;
+         R_Node : Count_Type;
+
+         Result : Boolean;
+
+      begin
+         BL := BL + 1;
+         LL := LL + 1;
+
+         BR := BR + 1;
+         LR := LR + 1;
+
+         L_Node := Left.First;
+         R_Node := Right.First;
+         loop
+            if L_Node = 0
+              or else R_Node = 0
+            then
+               Result := False;
+               exit;
+            end if;
+
+            if Is_Less (Left.Nodes (L_Node), Right.Nodes (R_Node)) then
+               L_Node := Tree_Operations.Next (Left, L_Node);
+
+            elsif Is_Less (Right.Nodes (R_Node), Left.Nodes (L_Node)) then
+               R_Node := Tree_Operations.Next (Right, R_Node);
+
+            else
+               Result := True;
+               exit;
+            end if;
+         end loop;
+
+         BL := BL - 1;
+         LL := LL - 1;
+
+         BR := BR - 1;
+         LR := LR - 1;
+
+         return Result;
+      exception
+         when others =>
+            BL := BL - 1;
+            LL := LL - 1;
+
+            BR := BR - 1;
+            LR := LR - 1;
+
+            raise;
+      end;
    end Set_Overlap;
 
    --------------------------
@@ -364,18 +598,21 @@ 
      (Target : in out Set_Type;
       Source : Set_Type)
    is
+      BT : Natural renames Target.Busy;
+      LT : Natural renames Target.Lock;
+
+      BS : Natural renames Source'Unrestricted_Access.Busy;
+      LS : Natural renames Source'Unrestricted_Access.Lock;
+
       Tgt : Count_Type;
       Src : Count_Type;
 
       New_Tgt_Node : Count_Type;
       pragma Warnings (Off, New_Tgt_Node);
 
+      Compare : Integer;
+
    begin
-      if Target.Busy > 0 then
-         raise Program_Error with
-           "attempt to tamper with cursors (container is busy)";
-      end if;
-
       if Target'Address = Source'Address then
          Tree_Operations.Clear_Tree (Target);
          return;
@@ -402,10 +639,44 @@ 
             return;
          end if;
 
-         if Is_Less (Target.Nodes (Tgt), Source.Nodes (Src)) then
+         --  Per AI05-0022, the container implementation is required to detect
+         --  element tampering by a generic actual subprogram.
+
+         begin
+            BT := BT + 1;
+            LT := LT + 1;
+
+            BS := BS + 1;
+            LS := LS + 1;
+
+            if Is_Less (Target.Nodes (Tgt), Source.Nodes (Src)) then
+               Compare := -1;
+            elsif Is_Less (Source.Nodes (Src), Target.Nodes (Tgt)) then
+               Compare := 1;
+            else
+               Compare := 0;
+            end if;
+
+            BT := BT - 1;
+            LT := LT - 1;
+
+            BS := BS - 1;
+            LS := LS - 1;
+         exception
+            when others =>
+               BT := BT - 1;
+               LT := LT - 1;
+
+               BS := BS - 1;
+               LS := LS - 1;
+
+               raise;
+         end;
+
+         if Compare < 0 then
             Tgt := Tree_Operations.Next (Target, Tgt);
 
-         elsif Is_Less (Source.Nodes (Src), Target.Nodes (Tgt)) then
+         elsif Compare > 0 then
             Insert_With_Hint
               (Dst_Set  => Target,
                Dst_Hint => Tgt,
@@ -432,12 +703,6 @@ 
    function Set_Symmetric_Difference
      (Left, Right : Set_Type) return Set_Type
    is
-      L_Node : Count_Type;
-      R_Node : Count_Type;
-
-      Dst_Node : Count_Type;
-      pragma Warnings (Off, Dst_Node);
-
    begin
       if Left'Address = Right'Address then
          return S : Set_Type (0);  -- Empty set
@@ -452,60 +717,100 @@ 
       end if;
 
       return Result : Set_Type (Left.Length + Right.Length) do
-         L_Node := Left.First;
-         R_Node := Right.First;
-         loop
-            if L_Node = 0 then
-               while R_Node /= 0 loop
+
+         --  Per AI05-0022, the container implementation is required to detect
+         --  element tampering by a generic actual subprogram.
+
+         declare
+            BL : Natural renames Left'Unrestricted_Access.Busy;
+            LL : Natural renames Left'Unrestricted_Access.Lock;
+
+            BR : Natural renames Right'Unrestricted_Access.Busy;
+            LR : Natural renames Right'Unrestricted_Access.Lock;
+
+            L_Node : Count_Type;
+            R_Node : Count_Type;
+
+            Dst_Node : Count_Type;
+            pragma Warnings (Off, Dst_Node);
+
+         begin
+            BL := BL + 1;
+            LL := LL + 1;
+
+            BR := BR + 1;
+            LR := LR + 1;
+
+            L_Node := Left.First;
+            R_Node := Right.First;
+            loop
+               if L_Node = 0 then
+                  while R_Node /= 0 loop
+                     Insert_With_Hint
+                       (Dst_Set  => Result,
+                        Dst_Hint => 0,
+                        Src_Node => Right.Nodes (R_Node),
+                        Dst_Node => Dst_Node);
+
+                     R_Node := Tree_Operations.Next (Right, R_Node);
+                  end loop;
+
+                  exit;
+               end if;
+
+               if R_Node = 0 then
+                  while L_Node /= 0 loop
+                     Insert_With_Hint
+                       (Dst_Set  => Result,
+                        Dst_Hint => 0,
+                        Src_Node => Left.Nodes (L_Node),
+                        Dst_Node => Dst_Node);
+
+                     L_Node := Tree_Operations.Next (Left, L_Node);
+                  end loop;
+
+                  exit;
+               end if;
+
+               if Is_Less (Left.Nodes (L_Node), Right.Nodes (R_Node)) then
                   Insert_With_Hint
                     (Dst_Set  => Result,
                      Dst_Hint => 0,
-                     Src_Node => Right.Nodes (R_Node),
+                     Src_Node => Left.Nodes (L_Node),
                      Dst_Node => Dst_Node);
 
-                  R_Node := Tree_Operations.Next (Right, R_Node);
-               end loop;
+                  L_Node := Tree_Operations.Next (Left, L_Node);
 
-               return;
-            end if;
-
-            if R_Node = 0 then
-               while L_Node /= 0 loop
+               elsif Is_Less (Right.Nodes (R_Node), Left.Nodes (L_Node)) then
                   Insert_With_Hint
                     (Dst_Set  => Result,
                      Dst_Hint => 0,
-                     Src_Node => Left.Nodes (L_Node),
+                     Src_Node => Right.Nodes (R_Node),
                      Dst_Node => Dst_Node);
 
+                  R_Node := Tree_Operations.Next (Right, R_Node);
+
+               else
                   L_Node := Tree_Operations.Next (Left, L_Node);
-               end loop;
+                  R_Node := Tree_Operations.Next (Right, R_Node);
+               end if;
+            end loop;
 
-               return;
-            end if;
+            BL := BL - 1;
+            LL := LL - 1;
 
-            if Is_Less (Left.Nodes (L_Node), Right.Nodes (R_Node)) then
-               Insert_With_Hint
-                 (Dst_Set  => Result,
-                  Dst_Hint => 0,
-                  Src_Node => Left.Nodes (L_Node),
-                  Dst_Node => Dst_Node);
+            BR := BR - 1;
+            LR := LR - 1;
+         exception
+            when others =>
+               BL := BL - 1;
+               LL := LL - 1;
 
-               L_Node := Tree_Operations.Next (Left, L_Node);
+               BR := BR - 1;
+               LR := LR - 1;
 
-            elsif Is_Less (Right.Nodes (R_Node), Left.Nodes (L_Node)) then
-               Insert_With_Hint
-                 (Dst_Set  => Result,
-                  Dst_Hint => 0,
-                  Src_Node => Right.Nodes (R_Node),
-                  Dst_Node => Dst_Node);
-
-               R_Node := Tree_Operations.Next (Right, R_Node);
-
-            else
-               L_Node := Tree_Operations.Next (Left, L_Node);
-               R_Node := Tree_Operations.Next (Right, R_Node);
-            end if;
-         end loop;
+               raise;
+         end;
       end return;
    end Set_Symmetric_Difference;
 
@@ -541,17 +846,34 @@ 
          return;
       end if;
 
-      if Target.Busy > 0 then
-         raise Program_Error with
-           "attempt to tamper with cursors (container is busy)";
-      end if;
+      --  Per AI05-0022, the container implementation is required to detect
+      --  element tampering by a generic actual subprogram.
 
-      --  Note that there's no way to decide a priori whether the target has
-      --  enough capacity for the union with source. We cannot simply compare
-      --  the sum of the existing lengths to the capacity of the target,
-      --  because equivalent items from source are not included in the union.
+      declare
+         BS : Natural renames Source'Unrestricted_Access.Busy;
+         LS : Natural renames Source'Unrestricted_Access.Lock;
 
-      Iterate (Source);
+      begin
+         BS := BS + 1;
+         LS := LS + 1;
+
+         --  Note that there's no way to decide a priori whether the target has
+         --  enough capacity for the union with source. We cannot simply
+         --  compare the sum of the existing lengths to the capacity of the
+         --  target, because equivalent items from source are not included in
+         --  the union.
+
+         Iterate (Source);
+
+         BS := BS - 1;
+         LS := LS - 1;
+      exception
+         when others =>
+            BS := BS - 1;
+            LS := LS - 1;
+
+            raise;
+      end;
    end Set_Union;
 
    function Set_Union (Left, Right : Set_Type) return Set_Type is
@@ -569,35 +891,65 @@ 
       end if;
 
       return Result : Set_Type (Left.Length + Right.Length) do
-         Assign (Target => Result, Source => Left);
+         declare
+            BL : Natural renames Left'Unrestricted_Access.Busy;
+            LL : Natural renames Left'Unrestricted_Access.Lock;
 
-         Insert_Right : declare
-            Hint : Count_Type := 0;
+            BR : Natural renames Right'Unrestricted_Access.Busy;
+            LR : Natural renames Right'Unrestricted_Access.Lock;
 
-            procedure Process (Node : Count_Type);
-            pragma Inline (Process);
+         begin
+            BL := BL + 1;
+            LL := LL + 1;
 
-            procedure Iterate is
-              new Tree_Operations.Generic_Iteration (Process);
+            BR := BR + 1;
+            LR := LR + 1;
 
-            -------------
-            -- Process --
-            -------------
+            Assign (Target => Result, Source => Left);
 
-            procedure Process (Node : Count_Type) is
+            Insert_Right : declare
+               Hint : Count_Type := 0;
+
+               procedure Process (Node : Count_Type);
+               pragma Inline (Process);
+
+               procedure Iterate is
+                 new Tree_Operations.Generic_Iteration (Process);
+
+               -------------
+               -- Process --
+               -------------
+
+               procedure Process (Node : Count_Type) is
+               begin
+                  Insert_With_Hint
+                    (Dst_Set  => Result,
+                     Dst_Hint => Hint,
+                     Src_Node => Right.Nodes (Node),
+                     Dst_Node => Hint);
+               end Process;
+
+            --  Start of processing for Insert_Right
+
             begin
-               Insert_With_Hint
-                 (Dst_Set  => Result,
-                  Dst_Hint => Hint,
-                  Src_Node => Right.Nodes (Node),
-                  Dst_Node => Hint);
-            end Process;
+               Iterate (Right);
+            end Insert_Right;
 
-         --  Start of processing for Insert_Right
+            BL := BL - 1;
+            LL := LL - 1;
 
-         begin
-            Iterate (Right);
-         end Insert_Right;
+            BR := BR - 1;
+            LR := LR - 1;
+         exception
+            when others =>
+               BL := BL - 1;
+               LL := LL - 1;
+
+               BR := BR - 1;
+               LR := LR - 1;
+
+               raise;
+         end;
       end return;
    end Set_Union;