gcc/testsuite/gnat.dg/linkedlist.adb

   1 --  { dg-do run }
   2
   3 with Ada.Text_IO; use Ada.Text_IO;
   4 with GNAT;        use GNAT;
   5 with GNAT.Lists;  use GNAT.Lists;
   6
   7 procedure 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
1161 begin
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;
1197 end Linkedlist;