1--  { dg-do run }
2
3with Ada.Text_IO; use Ada.Text_IO;
4with GNAT;        use GNAT;
5with GNAT.Lists;  use GNAT.Lists;
6
7procedure Linkedlist is
8   procedure Destroy (Val : in out Integer) is null;
9
10   package Integer_Lists is new Doubly_Linked_Lists
11     (Element_Type    => Integer,
12      "="             => "=",
13      Destroy_Element => Destroy);
14   use Integer_Lists;
15
16   procedure Check_Empty
17     (Caller    : String;
18      L         : Doubly_Linked_List;
19      Low_Elem  : Integer;
20      High_Elem : Integer);
21   --  Ensure that none of the elements in the range Low_Elem .. High_Elem are
22   --  present in list L, and that the list's length is 0.
23
24   procedure Check_Locked_Mutations
25     (Caller : String;
26      L      : in out Doubly_Linked_List);
27   --  Ensure that all mutation operations of list L are locked
28
29   procedure Check_Present
30     (Caller    : String;
31      L         : Doubly_Linked_List;
32      Low_Elem  : Integer;
33      High_Elem : Integer);
34   --  Ensure that all elements in the range Low_Elem .. High_Elem are present
35   --  in list L.
36
37   procedure Check_Unlocked_Mutations
38     (Caller : String;
39      L      : in out Doubly_Linked_List);
40   --  Ensure that all mutation operations of list L are unlocked
41
42   procedure Populate_With_Append
43     (L         : Doubly_Linked_List;
44      Low_Elem  : Integer;
45      High_Elem : Integer);
46   --  Add elements in the range Low_Elem .. High_Elem in that order in list L
47
48   procedure Test_Append;
49   --  Verify that Append properly inserts at the tail of a list
50
51   procedure Test_Contains
52     (Low_Elem  : Integer;
53      High_Elem : Integer);
54   --  Verify that Contains properly identifies that elements in the range
55   --  Low_Elem .. High_Elem are within a list.
56
57   procedure Test_Create;
58   --  Verify that all list operations fail on a non-created list
59
60   procedure Test_Delete
61     (Low_Elem  : Integer;
62      High_Elem : Integer);
63   --  Verify that Delete properly removes elements in the range Low_Elem ..
64   --  High_Elem from a list.
65
66   procedure Test_Delete_First
67     (Low_Elem  : Integer;
68      High_Elem : Integer);
69   --  Verify that Delete properly removes elements in the range Low_Elem ..
70   --  High_Elem from the head of a list.
71
72   procedure Test_Delete_Last
73     (Low_Elem  : Integer;
74      High_Elem : Integer);
75   --  Verify that Delete properly removes elements in the range Low_Elem ..
76   --  High_Elem from the tail of a list.
77
78   procedure Test_First;
79   --  Verify that First properly returns the head of a list
80
81   procedure Test_Insert_After;
82   --  Verify that Insert_After properly adds an element after some other
83   --  element.
84
85   procedure Test_Insert_Before;
86   --  Vefity that Insert_Before properly adds an element before some other
87   --  element.
88
89   procedure Test_Is_Empty;
90   --  Verify that Is_Empty properly returns this status of a list
91
92   procedure Test_Iterate;
93   --  Verify that iterators properly manipulate mutation operations
94
95   procedure Test_Iterate_Empty;
96   --  Verify that iterators properly manipulate mutation operations of an
97   --  empty list.
98
99   procedure Test_Iterate_Forced
100     (Low_Elem  : Integer;
101      High_Elem : Integer);
102   --  Verify that an iterator that is forcefully advanced by Next properly
103   --  unlocks the mutation operations of a list.
104
105   procedure Test_Last;
106   --  Verify that Last properly returns the tail of a list
107
108   procedure Test_Prepend;
109   --  Verify that Prepend properly inserts at the head of a list
110
111   procedure Test_Replace;
112   --  Verify that Replace properly substitutes old elements with new ones
113
114   procedure Test_Size;
115   --  Verify that Size returns the correct size of a list
116
117   -----------------
118   -- Check_Empty --
119   -----------------
120
121   procedure Check_Empty
122     (Caller    : String;
123      L         : Doubly_Linked_List;
124      Low_Elem  : Integer;
125      High_Elem : Integer)
126   is
127      Len : constant Natural := Size (L);
128
129   begin
130      for Elem in Low_Elem .. High_Elem loop
131         if Contains (L, Elem) then
132            Put_Line ("ERROR: " & Caller & ": extra element" & Elem'Img);
133         end if;
134      end loop;
135
136      if Len /= 0 then
137         Put_Line ("ERROR: " & Caller & ": wrong length");
138         Put_Line ("expected: 0");
139         Put_Line ("got     :" & Len'Img);
140      end if;
141   end Check_Empty;
142
143   ----------------------------
144   -- Check_Locked_Mutations --
145   ----------------------------
146
147   procedure Check_Locked_Mutations
148     (Caller : String;
149      L      : in out Doubly_Linked_List) is
150   begin
151      begin
152         Append (L, 1);
153         Put_Line ("ERROR: " & Caller & ": Append: no exception raised");
154      exception
155         when Iterated =>
156            null;
157         when others =>
158            Put_Line ("ERROR: " & Caller & ": Append: unexpected exception");
159      end;
160
161      begin
162         Delete (L, 1);
163         Put_Line ("ERROR: " & Caller & ": Delete: no exception raised");
164      exception
165         when List_Empty =>
166            null;
167         when Iterated =>
168            null;
169         when others =>
170            Put_Line ("ERROR: " & Caller & ": Delete: unexpected exception");
171      end;
172
173      begin
174         Delete_First (L);
175         Put_Line ("ERROR: " & Caller & ": Delete_First: no exception raised");
176      exception
177         when List_Empty =>
178            null;
179         when Iterated =>
180            null;
181         when others =>
182            Put_Line
183              ("ERROR: " & Caller & ": Delete_First: unexpected exception");
184      end;
185
186      begin
187         Delete_Last (L);
188         Put_Line ("ERROR: " & Caller & ": Delete_List: no exception raised");
189      exception
190         when List_Empty =>
191            null;
192         when Iterated =>
193            null;
194         when others =>
195            Put_Line
196              ("ERROR: " & Caller & ": Delete_Last: unexpected exception");
197      end;
198
199      begin
200         Destroy (L);
201         Put_Line ("ERROR: " & Caller & ": Destroy: no exception raised");
202      exception
203         when Iterated =>
204            null;
205         when others =>
206            Put_Line ("ERROR: " & Caller & ": Destroy: unexpected exception");
207      end;
208
209      begin
210         Insert_After (L, 1, 2);
211         Put_Line ("ERROR: " & Caller & ": Insert_After: no exception raised");
212      exception
213         when Iterated =>
214            null;
215         when others =>
216            Put_Line
217              ("ERROR: " & Caller & ": Insert_After: unexpected exception");
218      end;
219
220      begin
221         Insert_Before (L, 1, 2);
222         Put_Line
223           ("ERROR: " & Caller & ": Insert_Before: no exception raised");
224      exception
225         when Iterated =>
226            null;
227         when others =>
228            Put_Line
229              ("ERROR: " & Caller & ": Insert_Before: unexpected exception");
230      end;
231
232      begin
233         Prepend (L, 1);
234         Put_Line ("ERROR: " & Caller & ": Prepend: no exception raised");
235      exception
236         when Iterated =>
237            null;
238         when others =>
239            Put_Line ("ERROR: " & Caller & ": Prepend: unexpected exception");
240      end;
241
242      begin
243         Replace (L, 1, 2);
244         Put_Line ("ERROR: " & Caller & ": Replace: no exception raised");
245      exception
246         when Iterated =>
247            null;
248         when others =>
249            Put_Line ("ERROR: " & Caller & ": Replace: unexpected exception");
250      end;
251   end Check_Locked_Mutations;
252
253   -------------------
254   -- Check_Present --
255   -------------------
256
257   procedure Check_Present
258     (Caller    : String;
259      L         : Doubly_Linked_List;
260      Low_Elem  : Integer;
261      High_Elem : Integer)
262   is
263      Elem : Integer;
264      Iter : Iterator;
265
266   begin
267      Iter := Iterate (L);
268      for Exp_Elem in Low_Elem .. High_Elem loop
269         Next (Iter, Elem);
270
271         if Elem /= Exp_Elem then
272            Put_Line ("ERROR: " & Caller & ": Check_Present: wrong element");
273            Put_Line ("expected:" & Exp_Elem'Img);
274            Put_Line ("got     :" & Elem'Img);
275         end if;
276      end loop;
277
278      --  At this point all elements should have been accounted for. Check for
279      --  extra elements.
280
281      while Has_Next (Iter) loop
282         Next (Iter, Elem);
283         Put_Line
284           ("ERROR: " & Caller & ": Check_Present: extra element" & Elem'Img);
285      end loop;
286
287   exception
288      when Iterator_Exhausted =>
289         Put_Line
290           ("ERROR: "
291            & Caller
292            & "Check_Present: incorrect number of elements");
293   end Check_Present;
294
295   ------------------------------
296   -- Check_Unlocked_Mutations --
297   ------------------------------
298
299   procedure Check_Unlocked_Mutations
300     (Caller : String;
301      L      : in out Doubly_Linked_List)
302   is
303   begin
304      Append        (L, 1);
305      Append        (L, 2);
306      Append        (L, 3);
307      Delete        (L, 1);
308      Delete_First  (L);
309      Delete_Last   (L);
310      Insert_After  (L, 2, 3);
311      Insert_Before (L, 2, 1);
312      Prepend       (L, 0);
313      Replace       (L, 3, 4);
314   end Check_Unlocked_Mutations;
315
316   --------------------------
317   -- Populate_With_Append --
318   --------------------------
319
320   procedure Populate_With_Append
321     (L         : Doubly_Linked_List;
322      Low_Elem  : Integer;
323      High_Elem : Integer)
324   is
325   begin
326      for Elem in Low_Elem .. High_Elem loop
327         Append (L, Elem);
328      end loop;
329   end Populate_With_Append;
330
331   -----------------
332   -- Test_Append --
333   -----------------
334
335   procedure Test_Append is
336      L : Doubly_Linked_List := Create;
337
338   begin
339      Append (L, 1);
340      Append (L, 2);
341      Append (L, 3);
342      Append (L, 4);
343      Append (L, 5);
344
345      Check_Present
346        (Caller    => "Test_Append",
347         L         => L,
348         Low_Elem  => 1,
349         High_Elem => 5);
350
351      Destroy (L);
352   end Test_Append;
353
354   -------------------
355   -- Test_Contains --
356   -------------------
357
358   procedure Test_Contains
359     (Low_Elem  : Integer;
360      High_Elem : Integer)
361   is
362      Low_Bogus  : constant Integer := Low_Elem  - 1;
363      High_Bogus : constant Integer := High_Elem + 1;
364
365      L : Doubly_Linked_List := Create;
366
367   begin
368      Populate_With_Append (L, Low_Elem, High_Elem);
369
370      --  Ensure that the elements are contained in the list
371
372      for Elem in Low_Elem .. High_Elem loop
373         if not Contains (L, Elem) then
374            Put_Line
375              ("ERROR: Test_Contains: element" & Elem'Img & " not in list");
376         end if;
377      end loop;
378
379      --  Ensure that arbitrary elements which were not inserted in the list
380      --  are not contained in the list.
381
382      if Contains (L, Low_Bogus) then
383         Put_Line
384           ("ERROR: Test_Contains: element" & Low_Bogus'Img & " in list");
385      end if;
386
387      if Contains (L, High_Bogus) then
388         Put_Line
389           ("ERROR: Test_Contains: element" & High_Bogus'Img & " in list");
390      end if;
391
392      Destroy (L);
393   end Test_Contains;
394
395   -----------------
396   -- Test_Create --
397   -----------------
398
399   procedure Test_Create is
400      Count : Natural;
401      Flag  : Boolean;
402      Iter  : Iterator;
403      L     : Doubly_Linked_List;
404      Val   : Integer;
405
406   begin
407      --  Ensure that every routine defined in the API fails on a list which
408      --  has not been created yet.
409
410      begin
411         Append (L, 1);
412         Put_Line ("ERROR: Test_Create: Append: no exception raised");
413      exception
414         when Not_Created =>
415            null;
416         when others =>
417            Put_Line ("ERROR: Test_Create: Append: unexpected exception");
418      end;
419
420      begin
421         Flag := Contains (L, 1);
422         Put_Line ("ERROR: Test_Create: Contains: no exception raised");
423      exception
424         when Not_Created =>
425            null;
426         when others =>
427            Put_Line ("ERROR: Test_Create: Contains: unexpected exception");
428      end;
429
430      begin
431         Delete (L, 1);
432         Put_Line ("ERROR: Test_Create: Delete: no exception raised");
433      exception
434         when Not_Created =>
435            null;
436         when others =>
437            Put_Line ("ERROR: Test_Create: Delete: unexpected exception");
438      end;
439
440      begin
441         Delete_First (L);
442         Put_Line ("ERROR: Test_Create: Delete_First: no exception raised");
443      exception
444         when Not_Created =>
445            null;
446         when others =>
447            Put_Line
448              ("ERROR: Test_Create: Delete_First: unexpected exception");
449      end;
450
451      begin
452         Delete_Last (L);
453         Put_Line ("ERROR: Test_Create: Delete_Last: no exception raised");
454      exception
455         when Not_Created =>
456            null;
457         when others =>
458            Put_Line ("ERROR: Test_Create: Delete_Last: unexpected exception");
459      end;
460
461      begin
462         Val := First (L);
463         Put_Line ("ERROR: Test_Create: First: no exception raised");
464      exception
465         when Not_Created =>
466            null;
467         when others =>
468            Put_Line ("ERROR: Test_Create: First: unexpected exception");
469      end;
470
471      begin
472         Insert_After (L, 1, 2);
473         Put_Line ("ERROR: Test_Create: Insert_After: no exception raised");
474      exception
475         when Not_Created =>
476            null;
477         when others =>
478            Put_Line
479              ("ERROR: Test_Create: Insert_After: unexpected exception");
480      end;
481
482      begin
483         Insert_Before (L, 1, 2);
484         Put_Line ("ERROR: Test_Create: Insert_Before: no exception raised");
485      exception
486         when Not_Created =>
487            null;
488         when others =>
489            Put_Line
490              ("ERROR: Test_Create: Insert_Before: unexpected exception");
491      end;
492
493      begin
494         Flag := Is_Empty (L);
495         Put_Line ("ERROR: Test_Create: Is_Empty: no exception raised");
496      exception
497         when Not_Created =>
498            null;
499         when others =>
500            Put_Line ("ERROR: Test_Create: Is_Empty: unexpected exception");
501      end;
502
503      begin
504         Iter := Iterate (L);
505         Put_Line ("ERROR: Test_Create: Iterate: no exception raised");
506      exception
507         when Not_Created =>
508            null;
509         when others =>
510            Put_Line ("ERROR: Test_Create: Iterate: unexpected exception");
511      end;
512
513      begin
514         Val := Last (L);
515         Put_Line ("ERROR: Test_Create: Last: no exception raised");
516      exception
517         when Not_Created =>
518            null;
519         when others =>
520            Put_Line ("ERROR: Test_Create: Last: unexpected exception");
521      end;
522
523      begin
524         Prepend (L, 1);
525         Put_Line ("ERROR: Test_Create: Prepend: no exception raised");
526      exception
527         when Not_Created =>
528            null;
529         when others =>
530            Put_Line ("ERROR: Test_Create: Prepend: unexpected exception");
531      end;
532
533      begin
534         Replace (L, 1, 2);
535         Put_Line ("ERROR: Test_Create: Replace: no exception raised");
536      exception
537         when Not_Created =>
538            null;
539         when others =>
540            Put_Line ("ERROR: Test_Create: Replace: unexpected exception");
541      end;
542
543      begin
544         Count := Size (L);
545         Put_Line ("ERROR: Test_Create: Size: no exception raised");
546      exception
547         when Not_Created =>
548            null;
549         when others =>
550            Put_Line ("ERROR: Test_Create: Size: unexpected exception");
551      end;
552   end Test_Create;
553
554   -----------------
555   -- Test_Delete --
556   -----------------
557
558   procedure Test_Delete
559     (Low_Elem  : Integer;
560      High_Elem : Integer)
561   is
562      Iter : Iterator;
563      L    : Doubly_Linked_List := Create;
564
565   begin
566      Populate_With_Append (L, Low_Elem, High_Elem);
567
568      --  Delete the first element, which is technically the head
569
570      Delete (L, Low_Elem);
571
572      --  Ensure that all remaining elements except for the head are present in
573      --  the list.
574
575      Check_Present
576        (Caller    => "Test_Delete",
577         L         => L,
578         Low_Elem  => Low_Elem + 1,
579         High_Elem => High_Elem);
580
581      --  Delete the last element, which is technically the tail
582
583      Delete (L, High_Elem);
584
585      --  Ensure that all remaining elements except for the head and tail are
586      --  present in the list.
587
588      Check_Present
589        (Caller    => "Test_Delete",
590         L         => L,
591         Low_Elem  => Low_Elem  + 1,
592         High_Elem => High_Elem - 1);
593
594      --  Delete all even elements
595
596      for Elem in Low_Elem + 1 .. High_Elem - 1 loop
597         if Elem mod 2 = 0 then
598            Delete (L, Elem);
599         end if;
600      end loop;
601
602      --  Ensure that all remaining elements except the head, tail, and even
603      --  elements are present in the list.
604
605      for Elem in Low_Elem + 1 .. High_Elem - 1 loop
606         if Elem mod 2 /= 0 and then not Contains (L, Elem) then
607            Put_Line ("ERROR: Test_Delete: missing element" & Elem'Img);
608         end if;
609      end loop;
610
611      --  Delete all odd elements
612
613      for Elem in Low_Elem + 1 .. High_Elem - 1 loop
614         if Elem mod 2 /= 0 then
615            Delete (L, Elem);
616         end if;
617      end loop;
618
619      --  At this point the list should be completely empty
620
621      Check_Empty
622        (Caller    => "Test_Delete",
623         L         => L,
624         Low_Elem  => Low_Elem,
625         High_Elem => High_Elem);
626
627      --  Try to delete an element. This operation should raise List_Empty.
628
629      begin
630         Delete (L, Low_Elem);
631         Put_Line ("ERROR: Test_Delete: List_Empty not raised");
632      exception
633         when List_Empty =>
634            null;
635         when others =>
636            Put_Line ("ERROR: Test_Delete: unexpected exception");
637      end;
638
639      Destroy (L);
640   end Test_Delete;
641
642   -----------------------
643   -- Test_Delete_First --
644   -----------------------
645
646   procedure Test_Delete_First
647     (Low_Elem  : Integer;
648      High_Elem : Integer)
649   is
650      L : Doubly_Linked_List := Create;
651
652   begin
653      Populate_With_Append (L, Low_Elem, High_Elem);
654
655      --  Delete the head of the list, and verify that the remaining elements
656      --  are still present in the list.
657
658      for Elem in Low_Elem .. High_Elem loop
659         Delete_First (L);
660
661         Check_Present
662           (Caller    => "Test_Delete_First",
663            L         => L,
664            Low_Elem  => Elem + 1,
665            High_Elem => High_Elem);
666      end loop;
667
668      --  At this point the list should be completely empty
669
670      Check_Empty
671        (Caller    => "Test_Delete_First",
672         L         => L,
673         Low_Elem  => Low_Elem,
674         High_Elem => High_Elem);
675
676      --  Try to delete an element. This operation should raise List_Empty.
677
678      begin
679         Delete_First (L);
680         Put_Line ("ERROR: Test_Delete_First: List_Empty not raised");
681      exception
682         when List_Empty =>
683            null;
684         when others =>
685            Put_Line ("ERROR: Test_Delete_First: unexpected exception");
686      end;
687
688      Destroy (L);
689   end Test_Delete_First;
690
691   ----------------------
692   -- Test_Delete_Last --
693   ----------------------
694
695   procedure Test_Delete_Last
696     (Low_Elem  : Integer;
697      High_Elem : Integer)
698   is
699      L : Doubly_Linked_List := Create;
700
701   begin
702      Populate_With_Append (L, Low_Elem, High_Elem);
703
704      --  Delete the tail of the list, and verify that the remaining elements
705      --  are still present in the list.
706
707      for Elem in reverse Low_Elem .. High_Elem loop
708         Delete_Last (L);
709
710         Check_Present
711           (Caller    => "Test_Delete_Last",
712            L         => L,
713            Low_Elem  => Low_Elem,
714            High_Elem => Elem - 1);
715      end loop;
716
717      --  At this point the list should be completely empty
718
719      Check_Empty
720        (Caller    => "Test_Delete_Last",
721         L         => L,
722         Low_Elem  => Low_Elem,
723         High_Elem => High_Elem);
724
725      --  Try to delete an element. This operation should raise List_Empty.
726
727      begin
728         Delete_Last (L);
729         Put_Line ("ERROR: Test_Delete_Last: List_Empty not raised");
730      exception
731         when List_Empty =>
732            null;
733         when others =>
734            Put_Line ("ERROR: Test_Delete_First: unexpected exception");
735      end;
736
737      Destroy (L);
738   end Test_Delete_Last;
739
740   ----------------
741   -- Test_First --
742   ----------------
743
744   procedure Test_First is
745      Elem : Integer;
746      L    : Doubly_Linked_List := Create;
747
748   begin
749      --  Try to obtain the head. This operation should raise List_Empty.
750
751      begin
752         Elem := First (L);
753         Put_Line ("ERROR: Test_First: List_Empty not raised");
754      exception
755         when List_Empty =>
756            null;
757         when others =>
758            Put_Line ("ERROR: Test_First: unexpected exception");
759      end;
760
761      Populate_With_Append (L, 1, 2);
762
763      --  Obtain the head
764
765      Elem := First (L);
766
767      if Elem /= 1 then
768         Put_Line ("ERROR: Test_First: wrong element");
769         Put_Line ("expected: 1");
770         Put_Line ("got     :" & Elem'Img);
771      end if;
772
773      Destroy (L);
774   end Test_First;
775
776   -----------------------
777   -- Test_Insert_After --
778   -----------------------
779
780   procedure Test_Insert_After is
781      L : Doubly_Linked_List := Create;
782
783   begin
784      --  Try to insert after a non-inserted element, in an empty list
785
786      Insert_After (L, 1, 2);
787
788      --  At this point the list should be completely empty
789
790      Check_Empty
791        (Caller    => "Test_Insert_After",
792         L         => L,
793         Low_Elem  => 0,
794         High_Elem => -1);
795
796      Append (L, 1);           --  1
797
798      Insert_After (L, 1, 3);  --  1, 3
799      Insert_After (L, 1, 2);  --  1, 2, 3
800      Insert_After (L, 3, 4);  --  1, 2, 3, 4
801
802      --  Try to insert after a non-inserted element, in a full list
803
804      Insert_After (L, 10, 11);
805
806      Check_Present
807        (Caller    => "Test_Insert_After",
808         L         => L,
809         Low_Elem  => 1,
810         High_Elem => 4);
811
812      Destroy (L);
813   end Test_Insert_After;
814
815   ------------------------
816   -- Test_Insert_Before --
817   ------------------------
818
819   procedure Test_Insert_Before is
820      L : Doubly_Linked_List := Create;
821
822   begin
823      --  Try to insert before a non-inserted element, in an empty list
824
825      Insert_Before (L, 1, 2);
826
827      --  At this point the list should be completely empty
828
829      Check_Empty
830        (Caller    => "Test_Insert_Before",
831         L         => L,
832         Low_Elem  => 0,
833         High_Elem => -1);
834
835      Append (L, 4);            --  4
836
837      Insert_Before (L, 4, 2);  --  2, 4
838      Insert_Before (L, 2, 1);  --  1, 2, 4
839      Insert_Before (L, 4, 3);  --  1, 2, 3, 4
840
841      --  Try to insert before a non-inserted element, in a full list
842
843      Insert_Before (L, 10, 11);
844
845      Check_Present
846        (Caller    => "Test_Insert_Before",
847         L         => L,
848         Low_Elem  => 1,
849         High_Elem => 4);
850
851      Destroy (L);
852   end Test_Insert_Before;
853
854   -------------------
855   -- Test_Is_Empty --
856   -------------------
857
858   procedure Test_Is_Empty is
859      L : Doubly_Linked_List := Create;
860
861   begin
862      if not Is_Empty (L) then
863         Put_Line ("ERROR: Test_Is_Empty: list is not empty");
864      end if;
865
866      Append (L, 1);
867
868      if Is_Empty (L) then
869         Put_Line ("ERROR: Test_Is_Empty: list is empty");
870      end if;
871
872      Delete_First (L);
873
874      if not Is_Empty (L) then
875         Put_Line ("ERROR: Test_Is_Empty: list is not empty");
876      end if;
877
878      Destroy (L);
879   end Test_Is_Empty;
880
881   ------------------
882   -- Test_Iterate --
883   ------------------
884
885   procedure Test_Iterate is
886      Elem   : Integer;
887      Iter_1 : Iterator;
888      Iter_2 : Iterator;
889      L      : Doubly_Linked_List := Create;
890
891   begin
892      Populate_With_Append (L, 1, 5);
893
894      --  Obtain an iterator. This action must lock all mutation operations of
895      --  the list.
896
897      Iter_1 := Iterate (L);
898
899      --  Ensure that every mutation routine defined in the API fails on a list
900      --  with at least one outstanding iterator.
901
902      Check_Locked_Mutations
903        (Caller => "Test_Iterate",
904         L      => L);
905
906      --  Obtain another iterator
907
908      Iter_2 := Iterate (L);
909
910      --  Ensure that every mutation is still locked
911
912      Check_Locked_Mutations
913        (Caller => "Test_Iterate",
914         L      => L);
915
916      --  Exhaust the first itertor
917
918      while Has_Next (Iter_1) loop
919         Next (Iter_1, Elem);
920      end loop;
921
922      --  Ensure that every mutation is still locked
923
924      Check_Locked_Mutations
925        (Caller => "Test_Iterate",
926         L      => L);
927
928      --  Exhaust the second itertor
929
930      while Has_Next (Iter_2) loop
931         Next (Iter_2, Elem);
932      end loop;
933
934      --  Ensure that all mutation operations are once again callable
935
936      Check_Unlocked_Mutations
937        (Caller => "Test_Iterate",
938         L      => L);
939
940      Destroy (L);
941   end Test_Iterate;
942
943   ------------------------
944   -- Test_Iterate_Empty --
945   ------------------------
946
947   procedure Test_Iterate_Empty is
948      Elem : Integer;
949      Iter : Iterator;
950      L    : Doubly_Linked_List := Create;
951
952   begin
953      --  Obtain an iterator. This action must lock all mutation operations of
954      --  the list.
955
956      Iter := Iterate (L);
957
958      --  Ensure that every mutation routine defined in the API fails on a list
959      --  with at least one outstanding iterator.
960
961      Check_Locked_Mutations
962        (Caller => "Test_Iterate_Empty",
963         L      => L);
964
965      --  Attempt to iterate over the elements
966
967      while Has_Next (Iter) loop
968         Next (Iter, Elem);
969
970         Put_Line
971           ("ERROR: Test_Iterate_Empty: element" & Elem'Img & " exists");
972      end loop;
973
974      --  Ensure that all mutation operations are once again callable
975
976      Check_Unlocked_Mutations
977        (Caller => "Test_Iterate_Empty",
978         L      => L);
979
980      Destroy (L);
981   end Test_Iterate_Empty;
982
983   -------------------------
984   -- Test_Iterate_Forced --
985   -------------------------
986
987   procedure Test_Iterate_Forced
988     (Low_Elem  : Integer;
989      High_Elem : Integer)
990   is
991      Elem : Integer;
992      Iter : Iterator;
993      L    : Doubly_Linked_List := Create;
994
995   begin
996      Populate_With_Append (L, Low_Elem, High_Elem);
997
998      --  Obtain an iterator. This action must lock all mutation operations of
999      --  the list.
1000
1001      Iter := Iterate (L);
1002
1003      --  Ensure that every mutation routine defined in the API fails on a list
1004      --  with at least one outstanding iterator.
1005
1006      Check_Locked_Mutations
1007        (Caller => "Test_Iterate_Forced",
1008         L      => L);
1009
1010      --  Forcibly advance the iterator until it raises an exception
1011
1012      begin
1013         for Guard in Low_Elem .. High_Elem + 1 loop
1014            Next (Iter, Elem);
1015         end loop;
1016
1017         Put_Line
1018           ("ERROR: Test_Iterate_Forced: Iterator_Exhausted not raised");
1019      exception
1020         when Iterator_Exhausted =>
1021            null;
1022         when others =>
1023            Put_Line ("ERROR: Test_Iterate_Forced: unexpected exception");
1024      end;
1025
1026      --  Ensure that all mutation operations are once again callable
1027
1028      Check_Unlocked_Mutations
1029        (Caller => "Test_Iterate_Forced",
1030         L      => L);
1031
1032      Destroy (L);
1033   end Test_Iterate_Forced;
1034
1035   ---------------
1036   -- Test_Last --
1037   ---------------
1038
1039   procedure Test_Last is
1040      Elem : Integer;
1041      L    : Doubly_Linked_List := Create;
1042
1043   begin
1044      --  Try to obtain the tail. This operation should raise List_Empty.
1045
1046      begin
1047         Elem := First (L);
1048         Put_Line ("ERROR: Test_Last: List_Empty not raised");
1049      exception
1050         when List_Empty =>
1051            null;
1052         when others =>
1053            Put_Line ("ERROR: Test_Last: unexpected exception");
1054      end;
1055
1056      Populate_With_Append (L, 1, 2);
1057
1058      --  Obtain the tail
1059
1060      Elem := Last (L);
1061
1062      if Elem /= 2 then
1063         Put_Line ("ERROR: Test_Last: wrong element");
1064         Put_Line ("expected: 2");
1065         Put_Line ("got     :" & Elem'Img);
1066      end if;
1067
1068      Destroy (L);
1069   end Test_Last;
1070
1071   ------------------
1072   -- Test_Prepend --
1073   ------------------
1074
1075   procedure Test_Prepend is
1076      L : Doubly_Linked_List := Create;
1077
1078   begin
1079      Prepend (L, 5);
1080      Prepend (L, 4);
1081      Prepend (L, 3);
1082      Prepend (L, 2);
1083      Prepend (L, 1);
1084
1085      Check_Present
1086        (Caller    => "Test_Prepend",
1087         L         => L,
1088         Low_Elem  => 1,
1089         High_Elem => 5);
1090
1091      Destroy (L);
1092   end Test_Prepend;
1093
1094   ------------------
1095   -- Test_Replace --
1096   ------------------
1097
1098   procedure Test_Replace is
1099      L : Doubly_Linked_List := Create;
1100
1101   begin
1102      Populate_With_Append (L, 1, 5);
1103
1104      Replace (L, 3, 8);
1105      Replace (L, 1, 6);
1106      Replace (L, 4, 9);
1107      Replace (L, 5, 10);
1108      Replace (L, 2, 7);
1109
1110      Replace (L, 11, 12);
1111
1112      Check_Present
1113        (Caller    => "Test_Replace",
1114         L         => L,
1115         Low_Elem  => 6,
1116         High_Elem => 10);
1117
1118      Destroy (L);
1119   end Test_Replace;
1120
1121   ---------------
1122   -- Test_Size --
1123   ---------------
1124
1125   procedure Test_Size is
1126      L : Doubly_Linked_List := Create;
1127      S : Natural;
1128
1129   begin
1130      S := Size (L);
1131
1132      if S /= 0 then
1133         Put_Line ("ERROR: Test_Size: wrong size");
1134         Put_Line ("expected: 0");
1135         Put_Line ("got     :" & S'Img);
1136      end if;
1137
1138      Populate_With_Append (L, 1, 2);
1139      S := Size (L);
1140
1141      if S /= 2 then
1142         Put_Line ("ERROR: Test_Size: wrong size");
1143         Put_Line ("expected: 2");
1144         Put_Line ("got     :" & S'Img);
1145      end if;
1146
1147      Populate_With_Append (L, 3, 6);
1148      S := Size (L);
1149
1150      if S /= 6 then
1151         Put_Line ("ERROR: Test_Size: wrong size");
1152         Put_Line ("expected: 6");
1153         Put_Line ("got     :" & S'Img);
1154      end if;
1155
1156      Destroy (L);
1157   end Test_Size;
1158
1159--  Start of processing for Operations
1160
1161begin
1162   Test_Append;
1163
1164   Test_Contains
1165     (Low_Elem  => 1,
1166      High_Elem => 5);
1167
1168   Test_Create;
1169
1170   Test_Delete
1171     (Low_Elem  => 1,
1172      High_Elem => 10);
1173
1174   Test_Delete_First
1175     (Low_Elem  => 1,
1176      High_Elem => 5);
1177
1178   Test_Delete_Last
1179     (Low_Elem  => 1,
1180      High_Elem => 5);
1181
1182   Test_First;
1183   Test_Insert_After;
1184   Test_Insert_Before;
1185   Test_Is_Empty;
1186   Test_Iterate;
1187   Test_Iterate_Empty;
1188
1189   Test_Iterate_Forced
1190     (Low_Elem  => 1,
1191      High_Elem => 5);
1192
1193   Test_Last;
1194   Test_Prepend;
1195   Test_Replace;
1196   Test_Size;
1197end Linkedlist;
1198