home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / perl560.zip / t / op / delete.t < prev    next >
Text File  |  2000-01-12  |  4KB  |  124 lines
  1. #!./perl
  2.  
  3. print "1..36\n";
  4.  
  5. # delete() on hash elements
  6.  
  7. $foo{1} = 'a';
  8. $foo{2} = 'b';
  9. $foo{3} = 'c';
  10. $foo{4} = 'd';
  11. $foo{5} = 'e';
  12.  
  13. $foo = delete $foo{2};
  14.  
  15. if ($foo eq 'b') {print "ok 1\n";} else {print "not ok 1 $foo\n";}
  16. unless (exists $foo{2}) {print "ok 2\n";} else {print "not ok 2 $foo{2}\n";}
  17. if ($foo{1} eq 'a') {print "ok 3\n";} else {print "not ok 3\n";}
  18. if ($foo{3} eq 'c') {print "ok 4\n";} else {print "not ok 4\n";}
  19. if ($foo{4} eq 'd') {print "ok 5\n";} else {print "not ok 5\n";}
  20. if ($foo{5} eq 'e') {print "ok 6\n";} else {print "not ok 6\n";}
  21.  
  22. @foo = delete @foo{4, 5};
  23.  
  24. if (@foo == 2) {print "ok 7\n";} else {print "not ok 7 ", @foo+0, "\n";}
  25. if ($foo[0] eq 'd') {print "ok 8\n";} else {print "not ok 8 ", $foo[0], "\n";}
  26. if ($foo[1] eq 'e') {print "ok 9\n";} else {print "not ok 9 ", $foo[1], "\n";}
  27. unless (exists $foo{4}) {print "ok 10\n";} else {print "not ok 10 $foo{4}\n";}
  28. unless (exists $foo{5}) {print "ok 11\n";} else {print "not ok 11 $foo{5}\n";}
  29. if ($foo{1} eq 'a') {print "ok 12\n";} else {print "not ok 12\n";}
  30. if ($foo{3} eq 'c') {print "ok 13\n";} else {print "not ok 13\n";}
  31.  
  32. $foo = join('',values(%foo));
  33. if ($foo eq 'ac' || $foo eq 'ca') {print "ok 14\n";} else {print "not ok 14\n";}
  34.  
  35. foreach $key (keys %foo) {
  36.     delete $foo{$key};
  37. }
  38.  
  39. $foo{'foo'} = 'x';
  40. $foo{'bar'} = 'y';
  41.  
  42. $foo = join('',values(%foo));
  43. print +($foo eq 'xy' || $foo eq 'yx') ? "ok 15\n" : "not ok 15\n";
  44.  
  45. $refhash{"top"}->{"foo"} = "FOO";
  46. $refhash{"top"}->{"bar"} = "BAR";
  47.  
  48. delete $refhash{"top"}->{"bar"};
  49. @list = keys %{$refhash{"top"}};
  50.  
  51. print "@list" eq "foo" ? "ok 16\n" : "not ok 16 @list\n";
  52.  
  53. {
  54.     my %a = ('bar', 33);
  55.     my($a) = \(values %a);
  56.     my $b = \$a{bar};
  57.     my $c = \delete $a{bar};
  58.  
  59.     print "not " unless $a == $b && $b == $c;
  60.     print "ok 17\n";
  61. }
  62.  
  63. # delete() on array elements
  64.  
  65. @foo = ();
  66. $foo[1] = 'a';
  67. $foo[2] = 'b';
  68. $foo[3] = 'c';
  69. $foo[4] = 'd';
  70. $foo[5] = 'e';
  71.  
  72. $foo = delete $foo[2];
  73.  
  74. if ($foo eq 'b') {print "ok 18\n";} else {print "not ok 18 $foo\n";}
  75. unless (exists $foo[2]) {print "ok 19\n";} else {print "not ok 19 $foo[2]\n";}
  76. if ($foo[1] eq 'a') {print "ok 20\n";} else {print "not ok 20\n";}
  77. if ($foo[3] eq 'c') {print "ok 21\n";} else {print "not ok 21\n";}
  78. if ($foo[4] eq 'd') {print "ok 22\n";} else {print "not ok 22\n";}
  79. if ($foo[5] eq 'e') {print "ok 23\n";} else {print "not ok 23\n";}
  80.  
  81. @bar = delete @foo[4,5];
  82.  
  83. if (@bar == 2) {print "ok 24\n";} else {print "not ok 24 ", @bar+0, "\n";}
  84. if ($bar[0] eq 'd') {print "ok 25\n";} else {print "not ok 25 ", $bar[0], "\n";}
  85. if ($bar[1] eq 'e') {print "ok 26\n";} else {print "not ok 26 ", $bar[1], "\n";}
  86. unless (exists $foo[4]) {print "ok 27\n";} else {print "not ok 27 $foo[4]\n";}
  87. unless (exists $foo[5]) {print "ok 28\n";} else {print "not ok 28 $foo[5]\n";}
  88. if ($foo[1] eq 'a') {print "ok 29\n";} else {print "not ok 29\n";}
  89. if ($foo[3] eq 'c') {print "ok 30\n";} else {print "not ok 30\n";}
  90.  
  91. $foo = join('',@foo);
  92. if ($foo eq 'ac') {print "ok 31\n";} else {print "not ok 31\n";}
  93.  
  94. if (@foo == 4) {print "ok 32\n";} else {print "not ok 32\n";}
  95.  
  96. foreach $key (0 .. $#foo) {
  97.     delete $foo[$key];
  98. }
  99.  
  100. if (@foo == 0) {print "ok 33\n";} else {print "not ok 33\n";}
  101.  
  102. $foo[0] = 'x';
  103. $foo[1] = 'y';
  104.  
  105. $foo = "@foo";
  106. print +($foo eq 'x y') ? "ok 34\n" : "not ok 34\n";
  107.  
  108. $refary[0]->[0] = "FOO";
  109. $refary[0]->[3] = "BAR";
  110.  
  111. delete $refary[0]->[3];
  112.  
  113. print @{$refary[0]} == 1 ? "ok 35\n" : "not ok 35 @list\n";
  114.  
  115. {
  116.     my @a = 33;
  117.     my($a) = \(@a);
  118.     my $b = \$a[0];
  119.     my $c = \delete $a[bar];
  120.  
  121.     print "not " unless $a == $b && $b == $c;
  122.     print "ok 36\n";
  123. }
  124.