t/op/delete.t

   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 }