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