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