1--  Copyright 1994 Grady Booch
2--  Copyright 1994-1997 David Weller
3--  Copyright 1998-2014 Simon Wright <simon@pushface.org>
4
5--  This package is free software; you can redistribute it and/or
6--  modify it under terms of the GNU General Public License as
7--  published by the Free Software Foundation; either version 2, or
8--  (at your option) any later version. This package is distributed in
9--  the hope that it will be useful, but WITHOUT ANY WARRANTY; without
10--  even the implied warranty of MERCHANTABILITY or FITNESS FOR A
11--  PARTICULAR PURPOSE. See the GNU General Public License for more
12--  details. You should have received a copy of the GNU General Public
13--  License distributed with this package; see file COPYING.  If not,
14--  write to the Free Software Foundation, 59 Temple Place - Suite
15--  330, Boston, MA 02111-1307, USA.
16
17with Ada.Exceptions;
18with Ada.Text_IO;
19with BC;
20with List_Test_Support;
21
22procedure List_Test is
23
24   use Ada.Text_IO;
25   use List_Test_Support;
26   use Containers;
27   use Lists;
28   use LS;
29   use LD;
30
31   procedure Assertion (Cond : Boolean; Message : String);
32   procedure Assertion (Cond : Boolean; Message : String) is
33   begin
34      if not Cond then
35         Put_Line (Message);
36      end if;
37   end Assertion;
38
39   procedure Test_Single (L1, L2, T1, T2, T3 : in out LS.List);
40   procedure Test_Single (L1, L2, T1, T2, T3 : in out LS.List) is
41   begin
42      Assertion (Is_Null (L1), "** S01: List is not initially null");
43      Assertion ((Length (L1) = 0),
44                 "** S02: List Length is not initially zero");
45      Assertion (not Is_Shared (L1), "** S03: List is initially shared");
46      Append (L1, '3');
47      Append (L1, '1', 1);
48      Append (L1, '2', 2);
49      Assertion (not Is_Null (L1), "** S04: List is empty");
50      Assertion ((Length (L1) = 3), "** S05: List Length is not correct");
51      Assertion ((Head (L1) = '3'), "** S06: List Head is not correct");
52      Assertion (not Is_Shared (L1), "** S07: List is shared");
53      Clear (L1);
54      Assertion (Is_Null (L1), "** S08: List is not null");
55      Assertion ((Length (L1) = 0), "** S09: List Length is not zero");
56      Assertion (not Is_Shared (L1), "** S10: List is shared");
57      Insert (L1, '4');
58      Insert (L1, '5');
59      Insert (L1, '6');
60      Assertion (not Is_Null (L1), "** S11: List is empty");
61      Assertion ((Length (L1) = 3), "** S12: List Length is not correct");
62      Assertion ((Foot (L1) = '4'), "** S13: List Head is not correct");
63      Assertion (not Is_Shared (L1), "** S14: List is shared");
64      T1 := L1;
65      Assertion ((L1 = T1), "** S15: Lists are not equal");
66      Assertion (Is_Shared (L1), "** S16: List is not shared");
67      Assertion (Is_Shared (T1), "** S17: List is not shared");
68      Set_Head (T1, '7');
69      Assertion ((L1 = T1), "** S18: Lists are not equal");
70      Assertion ((Item_At (L1, 1) = '7'), "** S19: List Head is not correct");
71      Assertion ((Head (T1) = '7'), "** S20: List Head is not correct");
72      Insert (L1, '8');
73      Assertion ((L1 /= T1), "** S21: Lists are equal");
74      Assertion ((Length (L1) = 4), "** S22: List Length is not correct");
75      Assertion ((Item_At (L1, 2) = '7'), "** S23: List Head is not correct");
76      Assertion ((Length (T1) = 3), "** S24: List Length is not correct");
77      Assertion ((Head (T1) = '7'), "** S25: List Head is not correct");
78      T2 := T1;
79      Tail (T2);
80      Assertion ((T1 /= T2), "** S26: Lists are equal");
81      Assertion ((Length (T2) = 2), "** S27: List Length is not correct");
82      Assertion ((Head (T2) = '5'), "** S28: List Head is not correct");
83      Clear (T1);
84      Assertion ((Length (L1) = 4), "** S29: List Length is not correct");
85      Assertion ((Head (L1) = '8'), "** S30: List Head is not correct");
86      Assertion (not Is_Shared (L1), "** S31: List is not shared");
87      Assertion (Is_Null (T1), "** S32: List is not null");
88      Assertion ((Length (T1) = 0), "** S33: List Length is not correct");
89      Assertion (not Is_Shared (T1), "** S34: List is shared");
90      Assertion ((Length (T2) = 2), "** S35: List Length is not correct");
91      Assertion ((Head (T2) = '5'), "** S36: List Head is not correct");
92      Assertion (Is_Shared (T2), "** S37: List is not shared");
93      Clear (L1);
94      Assertion (Is_Null (L1), "** S38: List is not null");
95      Assertion ((Length (L1) = 0), "** S39: List Length is not correct");
96      Assertion (not Is_Shared (L1), "** S40: List is shared");
97      Assertion ((Length (T2) = 2), "** S41: List Length is not correct");
98      Assertion ((Head (T2) = '5'), "** S42: List Head is not correct");
99      Assertion (not Is_Shared (T2), "** S43: List is shared");
100      Insert (L2, '1');
101      Insert (L2, '3', 1);
102      Insert (L2, '2', 2);
103      Assertion ((L1 /= L2), "** S44: Lists are equal");
104      Assertion (not Is_Null (L2), "** S45: List is empty");
105      Assertion ((Length (L2) = 3), "** S46: List Length is not correct");
106      Assertion ((Head (L2) = '3'), "** S47: List Head is not correct");
107      Assertion (not Is_Shared (L2), "** S48: List is shared");
108      L1 := T2;
109      T3 := L2;
110      L1 := T3;
111      Tail (T3);
112      Assertion ((L1 = L2), "** S49: Lists are not equal");
113      Assertion ((L1 /= T2), "** S50: List are equal");
114      Assertion (Is_Shared (L1), "** S51: List is not shared");
115      Assertion (not Is_Shared (T2), "** S52: List is not shared");
116      Assertion (Is_Shared (T3), "** S53: List is not shared");
117      Clear (L1);
118      Swap_Tail (L2, T2);
119      Assertion (Is_Null (L1), "** S54: List is not null");
120      Assertion ((Length (L2) = 3), "** S55: List Length is not correct");
121      Assertion (not Is_Shared (L2), "** S56: List is shared");
122      Assertion ((T2 = T3), "** S55: Lists are not equal");
123      Assertion ((Length (T3) = 2), "** S56: List Length is not correct");
124      Assertion ((Head (T3) = '2'), "** S57: List Head is not correct");
125      L1 := T2;
126      T2 := L2;
127      Tail (T2);
128      Assertion ((L1 /= L2), "** S58: Lists are equal");
129      Assertion ((L1 = T3), "** S59: Lists are not equal");
130      Assertion ((Head (T2) = '5'), "** S60: List Head is not correct");
131      Assertion ((Length (T2) = 2), "** S61: List Length is not correct");
132      Set_Item (L1, '7', 1);
133      Assertion ((Head (L1) = '7'), "** S62: List Head is not correct");
134      Set_Item (L1, '7', 2);
135      Assertion ((Head (L1) = '7'), "** S63: List Head is not correct");
136      Set_Item (L1, '2', 1);
137      Set_Item (L1, '1', 2);
138      T1 := L1;
139      T2 := L2;
140      Clear (L1);
141      Clear (L2);
142      Insert (L1, '1');
143      Insert (L1, '5');
144      Insert (L2, '2');
145      Insert (L2, '3');
146      Insert (L2, '4');
147      Insert (L1, L2, 2);
148      Clear (L2);
149      Assertion ((Item_At (L1, 1) = '5'), "** S64: List Item is not correct");
150      Assertion ((Item_At (L1, 2) = '4'), "** S65: List Item is not correct");
151      Assertion ((Item_At (L1, 3) = '3'), "** S66: List Item is not correct");
152      Assertion ((Item_At (L1, 4) = '2'), "** S67: List Item is not correct");
153      Assertion ((Item_At (L1, 5) = '1'), "** S68: List Item is not correct");
154      Clear (T3);
155      Append (L2, '7');
156      Append (T3, '9');
157      Append (T3, '8');
158      Insert (L2, T3);
159      Clear (T3);
160      Append (T3, '2');
161      Append (T3, '1');
162      Append (L2, T3);
163      Clear (T3);
164      Append (T3, '6');
165      Append (T3, '5');
166      Append (T3, '4');
167      Append (T3, '3');
168      Append (L2, T3, 3);
169      Clear (T3);
170      Assertion ((Length (L2) = 9), "** S68: List Length is not correct");
171      Assertion ((Item_At (L2, 1) = '9'), "** S70: List Item is not correct");
172      Assertion ((Item_At (L2, 5) = '5'), "** S71: List Item is not correct");
173      Assertion ((Item_At (L2, 7) = '3'), "** S71: List Item is not correct");
174      Assertion ((Item_At (L2, 8) = '2'), "** S72: List Item is not correct");
175      Assertion ((Item_At (L2, 9) = '1'), "** S74: List Item is not correct");
176      Share_Foot (T3, L2);
177      Assertion ((Head (T3) = '1'), "** S75: List Item is not correct");
178      Share_Head (T3, L2);
179      Assertion ((Head (T3) = '9'), "** S76: List Item is not correct");
180      Share (T3, L2, 1);
181      Clear (L2);
182      Assertion ((Head (T3) = '9'), "** S77: List Item is not correct");
183      L2 := T3;
184      Assertion ((Head (L2) = '9'), "** S78: List Item is not correct");
185      Clear (L1);
186      Clear (T3);
187      L1 := L2;
188      Clear (L2);
189      Remove (L1, 1);
190      Remove (L1, 8);
191      Remove (L1, 4);
192      Assertion ((Length (L1) = 6), "** S79: List Length is not correct");
193      Assertion ((Head (L1) = '8'), "** S80: List Item is not correct");
194      Assertion ((Foot (L1) = '2'), "** S81: List Item is not correct");
195      Share (T1, L1, 3);
196      Share (T2, L1, 5);
197      Purge (L1, 4);
198      Assertion ((Length (L1) = 3), "** S82: List Length is not correct");
199      Assertion ((Length (T1) = 1), "** S83: List Length is not correct");
200      Assertion ((Length (T2) = 2), "** S84: List Length is not correct");
201      Assertion ((Head (L1) = '8'), "** S85: List Item is not correct");
202      Assertion ((Head (T1) = '6'), "** S86: List Item is not correct");
203      Assertion ((Head (T2) = '3'), "** S87: List Item is not correct");
204      Append (L1, '5');
205      Append (L1, '4');
206      Append (L1, '3');
207      Append (L1, '2');
208      Append (L1, '1');
209      Share (T1, L1, 3);
210      Share (T2, L1, 5);
211      Purge (L1, 4, 3);
212      Assertion ((Length (L1) = 5), "** S88: List Length is not correct");
213      Assertion ((Length (T1) = 3), "** S89: List Length is not correct");
214      Assertion ((Length (T2) = 2), "** S90: List Length is not correct");
215      Assertion ((Head (L1) = '8'), "** S91: List Item is not correct");
216      Assertion ((Item_At (T1, 2) = '2'), "** S92: List Item is not correct");
217      Assertion ((Head (T2) = '4'), "** S93: List Item is not correct");
218      Preserve (L1, 1);
219      Assertion ((Length (L1) = 5), "** S94: List Length is not correct");
220      Preserve (L1, 2);
221      Assertion ((Length (L1) = 4), "** S95: List Length is not correct");
222      Append (L1, '3');
223      Append (L1, '4');
224      Append (L1, '5');
225      Preserve (L1, 3, 4);
226      Assertion ((Length (L1) = 4), "** S96: List Length is not correct");
227      Assertion ((Length (T1) = 5), "** S97: List Length is not correct");
228   end Test_Single;
229
230   procedure Test_Single (L1, L2 : in out LS.List);
231   procedure Test_Single (L1, L2 : in out LS.List) is
232      T1, T2, T3 : LS.List;
233   begin
234      Test_Single (L1, L2, T1, T2, T3);
235   end Test_Single;
236
237   procedure Test_Double (L1, L2, T1, T2, T3 : in out LD.List);
238   procedure Test_Double (L1, L2, T1, T2, T3 : in out LD.List) is
239   begin
240      Assertion (Is_Null (L1), "** D01: List is not initially null");
241      Assertion ((Length (L1) = 0),
242                 "** D02: List Length is not initially zero");
243      Assertion (not Is_Shared (L1), "** D03: List is initially shared");
244      Append (L1, '3');
245      Append (L1, '1', 1);
246      Append (L1, '2', 2);
247      Assertion (not Is_Null (L1), "** D04: List is empty");
248      Assertion ((Length (L1) = 3), "** D05: List Length is not correct");
249      Assertion ((Head (L1) = '3'), "** D06: List Head is not correct");
250      Assertion (not Is_Shared (L1), "** D07: List is shared");
251      Clear (L1);
252      Assertion (Is_Null (L1), "** D08: List is not null");
253      Assertion ((Length (L1) = 0), "** D09: List Length is not zero");
254      Assertion (not Is_Shared (L1), "** D10: List is shared");
255      Insert (L1, '4');
256      Insert (L1, '5');
257      Insert (L1, '6');
258      Assertion (not Is_Null (L1), "** D11: List is empty");
259      Assertion ((Length (L1) = 3), "** D12: List Length is not correct");
260      Assertion ((Foot (L1) = '4'), "** D13: List Head is not correct");
261      Assertion (not Is_Shared (L1), "** D14: List is shared");
262      T1 := L1;
263      Assertion ((L1 = T1), "** D15: Lists are not equal");
264      Assertion (Is_Shared (L1), "** D16: List is not shared");
265      Assertion (Is_Shared (T1), "** D17: List is not shared");
266      Set_Head (T1, '7');
267      Assertion ((L1 = T1), "** D18: Lists are not equal");
268      Assertion ((Item_At (L1, 1) = '7'), "** D19: List Head is not correct");
269      Assertion ((Head (T1) = '7'), "** D20: List Head is not correct");
270      Insert (L1, '8');
271      Assertion ((L1 /= T1), "** D21: Lists are equal");
272      Assertion ((Length (L1) = 4), "** D22: List Length is not correct");
273      Assertion ((Item_At (L1, 2) = '7'), "** D23: List Head is not correct");
274      Assertion ((Length (T1) = 3), "** D24: List Length is not correct");
275      Assertion ((Head (T1) = '7'), "** D25: List Head is not correct");
276      T2 := T1;
277      Tail (T2);
278      Assertion ((T1 /= T2), "** D26: Lists are equal");
279      Assertion ((Length (T2) = 2), "** D27: List Length is not correct");
280      Assertion ((Head (T2) = '5'), "** D28: List Head is not correct");
281      Clear (T1);
282      Assertion ((Length (L1) = 4), "** D29: List Length is not correct");
283      Assertion ((Head (L1) = '8'), "** D30: List Head is not correct");
284      Assertion (not Is_Shared (L1), "** D31: List is not shared");
285      Assertion (Is_Null (T1), "** D32: List is not null");
286      Assertion ((Length (T1) = 0), "** D33: List Length is not correct");
287      Assertion (not Is_Shared (T1), "** D34: List is shared");
288      Assertion ((Length (T2) = 2), "** D35: List Length is not correct");
289      Assertion ((Head (T2) = '5'), "** D36: List Head is not correct");
290      Assertion (Is_Shared (T2), "** D37: List is not shared");
291      Clear (L1);
292      Assertion (Is_Null (L1), "** D38: List is not null");
293      Assertion ((Length (L1) = 0), "** D39: List Length is not correct");
294      Assertion (not Is_Shared (L1), "** D40: List is shared");
295      Assertion ((Length (T2) = 2), "** D41: List Length is not correct");
296      Assertion ((Head (T2) = '5'), "** D42: List Head is not correct");
297      Assertion (not Is_Shared (T2), "** D43: List is shared");
298      Insert (L2, '1');
299      Insert (L2, '3', 1);
300      Insert (L2, '2', 2);
301      Assertion ((L1 /= L2), "** D44: Lists are equal");
302      Assertion (not Is_Null (L2), "** D45: List is empty");
303      Assertion ((Length (L2) = 3), "** D46: List Length is not correct");
304      Assertion ((Head (L2) = '3'), "** D47: List Head is not correct");
305      Assertion (not Is_Shared (L2), "** D48: List is shared");
306      L1 := T2;
307      T3 := L2;
308      L1 := T3;
309      Tail (T3);
310      Assertion ((L1 = L2), "** D49: Lists are not equal");
311      Assertion ((L1 /= T2), "** D50: List are equal");
312      Assertion (Is_Shared (L1), "** D51: List is not shared");
313      Assertion (not Is_Shared (T2), "** D52: List is not shared");
314      Assertion (Is_Shared (T3), "** D53: List is not shared");
315      Clear (L1);
316      Swap_Tail (L2, T2);
317      Assertion (Is_Null (L1), "** D54: List is not null");
318      Assertion ((Length (L2) = 3), "** D55: List Length is not correct");
319      Assertion (not Is_Shared (L2), "** D56: List is shared");
320      Assertion ((T2 = T3), "** D55: Lists are not equal");
321      Assertion ((Length (T3) = 2), "** D56: List Length is not correct");
322      Assertion ((Head (T3) = '2'), "** D57: List Head is not correct");
323      L1 := T2;
324      T2 := L2;
325      Tail (T2);
326      Assertion ((L1 /= L2), "** D58: Lists are equal");
327      Assertion ((L1 = T3), "** D59: Lists are not equal");
328      Assertion ((Head (T2) = '5'), "** D60: List Head is not correct");
329      Assertion ((Length (T2) = 2), "** D61: List Length is not correct");
330      Set_Item (L1, '7', 1);
331      Assertion ((Head (L1) = '7'), "** D62: List Head is not correct");
332      Set_Item (L1, '7', 2);
333      Assertion ((Head (L1) = '7'), "** D63: List Head is not correct");
334      Set_Item (L1, '2', 1);
335      Set_Item (L1, '1', 2);
336      T1 := L1;
337      T2 := L2;
338      Clear (L1);
339      Clear (L2);
340      Insert (L1, '1');
341      Insert (L1, '5');
342      Insert (L2, '2');
343      Insert (L2, '3');
344      Insert (L2, '4');
345      Insert (L1, L2, 2);
346      Clear (L2);
347      Assertion ((Item_At (L1, 1) = '5'), "** D64: List Item is not correct");
348      Assertion ((Item_At (L1, 2) = '4'), "** D65: List Item is not correct");
349      Assertion ((Item_At (L1, 3) = '3'), "** D66: List Item is not correct");
350      Assertion ((Item_At (L1, 4) = '2'), "** D67: List Item is not correct");
351      Assertion ((Item_At (L1, 5) = '1'), "** D68: List Item is not correct");
352      Clear (T3);
353      Append (L2, '7');
354      Append (T3, '9');
355      Append (T3, '8');
356      Insert (L2, T3);
357      Clear (T3);
358      Append (T3, '2');
359      Append (T3, '1');
360      Append (L2, T3);
361      Clear (T3);
362      Append (T3, '6');
363      Append (T3, '5');
364      Append (T3, '4');
365      Append (T3, '3');
366      Append (L2, T3, 3);
367      Clear (T3);
368      Assertion ((Length (L2) = 9), "** D68: List Length is not correct");
369      Assertion ((Item_At (L2, 1) = '9'), "** D70: List Item is not correct");
370      Assertion ((Item_At (L2, 5) = '5'), "** D71: List Item is not correct");
371      Assertion ((Item_At (L2, 7) = '3'), "** D71: List Item is not correct");
372      Assertion ((Item_At (L2, 8) = '2'), "** D72: List Item is not correct");
373      Assertion ((Item_At (L2, 9) = '1'), "** D74: List Item is not correct");
374      Share_Foot (T3, L2);
375      Assertion ((Head (T3) = '1'), "** D75: List Item is not correct");
376      Share_Head (T3, L2);
377      Assertion ((Head (T3) = '9'), "** D76: List Item is not correct");
378      Share (T3, L2, 1);
379      Clear (L2);
380      Assertion ((Head (T3) = '9'), "** D77: List Item is not correct");
381      L2 := T3;
382      Assertion ((Head (L2) = '9'), "** D78: List Item is not correct");
383      Clear (L1);
384      Clear (T3);
385      L1 := L2;
386      Clear (L2);
387      Remove (L1, 1);
388      Remove (L1, 8);
389      Remove (L1, 4);
390      Assertion ((Length (L1) = 6), "** D79: List Length is not correct");
391      Assertion ((Head (L1) = '8'), "** D80: List Item is not correct");
392      Assertion ((Foot (L1) = '2'), "** D81: List Item is not correct");
393      Share (T1, L1, 3);
394      Share (T2, L1, 5);
395      Purge (L1, 4);
396      Assertion ((Length (L1) = 3), "** D82: List Length is not correct");
397      Assertion ((Length (T1) = 1), "** D83: List Length is not correct");
398      Assertion ((Length (T2) = 2), "** D84: List Length is not correct");
399      Assertion ((Head (L1) = '8'), "** D85: List Item is not correct");
400      Assertion ((Head (T1) = '6'), "** D86: List Item is not correct");
401      Assertion ((Head (T2) = '3'), "** D87: List Item is not correct");
402      Append (L1, '5');
403      Append (L1, '4');
404      Append (L1, '3');
405      Append (L1, '2');
406      Append (L1, '1');
407      Share (T1, L1, 3);
408      Share (T2, L1, 5);
409      Purge (L1, 4, 3);
410      Assertion ((Length (L1) = 5), "** D88: List Length is not correct");
411      Assertion ((Length (T1) = 3), "** D89: List Length is not correct");
412      Assertion ((Length (T2) = 2), "** D90: List Length is not correct");
413      Assertion ((Head (L1) = '8'), "** D91: List Item is not correct");
414      Assertion ((Item_At (T1, 2) = '2'), "** D92: List Item is not correct");
415      Assertion ((Head (T2) = '4'), "** D93: List Item is not correct");
416      Preserve (L1, 1);
417      Assertion ((Length (L1) = 5), "** D94: List Length is not correct");
418      Preserve (L1, 2);
419      Assertion ((Length (L1) = 4), "** D95: List Length is not correct");
420      Append (L1, '3');
421      Append (L1, '4');
422      Append (L1, '5');
423      Preserve (L1, 3, 4);
424      Assertion ((Length (L1) = 4), "** D96: List Length is not correct");
425      Assertion ((Length (T1) = 5), "** D97: List Length is not correct");
426      Share (T1, L1, 2);
427      Assertion (Is_Head (L1), "** D98: List is Head is not correct");
428      Assertion (not Is_Head (T1), "** D99: List is Head is not correct");
429      Predecessor (T1);
430      Assertion (Is_Head (T1), "** D100: List is Head is not correct");
431      Predecessor (T1);
432      Assertion (Is_Null (T1), "** D101: List is not null");
433   end Test_Double;
434
435   procedure Test_Double (L1, L2 : in out LD.List);
436   procedure Test_Double (L1, L2 : in out LD.List) is
437      T1, T2, T3 : LD.List;
438   begin
439      Test_Double (L1, L2, T1, T2, T3);
440   end Test_Double;
441
442   procedure Process (C : in Character; OK : out Boolean);
443   procedure Process (C : in Character; OK : out Boolean) is
444   begin
445      Put_Line ("Item: " & C);
446      OK := True;
447   end Process;
448
449   procedure Test_Active_Iterator (L : Container'Class);
450   procedure Test_Active_Iterator (L : Container'Class) is
451      Iter : Iterator'Class := New_Iterator (L);
452      Success : Boolean;
453      Temp : Character;
454   begin
455      while not Is_Done (Iter) loop
456         Temp := Current_Item (Iter);
457         Process (Temp, Success);
458         Next (Iter);
459      end loop;
460   end Test_Active_Iterator;
461
462   procedure Test_Passive_Iterator (L : Container'Class);
463   procedure Test_Passive_Iterator (L : Container'Class) is
464      procedure Iterate is new Visit (Apply => Process);
465      Iter : Iterator'Class := New_Iterator (L);
466   begin
467      Iterate (Using => Iter);
468   end Test_Passive_Iterator;
469
470   procedure Test_Iterator_Deletion (L : in out LS.List);
471   procedure Test_Iterator_Deletion (L : in out LS.List) is
472      Iter : Iterator'Class := New_Iterator (L);
473      Delete : Boolean;
474   begin
475      Clear (L);
476      Append (L, '1');
477      Append (L, '2');
478      Append (L, '3');
479      Append (L, '4');
480      Append (L, '5');
481      Append (L, '6');
482      Delete := False;
483      Reset (Iter);
484      while not Is_Done (Iter) loop
485         if Delete then
486            Delete_Item_At (Iter);
487            Delete := False;
488         else
489            Next (Iter);
490            Delete := True;
491         end if;
492      end loop;
493      begin
494         Delete_Item_At (Iter);
495         Assertion (False, "** IS01: Deletion succeeded");
496      exception
497         when BC.Not_Found => null;
498         when others =>
499            Assertion (False, "** IS02: Unexpected exception");
500      end;
501      Assertion (Length (L) = 3, "** IS03: List length is not correct");
502      Assertion (Head (L) = '1', "** IS04: List item is not correct");
503      Remove (L, 1);
504      Assertion (Head (L) = '3', "** IS05: List item is not correct");
505      Remove (L, 1);
506      Assertion (Head (L) = '5', "** IS06: List item is not correct");
507      Remove (L, 1);
508      Assertion (Length (L) = 0, "** IS07: List length is not zero");
509   end Test_Iterator_Deletion;
510
511   procedure Test_Iterator_Deletion (L : in out LD.List);
512   procedure Test_Iterator_Deletion (L : in out LD.List) is
513      Iter : Iterator'Class := New_Iterator (L);
514      Delete : Boolean;
515   begin
516      Clear (L);
517      Append (L, '1');
518      Append (L, '2');
519      Append (L, '3');
520      Append (L, '4');
521      Append (L, '5');
522      Append (L, '6');
523      Delete := False;
524      Reset (Iter);
525      while not Is_Done (Iter) loop
526         if Delete then
527            Delete_Item_At (Iter);
528            Delete := False;
529         else
530            Next (Iter);
531            Delete := True;
532         end if;
533      end loop;
534      begin
535         Delete_Item_At (Iter);
536         Assertion (False, "** ID01: Deletion succeeded");
537      exception
538         when BC.Not_Found => null;
539         when others =>
540            Assertion (False, "** ID02: Unexpected exception");
541      end;
542      Assertion (Length (L) = 3, "** ID03: List length is not correct");
543      Assertion (Head (L) = '1', "** ID04: List item is not correct");
544      Remove (L, 1);
545      Assertion (Head (L) = '3', "** ID05: List item is not correct");
546      Remove (L, 1);
547      Assertion (Head (L) = '5', "** ID06: List item is not correct");
548      Remove (L, 1);
549      Assertion (Length (L) = 0, "** ID07: List length is not zero");
550   end Test_Iterator_Deletion;
551
552   Slist_P1, Slist_P2 : LS.List;
553
554   Dlist_P1, Dlist_P2 : LD.List;
555
556begin
557   Put_Line ("Starting list tests");
558
559   Put_Line ("...Single List");
560   Test_Single (Slist_P1, Slist_P2);
561
562   Put_Line ("...Double List");
563   Test_Double (Dlist_P1, Dlist_P2);
564
565   Put_Line ("...List Active Iterator");
566   Put_Line ("   Single");
567   Test_Active_Iterator (Slist_P1);
568   Put_Line ("   Double");
569   Test_Active_Iterator (Dlist_P1);
570
571   Put_Line ("...List Passive Iterator");
572   Put_Line ("   Single");
573   Test_Passive_Iterator (Slist_P1);
574   Put_Line ("   Double");
575   Test_Passive_Iterator (Dlist_P1);
576
577   Put_Line ("...List Iterator Deletion");
578   Put_Line ("   Single:");
579   Test_Iterator_Deletion (Slist_P1);
580   Put_Line ("   Double:");
581   Test_Iterator_Deletion (Dlist_P1);
582
583   Put_Line ("Completed list tests");
584
585exception
586   when E : others =>
587      Put_Line ("                                   EXCEPTION "
588                & Ada.Exceptions.Exception_Name (E)
589                & " OCCURRED.");
590end List_Test;
591