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