diff options
Diffstat (limited to 'gcc/ada/a-crbtgk.adb')
| -rw-r--r-- | gcc/ada/a-crbtgk.adb | 280 |
1 files changed, 228 insertions, 52 deletions
diff --git a/gcc/ada/a-crbtgk.adb b/gcc/ada/a-crbtgk.adb index 713e542..0e27e0a 100644 --- a/gcc/ada/a-crbtgk.adb +++ b/gcc/ada/a-crbtgk.adb @@ -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 @@ package body Ada.Containers.Red_Black_Trees.Generic_Keys is -- 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 @@ package body Ada.Containers.Red_Black_Trees.Generic_Keys is 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 @@ package body Ada.Containers.Red_Black_Trees.Generic_Keys is end loop; if Y = null then - return null; - end if; + Result := null; + + elsif Is_Less_Key_Node (Key, Y) then + Result := null; - if Is_Less_Key_Node (Key, Y) then - return 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 @@ package body Ada.Containers.Red_Black_Trees.Generic_Keys is 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,8 +172,16 @@ package body Ada.Containers.Red_Black_Trees.Generic_Keys is 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 @@ -136,12 +199,27 @@ package body Ada.Containers.Red_Black_Trees.Generic_Keys is -- 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 @@ -172,7 +250,22 @@ package body Ada.Containers.Red_Black_Trees.Generic_Keys is -- 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 @@ -201,6 +294,15 @@ package body Ada.Containers.Red_Black_Trees.Generic_Keys is 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 @@ package body Ada.Containers.Red_Black_Trees.Generic_Keys is -- 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,28 +362,58 @@ package body Ada.Containers.Red_Black_Trees.Generic_Keys is -- 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; - begin - if Before = null then - Insert_Post (Tree, Tree.First, True, Node); - Inserted := True; + if Compare then + Test := Ops.Previous (Position); -- "before" - 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; + if Test = null then -- new first node + Insert_Post (Tree, Tree.First, True, Node); - Inserted := True; + Inserted := True; + return; + end if; + begin + B := B + 1; + L := L + 1; + + Compare := Is_Greater_Key_Node (Key, Test); + + 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,28 +424,58 @@ package body Ada.Containers.Red_Black_Trees.Generic_Keys is -- 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; - begin - if After = null then - Insert_Post (Tree, Tree.Last, False, Node); - Inserted := True; + if Compare then + Test := Ops.Next (Position); -- "after" - 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; + if Test = null then -- new last node + Insert_Post (Tree, Tree.Last, False, Node); - Inserted := True; + Inserted := True; + return; + end if; + begin + B := B + 1; + L := L + 1; + + Compare := Is_Less_Key_Node (Key, Test); + + 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; |