1#!./perl 2 3print "1..7\n"; 4 5# Tests bug #22977. Test case from Dave Mitchell. 6sub f ($); 7sub f ($) { 8my $test = $_[0]; 9write; 10format STDOUT = 11ok @<<<<<<< 12$test 13. 14} 15 16f(1); 17f(2); 18 19# A bug caused by the fix for #22977/50528 20sub foo { 21 sub bar { 22 # Fill the pad with alphabet soup, to give the closed-over variable a 23 # high padoffset (more likely to trigger the bug and crash). 24 {my ($a,$b,$c,$d,$e,$f,$g,$h,$i,$j,$k,$l,$m,$n,$o,$p,$q,$r,$s,$t,$u)} 25 {my ($a,$b,$c,$d,$e,$f,$g,$h,$i,$j,$k,$l,$m,$n,$o,$p,$q,$r,$s,$t,$u)} 26 {my ($a,$b,$c,$d,$e,$f,$g,$h,$i,$j,$k,$l,$m,$n,$o,$p,$q,$r,$s,$t,$u)} 27 {my ($a,$b,$c,$d,$e,$f,$g,$h,$i,$j,$k,$l,$m,$n,$o,$p,$q,$r,$s,$t,$u)} 28 {my ($a,$b,$c,$d,$e,$f,$g,$h,$i,$j,$k,$l,$m,$n,$o,$p,$q,$r,$s,$t,$u)} 29 {my ($a,$b,$c,$d,$e,$f,$g,$h,$i,$j,$k,$l,$m,$n,$o,$p,$q,$r,$s,$t,$u)} 30 {my ($a,$b,$c,$d,$e,$f,$g,$h,$i,$j,$k,$l,$m,$n,$o,$p,$q,$r,$s,$t,$u)} 31 {my ($a,$b,$c,$d,$e,$f,$g,$h,$i,$j,$k,$l,$m,$n,$o,$p,$q,$r,$s,$t,$u)} 32 {my ($a,$b,$c,$d,$e,$f,$g,$h,$i,$j,$k,$l,$m,$n,$o,$p,$q,$r,$s,$t,$u)} 33 {my ($a,$b,$c,$d,$e,$f,$g,$h,$i,$j,$k,$l,$m,$n,$o,$p,$q,$r,$s,$t,$u)} 34 {my ($a,$b,$c,$d,$e,$f,$g,$h,$i,$j,$k,$l,$m,$n,$o,$p,$q,$r,$s,$t,$u)} 35 {my ($a,$b,$c,$d,$e,$f,$g,$h,$i,$j,$k,$l,$m,$n,$o,$p,$q,$r,$s,$t,$u)} 36 {my ($a,$b,$c,$d,$e,$f,$g,$h,$i,$j,$k,$l,$m,$n,$o,$p,$q,$r,$s,$t,$u)} 37 {my ($a,$b,$c,$d,$e,$f,$g,$h,$i,$j,$k,$l,$m,$n,$o,$p,$q,$r,$s,$t,$u)} 38 {my ($a,$b,$c,$d,$e,$f,$g,$h,$i,$j,$k,$l,$m,$n,$o,$p,$q,$r,$s,$t,$u)} 39 {my ($a,$b,$c,$d,$e,$f,$g,$h,$i,$j,$k,$l,$m,$n,$o,$p,$q,$r,$s,$t,$u)} 40 {my ($a,$b,$c,$d,$e,$f,$g,$h,$i,$j,$k,$l,$m,$n,$o,$p,$q,$r,$s,$t,$u)} 41 {my ($a,$b,$c,$d,$e,$f,$g,$h,$i,$j,$k,$l,$m,$n,$o,$p,$q,$r,$s,$t,$u)} 42 my $x; 43 format STDOUT2 = 44@<<<<<< 45"ok 3".$x # $x is not available, but this should not crash 46. 47 } 48} 49*STDOUT = *STDOUT2{FORMAT}; 50undef *bar; 51write; 52 53# A regression introduced in 5.10; format cloning would close over the 54# variables in the currently-running sub (the main CV in this test) if the 55# outer sub were an inactive closure. 56sub baz { 57 my $a; 58 sub { 59 $a; 60 {my ($a,$b,$c,$d,$e,$f,$g,$h,$i,$j,$k,$l,$m,$n,$o,$p,$q,$r,$s,$t)} 61 my $x; 62 format STDOUT3 = 63@<<<<<<<<<<<<<<<<<<<<<<<<< 64defined $x ? "not ok 4 - $x" : "ok 4" 65. 66 } 67} 68*STDOUT = *STDOUT3{FORMAT}; 69{ 70 local $^W = 1; 71 my $w; 72 local $SIG{__WARN__} = sub { $w = shift }; 73 write; 74 print "not " unless $w =~ /^Variable "\$x" is not available at/; 75 print "ok 5 - closure var not available when outer sub is inactive\n"; 76} 77 78# Cloning a format whose outside has been undefined 79sub x { 80 {my ($a,$b,$c,$d,$e,$f,$g,$h,$i,$j,$k,$l,$m,$n,$o,$p,$q,$r,$s,$t,$u)} 81 my $z; 82 format STDOUT6 = 83@<<<<<<<<<<<<<<<<<<<<<<<<< 84defined $z ? "not ok 6 - $z" : "ok 6" 85. 86} 87undef &x; 88*STDOUT = *STDOUT6{FORMAT}; 89{ 90 local $^W = 1; 91 my $w; 92 local $SIG{__WARN__} = sub { $w = shift }; 93 write; 94 print "not " unless $w =~ /^Variable "\$z" is not available at/; 95 print "ok 7 - closure var not available when outer sub is undefined\n"; 96} 97