1 ------------------------------------------------------------------------------
3 -- GNAT LIBRARY COMPONENTS --
5 -- ADA.CONTAINERS.RED_BLACK_TREES.GENERIC_OPERATIONS --
9 -- Copyright (C) 2004-2013, Free Software Foundation, Inc. --
11 -- GNAT is free software; you can redistribute it and/or modify it under --
12 -- terms of the GNU General Public License as published by the Free Soft- --
13 -- ware Foundation; either version 3, or (at your option) any later ver- --
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
16 -- or FITNESS FOR A PARTICULAR PURPOSE. --
18 -- As a special exception under Section 7 of GPL version 3, you are granted --
19 -- additional permissions described in the GCC Runtime Library Exception, --
20 -- version 3.1, as published by the Free Software Foundation. --
22 -- You should have received a copy of the GNU General Public License and --
23 -- a copy of the GCC Runtime Library Exception along with this program; --
24 -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
25 -- <http://www.gnu.org/licenses/>. --
27 -- This unit was originally developed by Matthew J Heaney. --
28 ------------------------------------------------------------------------------
30 -- The references below to "CLR" refer to the following book, from which
31 -- several of the algorithms here were adapted:
32 -- Introduction to Algorithms
33 -- by Thomas H. Cormen, Charles E. Leiserson, Ronald L. Rivest
34 -- Publisher: The MIT Press (June 18, 1990)
37 with System
; use type System
.Address
;
39 package body Ada
.Containers
.Red_Black_Trees
.Generic_Operations
is
41 -----------------------
42 -- Local Subprograms --
43 -----------------------
45 procedure Delete_Fixup
(Tree
: in out Tree_Type
; Node
: Node_Access
);
47 procedure Delete_Swap
(Tree
: in out Tree_Type
; Z
, Y
: Node_Access
);
49 procedure Left_Rotate
(Tree
: in out Tree_Type
; X
: Node_Access
);
50 procedure Right_Rotate
(Tree
: in out Tree_Type
; Y
: Node_Access
);
52 -- Why is all the following code commented out ???
54 -- ---------------------
55 -- -- Check_Invariant --
56 -- ---------------------
58 -- procedure Check_Invariant (Tree : Tree_Type) is
59 -- Root : constant Node_Access := Tree.Root;
61 -- function Check (Node : Node_Access) return Natural;
67 -- function Check (Node : Node_Access) return Natural is
69 -- if Node = null then
73 -- if Color (Node) = Red then
75 -- L : constant Node_Access := Left (Node);
77 -- pragma Assert (L = null or else Color (L) = Black);
82 -- R : constant Node_Access := Right (Node);
84 -- pragma Assert (R = null or else Color (R) = Black);
89 -- NL : constant Natural := Check (Left (Node));
90 -- NR : constant Natural := Check (Right (Node));
92 -- pragma Assert (NL = NR);
98 -- NL : constant Natural := Check (Left (Node));
99 -- NR : constant Natural := Check (Right (Node));
101 -- pragma Assert (NL = NR);
106 -- -- Start of processing for Check_Invariant
109 -- if Root = null then
110 -- pragma Assert (Tree.First = null);
111 -- pragma Assert (Tree.Last = null);
112 -- pragma Assert (Tree.Length = 0);
116 -- pragma Assert (Color (Root) = Black);
117 -- pragma Assert (Tree.Length > 0);
118 -- pragma Assert (Tree.Root /= null);
119 -- pragma Assert (Tree.First /= null);
120 -- pragma Assert (Tree.Last /= null);
121 -- pragma Assert (Parent (Tree.Root) = null);
122 -- pragma Assert ((Tree.Length > 1)
123 -- or else (Tree.First = Tree.Last
124 -- and Tree.First = Tree.Root));
125 -- pragma Assert (Left (Tree.First) = null);
126 -- pragma Assert (Right (Tree.Last) = null);
129 -- L : constant Node_Access := Left (Root);
130 -- R : constant Node_Access := Right (Root);
131 -- NL : constant Natural := Check (L);
132 -- NR : constant Natural := Check (R);
134 -- pragma Assert (NL = NR);
138 -- end Check_Invariant;
144 procedure Delete_Fixup
(Tree
: in out Tree_Type
; Node
: Node_Access
) is
148 X
: Node_Access
:= Node
;
153 and then Color
(X
) = Black
155 if X
= Left
(Parent
(X
)) then
156 W
:= Right
(Parent
(X
));
158 if Color
(W
) = Red
then
159 Set_Color
(W
, Black
);
160 Set_Color
(Parent
(X
), Red
);
161 Left_Rotate
(Tree
, Parent
(X
));
162 W
:= Right
(Parent
(X
));
165 if (Left
(W
) = null or else Color
(Left
(W
)) = Black
)
167 (Right
(W
) = null or else Color
(Right
(W
)) = Black
)
174 or else Color
(Right
(W
)) = Black
176 -- As a condition for setting the color of the left child to
177 -- black, the left child access value must be non-null. A
178 -- truth table analysis shows that if we arrive here, that
179 -- condition holds, so there's no need for an explicit test.
180 -- The assertion is here to document what we know is true.
182 pragma Assert
(Left
(W
) /= null);
183 Set_Color
(Left
(W
), Black
);
186 Right_Rotate
(Tree
, W
);
187 W
:= Right
(Parent
(X
));
190 Set_Color
(W
, Color
(Parent
(X
)));
191 Set_Color
(Parent
(X
), Black
);
192 Set_Color
(Right
(W
), Black
);
193 Left_Rotate
(Tree
, Parent
(X
));
198 pragma Assert
(X
= Right
(Parent
(X
)));
200 W
:= Left
(Parent
(X
));
202 if Color
(W
) = Red
then
203 Set_Color
(W
, Black
);
204 Set_Color
(Parent
(X
), Red
);
205 Right_Rotate
(Tree
, Parent
(X
));
206 W
:= Left
(Parent
(X
));
209 if (Left
(W
) = null or else Color
(Left
(W
)) = Black
)
211 (Right
(W
) = null or else Color
(Right
(W
)) = Black
)
217 if Left
(W
) = null or else Color
(Left
(W
)) = Black
then
219 -- As a condition for setting the color of the right child
220 -- to black, the right child access value must be non-null.
221 -- A truth table analysis shows that if we arrive here, that
222 -- condition holds, so there's no need for an explicit test.
223 -- The assertion is here to document what we know is true.
225 pragma Assert
(Right
(W
) /= null);
226 Set_Color
(Right
(W
), Black
);
229 Left_Rotate
(Tree
, W
);
230 W
:= Left
(Parent
(X
));
233 Set_Color
(W
, Color
(Parent
(X
)));
234 Set_Color
(Parent
(X
), Black
);
235 Set_Color
(Left
(W
), Black
);
236 Right_Rotate
(Tree
, Parent
(X
));
242 Set_Color
(X
, Black
);
245 ---------------------------
246 -- Delete_Node_Sans_Free --
247 ---------------------------
249 procedure Delete_Node_Sans_Free
250 (Tree
: in out Tree_Type
;
257 Z
: constant Node_Access
:= Node
;
258 pragma Assert
(Z
/= null);
261 if Tree
.Busy
> 0 then
262 raise Program_Error
with
263 "attempt to tamper with cursors (container is busy)";
266 -- Why are these all commented out ???
268 -- pragma Assert (Tree.Length > 0);
269 -- pragma Assert (Tree.Root /= null);
270 -- pragma Assert (Tree.First /= null);
271 -- pragma Assert (Tree.Last /= null);
272 -- pragma Assert (Parent (Tree.Root) = null);
273 -- pragma Assert ((Tree.Length > 1)
274 -- or else (Tree.First = Tree.Last
275 -- and then Tree.First = Tree.Root));
276 -- pragma Assert ((Left (Node) = null)
277 -- or else (Parent (Left (Node)) = Node));
278 -- pragma Assert ((Right (Node) = null)
279 -- or else (Parent (Right (Node)) = Node));
280 -- pragma Assert (((Parent (Node) = null) and then (Tree.Root = Node))
281 -- or else ((Parent (Node) /= null) and then
282 -- ((Left (Parent (Node)) = Node)
283 -- or else (Right (Parent (Node)) = Node))));
285 if Left
(Z
) = null then
286 if Right
(Z
) = null then
287 if Z
= Tree
.First
then
288 Tree
.First
:= Parent
(Z
);
291 if Z
= Tree
.Last
then
292 Tree
.Last
:= Parent
(Z
);
295 if Color
(Z
) = Black
then
296 Delete_Fixup
(Tree
, Z
);
299 pragma Assert
(Left
(Z
) = null);
300 pragma Assert
(Right
(Z
) = null);
302 if Z
= Tree
.Root
then
303 pragma Assert
(Tree
.Length
= 1);
304 pragma Assert
(Parent
(Z
) = null);
306 elsif Z
= Left
(Parent
(Z
)) then
307 Set_Left
(Parent
(Z
), null);
309 pragma Assert
(Z
= Right
(Parent
(Z
)));
310 Set_Right
(Parent
(Z
), null);
314 pragma Assert
(Z
/= Tree
.Last
);
318 if Z
= Tree
.First
then
319 Tree
.First
:= Min
(X
);
322 if Z
= Tree
.Root
then
324 elsif Z
= Left
(Parent
(Z
)) then
325 Set_Left
(Parent
(Z
), X
);
327 pragma Assert
(Z
= Right
(Parent
(Z
)));
328 Set_Right
(Parent
(Z
), X
);
331 Set_Parent
(X
, Parent
(Z
));
333 if Color
(Z
) = Black
then
334 Delete_Fixup
(Tree
, X
);
338 elsif Right
(Z
) = null then
339 pragma Assert
(Z
/= Tree
.First
);
343 if Z
= Tree
.Last
then
344 Tree
.Last
:= Max
(X
);
347 if Z
= Tree
.Root
then
349 elsif Z
= Left
(Parent
(Z
)) then
350 Set_Left
(Parent
(Z
), X
);
352 pragma Assert
(Z
= Right
(Parent
(Z
)));
353 Set_Right
(Parent
(Z
), X
);
356 Set_Parent
(X
, Parent
(Z
));
358 if Color
(Z
) = Black
then
359 Delete_Fixup
(Tree
, X
);
363 pragma Assert
(Z
/= Tree
.First
);
364 pragma Assert
(Z
/= Tree
.Last
);
367 pragma Assert
(Left
(Y
) = null);
372 if Y
= Left
(Parent
(Y
)) then
373 pragma Assert
(Parent
(Y
) /= Z
);
374 Delete_Swap
(Tree
, Z
, Y
);
375 Set_Left
(Parent
(Z
), Z
);
378 pragma Assert
(Y
= Right
(Parent
(Y
)));
379 pragma Assert
(Parent
(Y
) = Z
);
380 Set_Parent
(Y
, Parent
(Z
));
382 if Z
= Tree
.Root
then
384 elsif Z
= Left
(Parent
(Z
)) then
385 Set_Left
(Parent
(Z
), Y
);
387 pragma Assert
(Z
= Right
(Parent
(Z
)));
388 Set_Right
(Parent
(Z
), Y
);
391 Set_Left
(Y
, Left
(Z
));
392 Set_Parent
(Left
(Y
), Y
);
399 Y_Color
: constant Color_Type
:= Color
(Y
);
401 Set_Color
(Y
, Color
(Z
));
402 Set_Color
(Z
, Y_Color
);
406 if Color
(Z
) = Black
then
407 Delete_Fixup
(Tree
, Z
);
410 pragma Assert
(Left
(Z
) = null);
411 pragma Assert
(Right
(Z
) = null);
413 if Z
= Right
(Parent
(Z
)) then
414 Set_Right
(Parent
(Z
), null);
416 pragma Assert
(Z
= Left
(Parent
(Z
)));
417 Set_Left
(Parent
(Z
), null);
421 if Y
= Left
(Parent
(Y
)) then
422 pragma Assert
(Parent
(Y
) /= Z
);
424 Delete_Swap
(Tree
, Z
, Y
);
426 Set_Left
(Parent
(Z
), X
);
427 Set_Parent
(X
, Parent
(Z
));
430 pragma Assert
(Y
= Right
(Parent
(Y
)));
431 pragma Assert
(Parent
(Y
) = Z
);
433 Set_Parent
(Y
, Parent
(Z
));
435 if Z
= Tree
.Root
then
437 elsif Z
= Left
(Parent
(Z
)) then
438 Set_Left
(Parent
(Z
), Y
);
440 pragma Assert
(Z
= Right
(Parent
(Z
)));
441 Set_Right
(Parent
(Z
), Y
);
444 Set_Left
(Y
, Left
(Z
));
445 Set_Parent
(Left
(Y
), Y
);
448 Y_Color
: constant Color_Type
:= Color
(Y
);
450 Set_Color
(Y
, Color
(Z
));
451 Set_Color
(Z
, Y_Color
);
455 if Color
(Z
) = Black
then
456 Delete_Fixup
(Tree
, X
);
461 Tree
.Length
:= Tree
.Length
- 1;
462 end Delete_Node_Sans_Free
;
468 procedure Delete_Swap
469 (Tree
: in out Tree_Type
;
472 pragma Assert
(Z
/= Y
);
473 pragma Assert
(Parent
(Y
) /= Z
);
475 Y_Parent
: constant Node_Access
:= Parent
(Y
);
476 Y_Color
: constant Color_Type
:= Color
(Y
);
479 Set_Parent
(Y
, Parent
(Z
));
480 Set_Left
(Y
, Left
(Z
));
481 Set_Right
(Y
, Right
(Z
));
482 Set_Color
(Y
, Color
(Z
));
484 if Tree
.Root
= Z
then
486 elsif Right
(Parent
(Y
)) = Z
then
487 Set_Right
(Parent
(Y
), Y
);
489 pragma Assert
(Left
(Parent
(Y
)) = Z
);
490 Set_Left
(Parent
(Y
), Y
);
493 if Right
(Y
) /= null then
494 Set_Parent
(Right
(Y
), Y
);
497 if Left
(Y
) /= null then
498 Set_Parent
(Left
(Y
), Y
);
501 Set_Parent
(Z
, Y_Parent
);
502 Set_Color
(Z
, Y_Color
);
511 procedure Generic_Adjust
(Tree
: in out Tree_Type
) is
512 N
: constant Count_Type
:= Tree
.Length
;
513 Root
: constant Node_Access
:= Tree
.Root
;
517 pragma Assert
(Root
= null);
518 pragma Assert
(Tree
.Busy
= 0);
519 pragma Assert
(Tree
.Lock
= 0);
528 Tree
.Root
:= Copy_Tree
(Root
);
529 Tree
.First
:= Min
(Tree
.Root
);
530 Tree
.Last
:= Max
(Tree
.Root
);
538 procedure Generic_Clear
(Tree
: in out Tree_Type
) is
539 Root
: Node_Access
:= Tree
.Root
;
541 if Tree
.Busy
> 0 then
542 raise Program_Error
with
543 "attempt to tamper with cursors (container is busy)";
546 Tree
:= (First
=> null,
556 -----------------------
557 -- Generic_Copy_Tree --
558 -----------------------
560 function Generic_Copy_Tree
(Source_Root
: Node_Access
) return Node_Access
is
561 Target_Root
: Node_Access
:= Copy_Node
(Source_Root
);
565 if Right
(Source_Root
) /= null then
567 (Node
=> Target_Root
,
568 Right
=> Generic_Copy_Tree
(Right
(Source_Root
)));
571 (Node
=> Right
(Target_Root
),
572 Parent
=> Target_Root
);
577 X
:= Left
(Source_Root
);
580 Y
: constant Node_Access
:= Copy_Node
(X
);
582 Set_Left
(Node
=> P
, Left
=> Y
);
583 Set_Parent
(Node
=> Y
, Parent
=> P
);
585 if Right
(X
) /= null then
588 Right
=> Generic_Copy_Tree
(Right
(X
)));
603 Delete_Tree
(Target_Root
);
605 end Generic_Copy_Tree
;
607 -------------------------
608 -- Generic_Delete_Tree --
609 -------------------------
611 procedure Generic_Delete_Tree
(X
: in out Node_Access
) is
613 pragma Warnings
(Off
, Y
);
617 Generic_Delete_Tree
(Y
);
622 end Generic_Delete_Tree
;
628 function Generic_Equal
(Left
, Right
: Tree_Type
) return Boolean is
629 BL
: Natural renames Left
'Unrestricted_Access.Busy
;
630 LL
: Natural renames Left
'Unrestricted_Access.Lock
;
632 BR
: Natural renames Right
'Unrestricted_Access.Busy
;
633 LR
: Natural renames Right
'Unrestricted_Access.Lock
;
635 L_Node
: Node_Access
;
636 R_Node
: Node_Access
;
641 if Left
'Address = Right
'Address then
645 if Left
.Length
/= Right
.Length
then
649 -- If the containers are empty, return a result immediately, so as to
650 -- not manipulate the tamper bits unnecessarily.
652 if Left
.Length
= 0 then
656 -- Per AI05-0022, the container implementation is required to detect
657 -- element tampering by a generic actual subprogram.
665 L_Node
:= Left
.First
;
666 R_Node
:= Right
.First
;
668 while L_Node
/= null loop
669 if not Is_Equal
(L_Node
, R_Node
) then
674 L_Node
:= Next
(L_Node
);
675 R_Node
:= Next
(R_Node
);
697 -----------------------
698 -- Generic_Iteration --
699 -----------------------
701 procedure Generic_Iteration
(Tree
: Tree_Type
) is
702 procedure Iterate
(P
: Node_Access
);
708 procedure Iterate
(P
: Node_Access
) is
709 X
: Node_Access
:= P
;
718 -- Start of processing for Generic_Iteration
722 end Generic_Iteration
;
728 procedure Generic_Move
(Target
, Source
: in out Tree_Type
) is
730 if Target
'Address = Source
'Address then
734 if Source
.Busy
> 0 then
735 raise Program_Error
with
736 "attempt to tamper with cursors (container is busy)";
743 Source
:= (First
=> null,
755 procedure Generic_Read
756 (Stream
: not null access Root_Stream_Type
'Class;
757 Tree
: in out Tree_Type
)
761 Node
, Last_Node
: Node_Access
;
766 Count_Type
'Base'Read (Stream, N);
767 pragma Assert (N >= 0);
773 Node := Read_Node (Stream);
774 pragma Assert (Node /= null);
775 pragma Assert (Color (Node) = Red);
777 Set_Color (Node, Black);
785 for J in Count_Type range 2 .. N loop
787 pragma Assert (Last_Node = Tree.Last);
789 Node := Read_Node (Stream);
790 pragma Assert (Node /= null);
791 pragma Assert (Color (Node) = Red);
793 Set_Right (Node => Last_Node, Right => Node);
795 Set_Parent (Node => Node, Parent => Last_Node);
796 Rebalance_For_Insert (Tree, Node);
797 Tree.Length := Tree.Length + 1;
801 -------------------------------
802 -- Generic_Reverse_Iteration --
803 -------------------------------
805 procedure Generic_Reverse_Iteration (Tree : Tree_Type)
807 procedure Iterate (P : Node_Access);
813 procedure Iterate (P : Node_Access) is
814 X : Node_Access := P;
823 -- Start of processing for Generic_Reverse_Iteration
827 end Generic_Reverse_Iteration;
833 procedure Generic_Write
834 (Stream : not null access Root_Stream_Type'Class;
837 procedure Process (Node : Node_Access);
838 pragma Inline (Process);
841 new Generic_Iteration (Process);
847 procedure Process (Node : Node_Access) is
849 Write_Node (Stream, Node);
852 -- Start of processing for Generic_Write
855 Count_Type'Base'Write
(Stream
, Tree
.Length
);
863 procedure Left_Rotate
(Tree
: in out Tree_Type
; X
: Node_Access
) is
867 Y
: constant Node_Access
:= Right
(X
);
868 pragma Assert
(Y
/= null);
871 Set_Right
(X
, Left
(Y
));
873 if Left
(Y
) /= null then
874 Set_Parent
(Left
(Y
), X
);
877 Set_Parent
(Y
, Parent
(X
));
879 if X
= Tree
.Root
then
881 elsif X
= Left
(Parent
(X
)) then
882 Set_Left
(Parent
(X
), Y
);
884 pragma Assert
(X
= Right
(Parent
(X
)));
885 Set_Right
(Parent
(X
), Y
);
896 function Max
(Node
: Node_Access
) return Node_Access
is
900 X
: Node_Access
:= Node
;
919 function Min
(Node
: Node_Access
) return Node_Access
is
923 X
: Node_Access
:= Node
;
942 function Next
(Node
: Node_Access
) return Node_Access
is
950 if Right
(Node
) /= null then
951 return Min
(Right
(Node
));
955 X
: Node_Access
:= Node
;
956 Y
: Node_Access
:= Parent
(Node
);
960 and then X
= Right
(Y
)
974 function Previous
(Node
: Node_Access
) return Node_Access
is
980 if Left
(Node
) /= null then
981 return Max
(Left
(Node
));
985 X
: Node_Access
:= Node
;
986 Y
: Node_Access
:= Parent
(Node
);
990 and then X
= Left
(Y
)
1000 --------------------------
1001 -- Rebalance_For_Insert --
1002 --------------------------
1004 procedure Rebalance_For_Insert
1005 (Tree
: in out Tree_Type
;
1010 X
: Node_Access
:= Node
;
1011 pragma Assert
(X
/= null);
1012 pragma Assert
(Color
(X
) = Red
);
1017 while X
/= Tree
.Root
and then Color
(Parent
(X
)) = Red
loop
1018 if Parent
(X
) = Left
(Parent
(Parent
(X
))) then
1019 Y
:= Right
(Parent
(Parent
(X
)));
1021 if Y
/= null and then Color
(Y
) = Red
then
1022 Set_Color
(Parent
(X
), Black
);
1023 Set_Color
(Y
, Black
);
1024 Set_Color
(Parent
(Parent
(X
)), Red
);
1025 X
:= Parent
(Parent
(X
));
1028 if X
= Right
(Parent
(X
)) then
1030 Left_Rotate
(Tree
, X
);
1033 Set_Color
(Parent
(X
), Black
);
1034 Set_Color
(Parent
(Parent
(X
)), Red
);
1035 Right_Rotate
(Tree
, Parent
(Parent
(X
)));
1039 pragma Assert
(Parent
(X
) = Right
(Parent
(Parent
(X
))));
1041 Y
:= Left
(Parent
(Parent
(X
)));
1043 if Y
/= null and then Color
(Y
) = Red
then
1044 Set_Color
(Parent
(X
), Black
);
1045 Set_Color
(Y
, Black
);
1046 Set_Color
(Parent
(Parent
(X
)), Red
);
1047 X
:= Parent
(Parent
(X
));
1050 if X
= Left
(Parent
(X
)) then
1052 Right_Rotate
(Tree
, X
);
1055 Set_Color
(Parent
(X
), Black
);
1056 Set_Color
(Parent
(Parent
(X
)), Red
);
1057 Left_Rotate
(Tree
, Parent
(Parent
(X
)));
1062 Set_Color
(Tree
.Root
, Black
);
1063 end Rebalance_For_Insert
;
1069 procedure Right_Rotate
(Tree
: in out Tree_Type
; Y
: Node_Access
) is
1070 X
: constant Node_Access
:= Left
(Y
);
1071 pragma Assert
(X
/= null);
1074 Set_Left
(Y
, Right
(X
));
1076 if Right
(X
) /= null then
1077 Set_Parent
(Right
(X
), Y
);
1080 Set_Parent
(X
, Parent
(Y
));
1082 if Y
= Tree
.Root
then
1084 elsif Y
= Left
(Parent
(Y
)) then
1085 Set_Left
(Parent
(Y
), X
);
1087 pragma Assert
(Y
= Right
(Parent
(Y
)));
1088 Set_Right
(Parent
(Y
), X
);
1099 function Vet
(Tree
: Tree_Type
; Node
: Node_Access
) return Boolean is
1105 if Parent
(Node
) = Node
1106 or else Left
(Node
) = Node
1107 or else Right
(Node
) = Node
1113 or else Tree
.Root
= null
1114 or else Tree
.First
= null
1115 or else Tree
.Last
= null
1120 if Parent
(Tree
.Root
) /= null then
1124 if Left
(Tree
.First
) /= null then
1128 if Right
(Tree
.Last
) /= null then
1132 if Tree
.Length
= 1 then
1133 if Tree
.First
/= Tree
.Last
1134 or else Tree
.First
/= Tree
.Root
1139 if Node
/= Tree
.First
then
1143 if Parent
(Node
) /= null
1144 or else Left
(Node
) /= null
1145 or else Right
(Node
) /= null
1153 if Tree
.First
= Tree
.Last
then
1157 if Tree
.Length
= 2 then
1158 if Tree
.First
/= Tree
.Root
1159 and then Tree
.Last
/= Tree
.Root
1164 if Tree
.First
/= Node
1165 and then Tree
.Last
/= Node
1171 if Left
(Node
) /= null
1172 and then Parent
(Left
(Node
)) /= Node
1177 if Right
(Node
) /= null
1178 and then Parent
(Right
(Node
)) /= Node
1183 if Parent
(Node
) = null then
1184 if Tree
.Root
/= Node
then
1188 elsif Left
(Parent
(Node
)) /= Node
1189 and then Right
(Parent
(Node
)) /= Node
1197 end Ada
.Containers
.Red_Black_Trees
.Generic_Operations
;