This patch corrects the implementation of routine Insert_Child in the following
multiway tree packages:
Ada.Containers.Indefinite_Multiway_Trees
Ada.Containers.Multiway_Trees
As a result, Insert_Child no longer returns a faulty Position when inserting
elements.
------------
-- Source --
------------
-- multi_main.adb
with Ada.Containers.Multiway_Trees;
with Ada.Text_IO; use Ada.Text_IO;
procedure Multi_Main is
Size : constant := 4;
type Small_Int is new Integer range 1 .. 9
with Default_Value => 1;
package MWT is new Ada.Containers.Multiway_Trees (Small_Int);
use MWT;
procedure Print_Tree (T : Tree) is
procedure Output (C : Cursor) is
begin
Put_Line (Element (C)'Img);
end Output;
begin
T.Iterate (Output'Access);
end Print_Tree;
T : Tree;
R : constant Cursor := T.Root;
C : Cursor;
begin
for Index in 1 .. Size loop
T.Prepend_Child (R, 8);
end loop;
T.Clear;
T.Insert_Child
(Parent => R,
Before => No_Element,
Position => C,
Count => 1);
T.Insert_Child
(Parent => R,
Before => C,
Position => C,
New_Item => 2,
Count => 2);
Print_Tree (T);
end Multi_Main;
----------------------------
-- Compilation and output --
----------------------------
$ gnatmake -q multi_main.adb
$ ./multi_main
2
2
1
Tested on x86_64-pc-linux-gnu, committed on trunk
2014-10-30 Hristian Kirtchev <kirtc...@adacore.com>
* a-comutr.adb, a-cimutr.adb (Insert_Child): Add new variable First.
Update the position after all insertions have taken place.
Index: a-cimutr.adb
===================================================================
--- a-cimutr.adb (revision 216770)
+++ a-cimutr.adb (working copy)
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 2004-2013, Free Software Foundation, Inc. --
+-- Copyright (C) 2004-2014, 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- --
@@ -1217,6 +1217,7 @@
Position : out Cursor;
Count : Count_Type := 1)
is
+ First : Tree_Node_Access;
Last : Tree_Node_Access;
Element : Element_Access;
@@ -1249,8 +1250,6 @@
with "attempt to tamper with cursors (tree is busy)";
end if;
- Position.Container := Parent.Container;
-
declare
-- The element allocator may need an accessibility check in the case
-- the actual type is class-wide or has access discriminants (see
@@ -1264,16 +1263,16 @@
Element := new Element_Type'(New_Item);
end;
- Position.Node := new Tree_Node_Type'(Parent => Parent.Node,
- Element => Element,
- others => <>);
+ First := new Tree_Node_Type'(Parent => Parent.Node,
+ Element => Element,
+ others => <>);
- Last := Position.Node;
+ Last := First;
+ for J in Count_Type'(2) .. Count loop
- for J in Count_Type'(2) .. Count loop
-- Reclaim other nodes if Storage_Error. ???
- Element := new Element_Type'(New_Item);
+ Element := new Element_Type'(New_Item);
Last.Next := new Tree_Node_Type'(Parent => Parent.Node,
Prev => Last,
Element => Element,
@@ -1283,7 +1282,7 @@
end loop;
Insert_Subtree_List
- (First => Position.Node,
+ (First => First,
Last => Last,
Parent => Parent.Node,
Before => Before.Node);
@@ -1293,6 +1292,8 @@
-- nodes we just inserted.
Container.Count := Container.Count + Count;
+
+ Position := Cursor'(Parent.Container, First);
end Insert_Child;
-------------------------
Index: a-comutr.adb
===================================================================
--- a-comutr.adb (revision 216770)
+++ a-comutr.adb (working copy)
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 2004-2013, Free Software Foundation, Inc. --
+-- Copyright (C) 2004-2014, 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- --
@@ -272,7 +272,8 @@
New_Item : Element_Type;
Count : Count_Type := 1)
is
- First, Last : Tree_Node_Access;
+ First : Tree_Node_Access;
+ Last : Tree_Node_Access;
begin
if Parent = No_Element then
@@ -297,7 +298,6 @@
others => <>);
Last := First;
-
for J in Count_Type'(2) .. Count loop
-- Reclaim other nodes if Storage_Error. ???
@@ -1171,7 +1171,8 @@
Position : out Cursor;
Count : Count_Type := 1)
is
- Last : Tree_Node_Access;
+ First : Tree_Node_Access;
+ Last : Tree_Node_Access;
begin
if Parent = No_Element then
@@ -1202,13 +1203,11 @@
with "attempt to tamper with cursors (tree is busy)";
end if;
- Position.Container := Parent.Container;
- Position.Node := new Tree_Node_Type'(Parent => Parent.Node,
- Element => New_Item,
- others => <>);
+ First := new Tree_Node_Type'(Parent => Parent.Node,
+ Element => New_Item,
+ others => <>);
- Last := Position.Node;
-
+ Last := First;
for J in Count_Type'(2) .. Count loop
-- Reclaim other nodes if Storage_Error. ???
@@ -1222,7 +1221,7 @@
end loop;
Insert_Subtree_List
- (First => Position.Node,
+ (First => First,
Last => Last,
Parent => Parent.Node,
Before => Before.Node);
@@ -1232,6 +1231,8 @@
-- nodes we just inserted.
Container.Count := Container.Count + Count;
+
+ Position := Cursor'(Parent.Container, First);
end Insert_Child;
procedure Insert_Child
@@ -1241,7 +1242,8 @@
Position : out Cursor;
Count : Count_Type := 1)
is
- Last : Tree_Node_Access;
+ First : Tree_Node_Access;
+ Last : Tree_Node_Access;
begin
if Parent = No_Element then
@@ -1272,13 +1274,11 @@
with "attempt to tamper with cursors (tree is busy)";
end if;
- Position.Container := Parent.Container;
- Position.Node := new Tree_Node_Type'(Parent => Parent.Node,
- Element => <>,
- others => <>);
+ First := new Tree_Node_Type'(Parent => Parent.Node,
+ Element => <>,
+ others => <>);
- Last := Position.Node;
-
+ Last := First;
for J in Count_Type'(2) .. Count loop
-- Reclaim other nodes if Storage_Error. ???
@@ -1292,7 +1292,7 @@
end loop;
Insert_Subtree_List
- (First => Position.Node,
+ (First => First,
Last => Last,
Parent => Parent.Node,
Before => Before.Node);
@@ -1302,6 +1302,8 @@
-- nodes we just inserted.
Container.Count := Container.Count + Count;
+
+ Position := Cursor'(Parent.Container, First);
end Insert_Child;
-------------------------
