1*0Sstevel@tonic-gate#!./perl 2*0Sstevel@tonic-gate 3*0Sstevel@tonic-gate# $RCSfile: my.t,v $ 4*0Sstevel@tonic-gate 5*0Sstevel@tonic-gateprint "1..33\n"; 6*0Sstevel@tonic-gate 7*0Sstevel@tonic-gatesub foo { 8*0Sstevel@tonic-gate my($a, $b) = @_; 9*0Sstevel@tonic-gate my $c; 10*0Sstevel@tonic-gate my $d; 11*0Sstevel@tonic-gate $c = "ok 3\n"; 12*0Sstevel@tonic-gate $d = "ok 4\n"; 13*0Sstevel@tonic-gate { my($a, undef, $c) = ("ok 9\n", "not ok 10\n", "ok 10\n"); 14*0Sstevel@tonic-gate ($x, $y) = ($a, $c); } 15*0Sstevel@tonic-gate print $a, $b; 16*0Sstevel@tonic-gate $c . $d; 17*0Sstevel@tonic-gate} 18*0Sstevel@tonic-gate 19*0Sstevel@tonic-gate$a = "ok 5\n"; 20*0Sstevel@tonic-gate$b = "ok 6\n"; 21*0Sstevel@tonic-gate$c = "ok 7\n"; 22*0Sstevel@tonic-gate$d = "ok 8\n"; 23*0Sstevel@tonic-gate 24*0Sstevel@tonic-gateprint &foo("ok 1\n","ok 2\n"); 25*0Sstevel@tonic-gate 26*0Sstevel@tonic-gateprint $a,$b,$c,$d,$x,$y; 27*0Sstevel@tonic-gate 28*0Sstevel@tonic-gate# same thing, only with arrays and associative arrays 29*0Sstevel@tonic-gate 30*0Sstevel@tonic-gatesub foo2 { 31*0Sstevel@tonic-gate my($a, @b) = @_; 32*0Sstevel@tonic-gate my(@c, %d); 33*0Sstevel@tonic-gate @c = "ok 13\n"; 34*0Sstevel@tonic-gate $d{''} = "ok 14\n"; 35*0Sstevel@tonic-gate { my($a,@c) = ("ok 19\n", "ok 20\n"); ($x, $y) = ($a, @c); } 36*0Sstevel@tonic-gate print $a, @b; 37*0Sstevel@tonic-gate $c[0] . $d{''}; 38*0Sstevel@tonic-gate} 39*0Sstevel@tonic-gate 40*0Sstevel@tonic-gate$a = "ok 15\n"; 41*0Sstevel@tonic-gate@b = "ok 16\n"; 42*0Sstevel@tonic-gate@c = "ok 17\n"; 43*0Sstevel@tonic-gate$d{''} = "ok 18\n"; 44*0Sstevel@tonic-gate 45*0Sstevel@tonic-gateprint &foo2("ok 11\n","ok 12\n"); 46*0Sstevel@tonic-gate 47*0Sstevel@tonic-gateprint $a,@b,@c,%d,$x,$y; 48*0Sstevel@tonic-gate 49*0Sstevel@tonic-gatemy $i = "outer"; 50*0Sstevel@tonic-gate 51*0Sstevel@tonic-gateif (my $i = "inner") { 52*0Sstevel@tonic-gate print "not " if $i ne "inner"; 53*0Sstevel@tonic-gate} 54*0Sstevel@tonic-gateprint "ok 21\n"; 55*0Sstevel@tonic-gate 56*0Sstevel@tonic-gateif ((my $i = 1) == 0) { 57*0Sstevel@tonic-gate print "not "; 58*0Sstevel@tonic-gate} 59*0Sstevel@tonic-gateelse { 60*0Sstevel@tonic-gate print "not" if $i != 1; 61*0Sstevel@tonic-gate} 62*0Sstevel@tonic-gateprint "ok 22\n"; 63*0Sstevel@tonic-gate 64*0Sstevel@tonic-gatemy $j = 5; 65*0Sstevel@tonic-gatewhile (my $i = --$j) { 66*0Sstevel@tonic-gate print("not "), last unless $i > 0; 67*0Sstevel@tonic-gate} 68*0Sstevel@tonic-gatecontinue { 69*0Sstevel@tonic-gate print("not "), last unless $i > 0; 70*0Sstevel@tonic-gate} 71*0Sstevel@tonic-gateprint "ok 23\n"; 72*0Sstevel@tonic-gate 73*0Sstevel@tonic-gate$j = 5; 74*0Sstevel@tonic-gatefor (my $i = 0; (my $k = $i) < $j; ++$i) { 75*0Sstevel@tonic-gate print("not "), last unless $i >= 0 && $i < $j && $i == $k; 76*0Sstevel@tonic-gate} 77*0Sstevel@tonic-gateprint "ok 24\n"; 78*0Sstevel@tonic-gateprint "not " if defined $k; 79*0Sstevel@tonic-gateprint "ok 25\n"; 80*0Sstevel@tonic-gate 81*0Sstevel@tonic-gateforeach my $i (26, 27) { 82*0Sstevel@tonic-gate print "ok $i\n"; 83*0Sstevel@tonic-gate} 84*0Sstevel@tonic-gate 85*0Sstevel@tonic-gateprint "not " if $i ne "outer"; 86*0Sstevel@tonic-gateprint "ok 28\n"; 87*0Sstevel@tonic-gate 88*0Sstevel@tonic-gate# Ensure that C<my @y> (without parens) doesn't force scalar context. 89*0Sstevel@tonic-gatemy @x; 90*0Sstevel@tonic-gate{ @x = my @y } 91*0Sstevel@tonic-gateprint +(@x ? "not " : ""), "ok 29\n"; 92*0Sstevel@tonic-gate{ @x = my %y } 93*0Sstevel@tonic-gateprint +(@x ? "not " : ""), "ok 30\n"; 94*0Sstevel@tonic-gate 95*0Sstevel@tonic-gate# Found in HTML::FormatPS 96*0Sstevel@tonic-gatemy %fonts = qw(nok 31); 97*0Sstevel@tonic-gatefor my $full (keys %fonts) { 98*0Sstevel@tonic-gate $full =~ s/^n//; 99*0Sstevel@tonic-gate # Supposed to be copy-on-write via force_normal after a THINKFIRST check. 100*0Sstevel@tonic-gate print "$full $fonts{nok}\n"; 101*0Sstevel@tonic-gate} 102*0Sstevel@tonic-gate 103*0Sstevel@tonic-gate# [perl #29340] optimising away the = () left the padav returning the 104*0Sstevel@tonic-gate# array rather than the contents, leading to 'Bizarre copy of array' error 105*0Sstevel@tonic-gate 106*0Sstevel@tonic-gatesub opta { my @a=() } 107*0Sstevel@tonic-gatesub opth { my %h=() } 108*0Sstevel@tonic-gateeval { my $x = opta }; 109*0Sstevel@tonic-gateprint "not " if $@; 110*0Sstevel@tonic-gateprint "ok 32\n"; 111*0Sstevel@tonic-gateeval { my $x = opth }; 112*0Sstevel@tonic-gateprint "not " if $@; 113*0Sstevel@tonic-gateprint "ok 33\n"; 114