delete.t revision 1.5
1#!./perl 2 3print "1..37\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 15if ($foo eq 'b') {print "ok 1\n";} else {print "not ok 1 $foo\n";} 16unless (exists $foo{2}) {print "ok 2\n";} else {print "not ok 2 $foo{2}\n";} 17if ($foo{1} eq 'a') {print "ok 3\n";} else {print "not ok 3\n";} 18if ($foo{3} eq 'c') {print "ok 4\n";} else {print "not ok 4\n";} 19if ($foo{4} eq 'd') {print "ok 5\n";} else {print "not ok 5\n";} 20if ($foo{5} eq 'e') {print "ok 6\n";} else {print "not ok 6\n";} 21 22@foo = delete @foo{4, 5}; 23 24if (@foo == 2) {print "ok 7\n";} else {print "not ok 7 ", @foo+0, "\n";} 25if ($foo[0] eq 'd') {print "ok 8\n";} else {print "not ok 8 ", $foo[0], "\n";} 26if ($foo[1] eq 'e') {print "ok 9\n";} else {print "not ok 9 ", $foo[1], "\n";} 27unless (exists $foo{4}) {print "ok 10\n";} else {print "not ok 10 $foo{4}\n";} 28unless (exists $foo{5}) {print "ok 11\n";} else {print "not ok 11 $foo{5}\n";} 29if ($foo{1} eq 'a') {print "ok 12\n";} else {print "not ok 12\n";} 30if ($foo{3} eq 'c') {print "ok 13\n";} else {print "not ok 13\n";} 31 32$foo = join('',values(%foo)); 33if ($foo eq 'ac' || $foo eq 'ca') {print "ok 14\n";} else {print "not ok 14\n";} 34 35foreach $key (keys %foo) { 36 delete $foo{$key}; 37} 38 39$foo{'foo'} = 'x'; 40$foo{'bar'} = 'y'; 41 42$foo = join('',values(%foo)); 43print +($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 48delete $refhash{"top"}->{"bar"}; 49@list = keys %{$refhash{"top"}}; 50 51print "@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 74if ($foo eq 'b') {print "ok 18\n";} else {print "not ok 18 $foo\n";} 75unless (exists $foo[2]) {print "ok 19\n";} else {print "not ok 19 $foo[2]\n";} 76if ($foo[1] eq 'a') {print "ok 20\n";} else {print "not ok 20\n";} 77if ($foo[3] eq 'c') {print "ok 21\n";} else {print "not ok 21\n";} 78if ($foo[4] eq 'd') {print "ok 22\n";} else {print "not ok 22\n";} 79if ($foo[5] eq 'e') {print "ok 23\n";} else {print "not ok 23\n";} 80 81@bar = delete @foo[4,5]; 82 83if (@bar == 2) {print "ok 24\n";} else {print "not ok 24 ", @bar+0, "\n";} 84if ($bar[0] eq 'd') {print "ok 25\n";} else {print "not ok 25 ", $bar[0], "\n";} 85if ($bar[1] eq 'e') {print "ok 26\n";} else {print "not ok 26 ", $bar[1], "\n";} 86unless (exists $foo[4]) {print "ok 27\n";} else {print "not ok 27 $foo[4]\n";} 87unless (exists $foo[5]) {print "ok 28\n";} else {print "not ok 28 $foo[5]\n";} 88if ($foo[1] eq 'a') {print "ok 29\n";} else {print "not ok 29\n";} 89if ($foo[3] eq 'c') {print "ok 30\n";} else {print "not ok 30\n";} 90 91$foo = join('',@foo); 92if ($foo eq 'ac') {print "ok 31\n";} else {print "not ok 31\n";} 93 94if (@foo == 4) {print "ok 32\n";} else {print "not ok 32\n";} 95 96foreach $key (0 .. $#foo) { 97 delete $foo[$key]; 98} 99 100if (@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"; 106print +($foo eq 'x y') ? "ok 34\n" : "not ok 34\n"; 107 108$refary[0]->[0] = "FOO"; 109$refary[0]->[3] = "BAR"; 110 111delete $refary[0]->[3]; 112 113print @{$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 125{ 126 # [perl #29127] scalar delete of empty slice returned garbage 127 my %h; 128 my ($x,$y) = (1, scalar delete @h{()}); 129 print "not " if defined $y; 130 print "ok 37\n"; 131} 132