Perl bug? Weird combination of do, local, and something else?

UPDATE: This perl bug has been fixed

I was writing some very simple unit tests last night and was baffled when one didn't work. The code was very simple, something I thought I had done hundreds of times:

return do { local $/; $fh->getline }

But I stumbled upon some weird voodoo... It's extra baffling to me considering this recent post/bug discovery by Brian D Foy.

It's not the same thing, but it seems similar to me. Unfortunately the commit that fixed Brian's bug 93548 does not fix this one.

I refactored the problem down to a pretty small sub, and am further baffled by the minor variations that cause the problem to go away.

Here is the script and the output from various perls... Interestingly this test appears to include another bug that was fixed somewhere between 5.10 and 5.12...

# original weirdness: same result changing local to my and if(){} to bare {}
sub weird {
my ($c) = @_;
if( ref $c ){
return (ref $c eq 'SCALAR' ? 't' : do { local $/; warn "# doing\n"; 'do'; });
}
return 'r';
}
# fix: no local, no my
sub no_vars_in_do {
my ($c) = @_;
if( ref $c ){
return (ref $c eq 'SCALAR' ? 't' : do { 'do'; });
}
return 'r';
}
# fix: no superfluous return after the if block (which is true for all of our tests)
sub no_extra_return {
my ($c) = @_;
if( ref $c ){
return (ref $c eq 'SCALAR' ? 't' : do { local $/; 'do'; });
}
}
# fix: both if(true){} or bare {} cause problems, works without block
sub no_enclosing_block {
my ($c) = @_;
return (ref $c eq 'SCALAR' ? 't' : do { local $/; 'do'; });
return 'r';
}
# fix: use constant true/false values instead of ref $c
sub any_bool {
my ($c) = @_;
if( 1 ){
return ( 0 ? 't' : do { local $/; 'do'; });
}
return 'r';
}
my ($i, @subs) = qw( 0 no_vars_in_do no_extra_return no_enclosing_block weird );
use Config;
printf "# perl %s\n1..%d\n", $Config{git_describe} || sprintf("%vd", $^V), 2 * @subs + 1;
# only run this sub once since we can't reach the 't' outcome
t(any_bool => any_arg => 1, 'do');
for my $s ( @subs ){
t($s, SCALAR => \'s' , 't' );
t($s, other => ['s'], 'do');
}
sub t {
my ($sub, $name, $val, $exp) = @_;
my $r = &$sub( $val );
my $result = ((my $ok = $r eq $exp) ? '' : 'not ') . 'ok';
printf "%s %d # %*s: %10s => '%s' %5s\n",
$result, ++$i, 22 - length($result) - int($i/10), $sub, $name, $r, $ok?'':'!';
}
view raw weirdness.pl hosted with ❤ by GitHub
# perl 5.8.3
# perl 5.10.1
1..9
not ok 1 # any_bool: any_arg => '' !
ok 2 # no_vars_in_do: SCALAR => 't'
ok 3 # no_vars_in_do: other => 'do'
ok 4 # no_extra_return: SCALAR => 't'
ok 5 # no_extra_return: other => 'do'
ok 6 # no_enclosing_block: SCALAR => 't'
ok 7 # no_enclosing_block: other => 'do'
ok 8 # weird: SCALAR => 't'
# doing
not ok 9 # weird: other => '' !
# perl 5.12.3
# perl 5.14.0
# perl 5.15.0 (blead) (c08f093)
1..9
ok 1 # any_bool: any_arg => 'do'
ok 2 # no_vars_in_do: SCALAR => 't'
ok 3 # no_vars_in_do: other => 'do'
ok 4 # no_extra_return: SCALAR => 't'
ok 5 # no_extra_return: other => 'do'
ok 6 # no_enclosing_block: SCALAR => 't'
ok 7 # no_enclosing_block: other => 'do'
ok 8 # weird: SCALAR => 't'
# doing
not ok 9 # weird: other => '' !
# perl v5.15.0-129-g7c2d9d0
1..9
ok 1 # any_bool: any_arg => 'do'
ok 2 # no_vars_in_do: SCALAR => 't'
ok 3 # no_vars_in_do: other => 'do'
ok 4 # no_extra_return: SCALAR => 't'
ok 5 # no_extra_return: other => 'do'
ok 6 # no_enclosing_block: SCALAR => 't'
ok 7 # no_enclosing_block: other => 'do'
ok 8 # weird: SCALAR => 't'
# doing
ok 9 # weird: other => 'do'
view raw weirdness.txt hosted with ❤ by GitHub

Can anybody make sense of this? Am I missing something? Or is this a legitimate perl bug?

UPDATE: I should add that, in my original function, I added a warning to the getline method on the object so that I could tell that it was in fact getting called (inside the do-block), but somehow undef was still being returned in the end.

1 Comment

Leave a comment

Sign in to comment.

About Randy Stauner

user-pic perl -C -E 'say"i \x{2764} ",($^X =~ m#([^/]+)$#)'