1*0Sstevel@tonic-gate#!./perl 2*0Sstevel@tonic-gate 3*0Sstevel@tonic-gateprint "1..37\n"; 4*0Sstevel@tonic-gate 5*0Sstevel@tonic-gate# delete() on hash elements 6*0Sstevel@tonic-gate 7*0Sstevel@tonic-gate$foo{1} = 'a'; 8*0Sstevel@tonic-gate$foo{2} = 'b'; 9*0Sstevel@tonic-gate$foo{3} = 'c'; 10*0Sstevel@tonic-gate$foo{4} = 'd'; 11*0Sstevel@tonic-gate$foo{5} = 'e'; 12*0Sstevel@tonic-gate 13*0Sstevel@tonic-gate$foo = delete $foo{2}; 14*0Sstevel@tonic-gate 15*0Sstevel@tonic-gateif ($foo eq 'b') {print "ok 1\n";} else {print "not ok 1 $foo\n";} 16*0Sstevel@tonic-gateunless (exists $foo{2}) {print "ok 2\n";} else {print "not ok 2 $foo{2}\n";} 17*0Sstevel@tonic-gateif ($foo{1} eq 'a') {print "ok 3\n";} else {print "not ok 3\n";} 18*0Sstevel@tonic-gateif ($foo{3} eq 'c') {print "ok 4\n";} else {print "not ok 4\n";} 19*0Sstevel@tonic-gateif ($foo{4} eq 'd') {print "ok 5\n";} else {print "not ok 5\n";} 20*0Sstevel@tonic-gateif ($foo{5} eq 'e') {print "ok 6\n";} else {print "not ok 6\n";} 21*0Sstevel@tonic-gate 22*0Sstevel@tonic-gate@foo = delete @foo{4, 5}; 23*0Sstevel@tonic-gate 24*0Sstevel@tonic-gateif (@foo == 2) {print "ok 7\n";} else {print "not ok 7 ", @foo+0, "\n";} 25*0Sstevel@tonic-gateif ($foo[0] eq 'd') {print "ok 8\n";} else {print "not ok 8 ", $foo[0], "\n";} 26*0Sstevel@tonic-gateif ($foo[1] eq 'e') {print "ok 9\n";} else {print "not ok 9 ", $foo[1], "\n";} 27*0Sstevel@tonic-gateunless (exists $foo{4}) {print "ok 10\n";} else {print "not ok 10 $foo{4}\n";} 28*0Sstevel@tonic-gateunless (exists $foo{5}) {print "ok 11\n";} else {print "not ok 11 $foo{5}\n";} 29*0Sstevel@tonic-gateif ($foo{1} eq 'a') {print "ok 12\n";} else {print "not ok 12\n";} 30*0Sstevel@tonic-gateif ($foo{3} eq 'c') {print "ok 13\n";} else {print "not ok 13\n";} 31*0Sstevel@tonic-gate 32*0Sstevel@tonic-gate$foo = join('',values(%foo)); 33*0Sstevel@tonic-gateif ($foo eq 'ac' || $foo eq 'ca') {print "ok 14\n";} else {print "not ok 14\n";} 34*0Sstevel@tonic-gate 35*0Sstevel@tonic-gateforeach $key (keys %foo) { 36*0Sstevel@tonic-gate delete $foo{$key}; 37*0Sstevel@tonic-gate} 38*0Sstevel@tonic-gate 39*0Sstevel@tonic-gate$foo{'foo'} = 'x'; 40*0Sstevel@tonic-gate$foo{'bar'} = 'y'; 41*0Sstevel@tonic-gate 42*0Sstevel@tonic-gate$foo = join('',values(%foo)); 43*0Sstevel@tonic-gateprint +($foo eq 'xy' || $foo eq 'yx') ? "ok 15\n" : "not ok 15\n"; 44*0Sstevel@tonic-gate 45*0Sstevel@tonic-gate$refhash{"top"}->{"foo"} = "FOO"; 46*0Sstevel@tonic-gate$refhash{"top"}->{"bar"} = "BAR"; 47*0Sstevel@tonic-gate 48*0Sstevel@tonic-gatedelete $refhash{"top"}->{"bar"}; 49*0Sstevel@tonic-gate@list = keys %{$refhash{"top"}}; 50*0Sstevel@tonic-gate 51*0Sstevel@tonic-gateprint "@list" eq "foo" ? "ok 16\n" : "not ok 16 @list\n"; 52*0Sstevel@tonic-gate 53*0Sstevel@tonic-gate{ 54*0Sstevel@tonic-gate my %a = ('bar', 33); 55*0Sstevel@tonic-gate my($a) = \(values %a); 56*0Sstevel@tonic-gate my $b = \$a{bar}; 57*0Sstevel@tonic-gate my $c = \delete $a{bar}; 58*0Sstevel@tonic-gate 59*0Sstevel@tonic-gate print "not " unless $a == $b && $b == $c; 60*0Sstevel@tonic-gate print "ok 17\n"; 61*0Sstevel@tonic-gate} 62*0Sstevel@tonic-gate 63*0Sstevel@tonic-gate# delete() on array elements 64*0Sstevel@tonic-gate 65*0Sstevel@tonic-gate@foo = (); 66*0Sstevel@tonic-gate$foo[1] = 'a'; 67*0Sstevel@tonic-gate$foo[2] = 'b'; 68*0Sstevel@tonic-gate$foo[3] = 'c'; 69*0Sstevel@tonic-gate$foo[4] = 'd'; 70*0Sstevel@tonic-gate$foo[5] = 'e'; 71*0Sstevel@tonic-gate 72*0Sstevel@tonic-gate$foo = delete $foo[2]; 73*0Sstevel@tonic-gate 74*0Sstevel@tonic-gateif ($foo eq 'b') {print "ok 18\n";} else {print "not ok 18 $foo\n";} 75*0Sstevel@tonic-gateunless (exists $foo[2]) {print "ok 19\n";} else {print "not ok 19 $foo[2]\n";} 76*0Sstevel@tonic-gateif ($foo[1] eq 'a') {print "ok 20\n";} else {print "not ok 20\n";} 77*0Sstevel@tonic-gateif ($foo[3] eq 'c') {print "ok 21\n";} else {print "not ok 21\n";} 78*0Sstevel@tonic-gateif ($foo[4] eq 'd') {print "ok 22\n";} else {print "not ok 22\n";} 79*0Sstevel@tonic-gateif ($foo[5] eq 'e') {print "ok 23\n";} else {print "not ok 23\n";} 80*0Sstevel@tonic-gate 81*0Sstevel@tonic-gate@bar = delete @foo[4,5]; 82*0Sstevel@tonic-gate 83*0Sstevel@tonic-gateif (@bar == 2) {print "ok 24\n";} else {print "not ok 24 ", @bar+0, "\n";} 84*0Sstevel@tonic-gateif ($bar[0] eq 'd') {print "ok 25\n";} else {print "not ok 25 ", $bar[0], "\n";} 85*0Sstevel@tonic-gateif ($bar[1] eq 'e') {print "ok 26\n";} else {print "not ok 26 ", $bar[1], "\n";} 86*0Sstevel@tonic-gateunless (exists $foo[4]) {print "ok 27\n";} else {print "not ok 27 $foo[4]\n";} 87*0Sstevel@tonic-gateunless (exists $foo[5]) {print "ok 28\n";} else {print "not ok 28 $foo[5]\n";} 88*0Sstevel@tonic-gateif ($foo[1] eq 'a') {print "ok 29\n";} else {print "not ok 29\n";} 89*0Sstevel@tonic-gateif ($foo[3] eq 'c') {print "ok 30\n";} else {print "not ok 30\n";} 90*0Sstevel@tonic-gate 91*0Sstevel@tonic-gate$foo = join('',@foo); 92*0Sstevel@tonic-gateif ($foo eq 'ac') {print "ok 31\n";} else {print "not ok 31\n";} 93*0Sstevel@tonic-gate 94*0Sstevel@tonic-gateif (@foo == 4) {print "ok 32\n";} else {print "not ok 32\n";} 95*0Sstevel@tonic-gate 96*0Sstevel@tonic-gateforeach $key (0 .. $#foo) { 97*0Sstevel@tonic-gate delete $foo[$key]; 98*0Sstevel@tonic-gate} 99*0Sstevel@tonic-gate 100*0Sstevel@tonic-gateif (@foo == 0) {print "ok 33\n";} else {print "not ok 33\n";} 101*0Sstevel@tonic-gate 102*0Sstevel@tonic-gate$foo[0] = 'x'; 103*0Sstevel@tonic-gate$foo[1] = 'y'; 104*0Sstevel@tonic-gate 105*0Sstevel@tonic-gate$foo = "@foo"; 106*0Sstevel@tonic-gateprint +($foo eq 'x y') ? "ok 34\n" : "not ok 34\n"; 107*0Sstevel@tonic-gate 108*0Sstevel@tonic-gate$refary[0]->[0] = "FOO"; 109*0Sstevel@tonic-gate$refary[0]->[3] = "BAR"; 110*0Sstevel@tonic-gate 111*0Sstevel@tonic-gatedelete $refary[0]->[3]; 112*0Sstevel@tonic-gate 113*0Sstevel@tonic-gateprint @{$refary[0]} == 1 ? "ok 35\n" : "not ok 35 @list\n"; 114*0Sstevel@tonic-gate 115*0Sstevel@tonic-gate{ 116*0Sstevel@tonic-gate my @a = 33; 117*0Sstevel@tonic-gate my($a) = \(@a); 118*0Sstevel@tonic-gate my $b = \$a[0]; 119*0Sstevel@tonic-gate my $c = \delete $a[bar]; 120*0Sstevel@tonic-gate 121*0Sstevel@tonic-gate print "not " unless $a == $b && $b == $c; 122*0Sstevel@tonic-gate print "ok 36\n"; 123*0Sstevel@tonic-gate} 124*0Sstevel@tonic-gate 125*0Sstevel@tonic-gate{ 126*0Sstevel@tonic-gate # [perl #29127] scalar delete of empty slice returned garbage 127*0Sstevel@tonic-gate my %h; 128*0Sstevel@tonic-gate my ($x,$y) = (1, scalar delete @h{()}); 129*0Sstevel@tonic-gate print "not " if defined $y; 130*0Sstevel@tonic-gate print "ok 37\n"; 131*0Sstevel@tonic-gate} 132