Created
June 26, 2011 22:12
-
-
Save rwstauner/1048051 to your computer and use it in GitHub Desktop.
Perl bug? Weird combination of do, local, and something else? (http://bit.ly/mhaQ4x)
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
# 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?'':'!'; | |
} |
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
# 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' |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment