1-- { dg-do run } 2 3with Ada.Text_IO; use Ada.Text_IO; 4with GNAT; use GNAT; 5with GNAT.Dynamic_HTables; use GNAT.Dynamic_HTables; 6 7procedure Dynhash is 8 procedure Destroy (Val : in out Integer) is null; 9 function Hash (Key : Integer) return Bucket_Range_Type; 10 11 package DHT is new Dynamic_Hash_Tables 12 (Key_Type => Integer, 13 Value_Type => Integer, 14 No_Value => 0, 15 Expansion_Threshold => 1.3, 16 Expansion_Factor => 2, 17 Compression_Threshold => 0.3, 18 Compression_Factor => 2, 19 "=" => "=", 20 Destroy_Value => Destroy, 21 Hash => Hash); 22 use DHT; 23 24 function Create_And_Populate 25 (Low_Key : Integer; 26 High_Key : Integer; 27 Init_Size : Positive) return Dynamic_Hash_Table; 28 -- Create a hash table with initial size Init_Size and populate it with 29 -- key-value pairs where both keys and values are in the range Low_Key 30 -- .. High_Key. 31 32 procedure Check_Empty 33 (Caller : String; 34 T : Dynamic_Hash_Table; 35 Low_Key : Integer; 36 High_Key : Integer); 37 -- Ensure that 38 -- 39 -- * The key-value pairs count of hash table T is 0. 40 -- * All values for the keys in range Low_Key .. High_Key are 0. 41 42 procedure Check_Keys 43 (Caller : String; 44 Iter : in out Iterator; 45 Low_Key : Integer; 46 High_Key : Integer); 47 -- Ensure that iterator Iter visits every key in the range Low_Key .. 48 -- High_Key exactly once. 49 50 procedure Check_Locked_Mutations 51 (Caller : String; 52 T : in out Dynamic_Hash_Table); 53 -- Ensure that all mutation operations of hash table T are locked 54 55 procedure Check_Size 56 (Caller : String; 57 T : Dynamic_Hash_Table; 58 Exp_Count : Natural); 59 -- Ensure that the count of key-value pairs of hash table T matches 60 -- expected count Exp_Count. Emit an error if this is not the case. 61 62 procedure Test_Create (Init_Size : Positive); 63 -- Verify that all dynamic hash table operations fail on a non-created 64 -- table of size Init_Size. 65 66 procedure Test_Delete_Get_Put_Size 67 (Low_Key : Integer; 68 High_Key : Integer; 69 Exp_Count : Natural; 70 Init_Size : Positive); 71 -- Verify that 72 -- 73 -- * Put properly inserts values in the hash table. 74 -- * Get properly retrieves all values inserted in the table. 75 -- * Delete properly deletes values. 76 -- * The size of the hash table properly reflects the number of key-value 77 -- pairs. 78 -- 79 -- Low_Key and High_Key denote the range of keys to be inserted, retrieved, 80 -- and deleted. Exp_Count is the expected count of key-value pairs n the 81 -- hash table. Init_Size denotes the initial size of the table. 82 83 procedure Test_Iterate 84 (Low_Key : Integer; 85 High_Key : Integer; 86 Init_Size : Positive); 87 -- Verify that iterators 88 -- 89 -- * Properly visit each key exactly once. 90 -- * Mutation operations are properly locked and unlocked during 91 -- iteration. 92 -- 93 -- Low_Key and High_Key denote the range of keys to be inserted, retrieved, 94 -- and deleted. Init_Size denotes the initial size of the table. 95 96 procedure Test_Iterate_Empty (Init_Size : Positive); 97 -- Verify that an iterator over an empty hash table 98 -- 99 -- * Does not visit any key 100 -- * Mutation operations are properly locked and unlocked during 101 -- iteration. 102 -- 103 -- Init_Size denotes the initial size of the table. 104 105 procedure Test_Iterate_Forced 106 (Low_Key : Integer; 107 High_Key : Integer; 108 Init_Size : Positive); 109 -- Verify that an iterator that is forcefully advanced by just Next 110 -- 111 -- * Properly visit each key exactly once. 112 -- * Mutation operations are properly locked and unlocked during 113 -- iteration. 114 -- 115 -- Low_Key and High_Key denote the range of keys to be inserted, retrieved, 116 -- and deleted. Init_Size denotes the initial size of the table. 117 118 procedure Test_Replace 119 (Low_Val : Integer; 120 High_Val : Integer; 121 Init_Size : Positive); 122 -- Verify that Put properly updates the value of a particular key. Low_Val 123 -- and High_Val denote the range of values to be updated. Init_Size denotes 124 -- the initial size of the table. 125 126 procedure Test_Reset 127 (Low_Key : Integer; 128 High_Key : Integer; 129 Init_Size : Positive); 130 -- Verify that Reset properly destroy and recreats a hash table. Low_Key 131 -- and High_Key denote the range of keys to be inserted in the hash table. 132 -- Init_Size denotes the initial size of the table. 133 134 ------------------------- 135 -- Create_And_Populate -- 136 ------------------------- 137 138 function Create_And_Populate 139 (Low_Key : Integer; 140 High_Key : Integer; 141 Init_Size : Positive) return Dynamic_Hash_Table 142 is 143 T : Dynamic_Hash_Table; 144 145 begin 146 T := Create (Init_Size); 147 148 for Key in Low_Key .. High_Key loop 149 Put (T, Key, Key); 150 end loop; 151 152 return T; 153 end Create_And_Populate; 154 155 ----------------- 156 -- Check_Empty -- 157 ----------------- 158 159 procedure Check_Empty 160 (Caller : String; 161 T : Dynamic_Hash_Table; 162 Low_Key : Integer; 163 High_Key : Integer) 164 is 165 Val : Integer; 166 167 begin 168 Check_Size 169 (Caller => Caller, 170 T => T, 171 Exp_Count => 0); 172 173 for Key in Low_Key .. High_Key loop 174 Val := Get (T, Key); 175 176 if Val /= 0 then 177 Put_Line ("ERROR: " & Caller & ": wrong value"); 178 Put_Line ("expected: 0"); 179 Put_Line ("got :" & Val'Img); 180 end if; 181 end loop; 182 end Check_Empty; 183 184 ---------------- 185 -- Check_Keys -- 186 ---------------- 187 188 procedure Check_Keys 189 (Caller : String; 190 Iter : in out Iterator; 191 Low_Key : Integer; 192 High_Key : Integer) 193 is 194 type Bit_Vector is array (Low_Key .. High_Key) of Boolean; 195 pragma Pack (Bit_Vector); 196 197 Count : Natural; 198 Key : Integer; 199 Seen : Bit_Vector := (others => False); 200 201 begin 202 -- Compute the number of outstanding keys that have to be iterated on 203 204 Count := High_Key - Low_Key + 1; 205 206 while Has_Next (Iter) loop 207 Next (Iter, Key); 208 209 if Seen (Key) then 210 Put_Line 211 ("ERROR: " & Caller & ": Check_Keys: duplicate key" & Key'Img); 212 else 213 Seen (Key) := True; 214 Count := Count - 1; 215 end if; 216 end loop; 217 218 -- In the end, all keys must have been iterated on 219 220 if Count /= 0 then 221 for Key in Seen'Range loop 222 if not Seen (Key) then 223 Put_Line 224 ("ERROR: " & Caller & ": Check_Keys: missing key" & Key'Img); 225 end if; 226 end loop; 227 end if; 228 end Check_Keys; 229 230 ---------------------------- 231 -- Check_Locked_Mutations -- 232 ---------------------------- 233 234 procedure Check_Locked_Mutations 235 (Caller : String; 236 T : in out Dynamic_Hash_Table) 237 is 238 begin 239 begin 240 Delete (T, 1); 241 Put_Line ("ERROR: " & Caller & ": Delete: no exception raised"); 242 exception 243 when Iterated => 244 null; 245 when others => 246 Put_Line ("ERROR: " & Caller & ": Delete: unexpected exception"); 247 end; 248 249 begin 250 Destroy (T); 251 Put_Line ("ERROR: " & Caller & ": Destroy: no exception raised"); 252 exception 253 when Iterated => 254 null; 255 when others => 256 Put_Line ("ERROR: " & Caller & ": Destroy: unexpected exception"); 257 end; 258 259 begin 260 Put (T, 1, 1); 261 Put_Line ("ERROR: " & Caller & ": Put: no exception raised"); 262 exception 263 when Iterated => 264 null; 265 when others => 266 Put_Line ("ERROR: " & Caller & ": Put: unexpected exception"); 267 end; 268 269 begin 270 Reset (T); 271 Put_Line ("ERROR: " & Caller & ": Reset: no exception raised"); 272 exception 273 when Iterated => 274 null; 275 when others => 276 Put_Line ("ERROR: " & Caller & ": Reset: unexpected exception"); 277 end; 278 end Check_Locked_Mutations; 279 280 ---------------- 281 -- Check_Size -- 282 ---------------- 283 284 procedure Check_Size 285 (Caller : String; 286 T : Dynamic_Hash_Table; 287 Exp_Count : Natural) 288 is 289 Count : constant Natural := Size (T); 290 291 begin 292 if Count /= Exp_Count then 293 Put_Line ("ERROR: " & Caller & ": Size: wrong value"); 294 Put_Line ("expected:" & Exp_Count'Img); 295 Put_Line ("got :" & Count'Img); 296 end if; 297 end Check_Size; 298 299 ---------- 300 -- Hash -- 301 ---------- 302 303 function Hash (Key : Integer) return Bucket_Range_Type is 304 begin 305 return Bucket_Range_Type (Key); 306 end Hash; 307 308 ----------------- 309 -- Test_Create -- 310 ----------------- 311 312 procedure Test_Create (Init_Size : Positive) is 313 Count : Natural; 314 Iter : Iterator; 315 T : Dynamic_Hash_Table; 316 Val : Integer; 317 318 begin 319 -- Ensure that every routine defined in the API fails on a hash table 320 -- which has not been created yet. 321 322 begin 323 Delete (T, 1); 324 Put_Line ("ERROR: Test_Create: Delete: no exception raised"); 325 exception 326 when Not_Created => 327 null; 328 when others => 329 Put_Line ("ERROR: Test_Create: Delete: unexpected exception"); 330 end; 331 332 begin 333 Destroy (T); 334 Put_Line ("ERROR: Test_Create: Destroy: no exception raised"); 335 exception 336 when Not_Created => 337 null; 338 when others => 339 Put_Line ("ERROR: Test_Create: Destroy: unexpected exception"); 340 end; 341 342 begin 343 Val := Get (T, 1); 344 Put_Line ("ERROR: Test_Create: Get: no exception raised"); 345 exception 346 when Not_Created => 347 null; 348 when others => 349 Put_Line ("ERROR: Test_Create: Get: unexpected exception"); 350 end; 351 352 begin 353 Iter := Iterate (T); 354 Put_Line ("ERROR: Test_Create: Iterate: no exception raised"); 355 exception 356 when Not_Created => 357 null; 358 when others => 359 Put_Line ("ERROR: Test_Create: Iterate: unexpected exception"); 360 end; 361 362 begin 363 Put (T, 1, 1); 364 Put_Line ("ERROR: Test_Create: Put: no exception raised"); 365 exception 366 when Not_Created => 367 null; 368 when others => 369 Put_Line ("ERROR: Test_Create: Put: unexpected exception"); 370 end; 371 372 begin 373 Reset (T); 374 Put_Line ("ERROR: Test_Create: Reset: no exception raised"); 375 exception 376 when Not_Created => 377 null; 378 when others => 379 Put_Line ("ERROR: Test_Create: Reset: unexpected exception"); 380 end; 381 382 begin 383 Count := Size (T); 384 Put_Line ("ERROR: Test_Create: Size: no exception raised"); 385 exception 386 when Not_Created => 387 null; 388 when others => 389 Put_Line ("ERROR: Test_Create: Size: unexpected exception"); 390 end; 391 392 -- Test create 393 394 T := Create (Init_Size); 395 396 -- Clean up the hash table to prevent memory leaks 397 398 Destroy (T); 399 end Test_Create; 400 401 ------------------------------ 402 -- Test_Delete_Get_Put_Size -- 403 ------------------------------ 404 405 procedure Test_Delete_Get_Put_Size 406 (Low_Key : Integer; 407 High_Key : Integer; 408 Exp_Count : Natural; 409 Init_Size : Positive) 410 is 411 Exp_Val : Integer; 412 T : Dynamic_Hash_Table; 413 Val : Integer; 414 415 begin 416 T := Create_And_Populate (Low_Key, High_Key, Init_Size); 417 418 -- Ensure that its size matches an expected value 419 420 Check_Size 421 (Caller => "Test_Delete_Get_Put_Size", 422 T => T, 423 Exp_Count => Exp_Count); 424 425 -- Ensure that every value for the range of keys exists 426 427 for Key in Low_Key .. High_Key loop 428 Val := Get (T, Key); 429 430 if Val /= Key then 431 Put_Line ("ERROR: Test_Delete_Get_Put_Size: Get: wrong value"); 432 Put_Line ("expected:" & Key'Img); 433 Put_Line ("got :" & Val'Img); 434 end if; 435 end loop; 436 437 -- Delete values whose keys are divisible by 10 438 439 for Key in Low_Key .. High_Key loop 440 if Key mod 10 = 0 then 441 Delete (T, Key); 442 end if; 443 end loop; 444 445 -- Ensure that all values whose keys were not deleted still exist 446 447 for Key in Low_Key .. High_Key loop 448 if Key mod 10 = 0 then 449 Exp_Val := 0; 450 else 451 Exp_Val := Key; 452 end if; 453 454 Val := Get (T, Key); 455 456 if Val /= Exp_Val then 457 Put_Line ("ERROR: Test_Delete_Get_Put_Size: Get: wrong value"); 458 Put_Line ("expected:" & Exp_Val'Img); 459 Put_Line ("got :" & Val'Img); 460 end if; 461 end loop; 462 463 -- Delete all values 464 465 for Key in Low_Key .. High_Key loop 466 Delete (T, Key); 467 end loop; 468 469 -- Ensure that the hash table is empty 470 471 Check_Empty 472 (Caller => "Test_Delete_Get_Put_Size", 473 T => T, 474 Low_Key => Low_Key, 475 High_Key => High_Key); 476 477 -- Clean up the hash table to prevent memory leaks 478 479 Destroy (T); 480 end Test_Delete_Get_Put_Size; 481 482 ------------------ 483 -- Test_Iterate -- 484 ------------------ 485 486 procedure Test_Iterate 487 (Low_Key : Integer; 488 High_Key : Integer; 489 Init_Size : Positive) 490 is 491 Iter_1 : Iterator; 492 Iter_2 : Iterator; 493 T : Dynamic_Hash_Table; 494 495 begin 496 T := Create_And_Populate (Low_Key, High_Key, Init_Size); 497 498 -- Obtain an iterator. This action must lock all mutation operations of 499 -- the hash table. 500 501 Iter_1 := Iterate (T); 502 503 -- Ensure that every mutation routine defined in the API fails on a hash 504 -- table with at least one outstanding iterator. 505 506 Check_Locked_Mutations 507 (Caller => "Test_Iterate", 508 T => T); 509 510 -- Obtain another iterator 511 512 Iter_2 := Iterate (T); 513 514 -- Ensure that every mutation is still locked 515 516 Check_Locked_Mutations 517 (Caller => "Test_Iterate", 518 T => T); 519 520 -- Ensure that all keys are iterable. Note that this does not unlock the 521 -- mutation operations of the hash table because Iter_2 is not exhausted 522 -- yet. 523 524 Check_Keys 525 (Caller => "Test_Iterate", 526 Iter => Iter_1, 527 Low_Key => Low_Key, 528 High_Key => High_Key); 529 530 Check_Locked_Mutations 531 (Caller => "Test_Iterate", 532 T => T); 533 534 -- Ensure that all keys are iterable. This action unlocks all mutation 535 -- operations of the hash table because all outstanding iterators have 536 -- been exhausted. 537 538 Check_Keys 539 (Caller => "Test_Iterate", 540 Iter => Iter_2, 541 Low_Key => Low_Key, 542 High_Key => High_Key); 543 544 -- Ensure that all mutation operations are once again callable 545 546 Delete (T, Low_Key); 547 Put (T, Low_Key, Low_Key); 548 Reset (T); 549 550 -- Clean up the hash table to prevent memory leaks 551 552 Destroy (T); 553 end Test_Iterate; 554 555 ------------------------ 556 -- Test_Iterate_Empty -- 557 ------------------------ 558 559 procedure Test_Iterate_Empty (Init_Size : Positive) is 560 Iter : Iterator; 561 Key : Integer; 562 T : Dynamic_Hash_Table; 563 564 begin 565 T := Create_And_Populate (0, -1, Init_Size); 566 567 -- Obtain an iterator. This action must lock all mutation operations of 568 -- the hash table. 569 570 Iter := Iterate (T); 571 572 -- Ensure that every mutation routine defined in the API fails on a hash 573 -- table with at least one outstanding iterator. 574 575 Check_Locked_Mutations 576 (Caller => "Test_Iterate_Empty", 577 T => T); 578 579 -- Attempt to iterate over the keys 580 581 while Has_Next (Iter) loop 582 Next (Iter, Key); 583 584 Put_Line ("ERROR: Test_Iterate_Empty: key" & Key'Img & " exists"); 585 end loop; 586 587 -- Ensure that all mutation operations are once again callable 588 589 Delete (T, 1); 590 Put (T, 1, 1); 591 Reset (T); 592 593 -- Clean up the hash table to prevent memory leaks 594 595 Destroy (T); 596 end Test_Iterate_Empty; 597 598 ------------------------- 599 -- Test_Iterate_Forced -- 600 ------------------------- 601 602 procedure Test_Iterate_Forced 603 (Low_Key : Integer; 604 High_Key : Integer; 605 Init_Size : Positive) 606 is 607 Iter : Iterator; 608 Key : Integer; 609 T : Dynamic_Hash_Table; 610 611 begin 612 T := Create_And_Populate (Low_Key, High_Key, Init_Size); 613 614 -- Obtain an iterator. This action must lock all mutation operations of 615 -- the hash table. 616 617 Iter := Iterate (T); 618 619 -- Ensure that every mutation routine defined in the API fails on a hash 620 -- table with at least one outstanding iterator. 621 622 Check_Locked_Mutations 623 (Caller => "Test_Iterate_Forced", 624 T => T); 625 626 -- Forcibly advance the iterator until it raises an exception 627 628 begin 629 for Guard in Low_Key .. High_Key + 1 loop 630 Next (Iter, Key); 631 end loop; 632 633 Put_Line 634 ("ERROR: Test_Iterate_Forced: Iterator_Exhausted not raised"); 635 exception 636 when Iterator_Exhausted => 637 null; 638 when others => 639 Put_Line ("ERROR: Test_Iterate_Forced: unexpected exception"); 640 end; 641 642 -- Ensure that all mutation operations are once again callable 643 644 Delete (T, Low_Key); 645 Put (T, Low_Key, Low_Key); 646 Reset (T); 647 648 -- Clean up the hash table to prevent memory leaks 649 650 Destroy (T); 651 end Test_Iterate_Forced; 652 653 ------------------ 654 -- Test_Replace -- 655 ------------------ 656 657 procedure Test_Replace 658 (Low_Val : Integer; 659 High_Val : Integer; 660 Init_Size : Positive) 661 is 662 Key : constant Integer := 1; 663 T : Dynamic_Hash_Table; 664 Val : Integer; 665 666 begin 667 T := Create (Init_Size); 668 669 -- Ensure the Put properly updates values with the same key 670 671 for Exp_Val in Low_Val .. High_Val loop 672 Put (T, Key, Exp_Val); 673 674 Val := Get (T, Key); 675 676 if Val /= Exp_Val then 677 Put_Line ("ERROR: Test_Replace: Get: wrong value"); 678 Put_Line ("expected:" & Exp_Val'Img); 679 Put_Line ("got :" & Val'Img); 680 end if; 681 end loop; 682 683 -- Clean up the hash table to prevent memory leaks 684 685 Destroy (T); 686 end Test_Replace; 687 688 ---------------- 689 -- Test_Reset -- 690 ---------------- 691 692 procedure Test_Reset 693 (Low_Key : Integer; 694 High_Key : Integer; 695 Init_Size : Positive) 696 is 697 T : Dynamic_Hash_Table; 698 699 begin 700 T := Create_And_Populate (Low_Key, High_Key, Init_Size); 701 702 -- Reset the contents of the hash table 703 704 Reset (T); 705 706 -- Ensure that the hash table is empty 707 708 Check_Empty 709 (Caller => "Test_Reset", 710 T => T, 711 Low_Key => Low_Key, 712 High_Key => High_Key); 713 714 -- Clean up the hash table to prevent memory leaks 715 716 Destroy (T); 717 end Test_Reset; 718 719-- Start of processing for Operations 720 721begin 722 Test_Create (Init_Size => 1); 723 Test_Create (Init_Size => 100); 724 725 Test_Delete_Get_Put_Size 726 (Low_Key => 1, 727 High_Key => 1, 728 Exp_Count => 1, 729 Init_Size => 1); 730 731 Test_Delete_Get_Put_Size 732 (Low_Key => 1, 733 High_Key => 1000, 734 Exp_Count => 1000, 735 Init_Size => 32); 736 737 Test_Iterate 738 (Low_Key => 1, 739 High_Key => 32, 740 Init_Size => 32); 741 742 Test_Iterate_Empty (Init_Size => 32); 743 744 Test_Iterate_Forced 745 (Low_Key => 1, 746 High_Key => 32, 747 Init_Size => 32); 748 749 Test_Replace 750 (Low_Val => 1, 751 High_Val => 10, 752 Init_Size => 32); 753 754 Test_Reset 755 (Low_Key => 1, 756 High_Key => 1000, 757 Init_Size => 100); 758end Dynhash; 759