diff options
author | David Mitchell <davem@iabyn.com> | 2012-10-10 16:32:52 +0100 |
---|---|---|
committer | David Mitchell <davem@iabyn.com> | 2012-10-10 16:39:21 +0100 |
commit | aaaaf4274b748225fa5a628d88665311dcb00b55 (patch) | |
tree | 1797e8be08fd30c531f23bf00d0acbb21c0f6c31 /dist | |
parent | d8e99b9768201060c8fa1d6458d88c8b7081f491 (diff) | |
download | perl-aaaaf4274b748225fa5a628d88665311dcb00b55.tar.gz |
Deparse/t/core.t: add support for lex vars
Enlarge the testing regime: before, for each op it tested
foo($a,$b,$c,...)
now it also does
foo(my $a,$b,$c,...)
my ($a,$b,$c,...); foo($a,$b,$c,...)
Diffstat (limited to 'dist')
-rw-r--r-- | dist/B-Deparse/t/core.t | 73 |
1 files changed, 53 insertions, 20 deletions
diff --git a/dist/B-Deparse/t/core.t b/dist/B-Deparse/t/core.t index 433d26586f..8f4b6e5d2e 100644 --- a/dist/B-Deparse/t/core.t +++ b/dist/B-Deparse/t/core.t @@ -16,6 +16,12 @@ # for weak: CORE::keyword(..) deparsed as CORE::keyword(..) # for strong: CORE::keyword(..) deparsed as keyword(..) # +# Three permutations of lex/nonlex args are checked for: +# +# foo($a,$b,$c,...) +# foo(my $a,$b,$c,...) +# my ($a,$b,$c,...); foo($a,$b,$c,...) +# # Note that tests for prefixing feature.pm-enabled keywords with CORE:: when # feature.pm is not enabled are in deparse.t, as they fit that format better. @@ -30,7 +36,7 @@ BEGIN { use strict; use Test::More; -plan tests => 707; +plan tests => 2063; use feature (sprintf(":%vd", $^V)); # to avoid relying on the feature # logic to add CORE:: @@ -49,31 +55,58 @@ sub testit { $expected_expr //= $expr; $SEEN{$keyword} = 1; - my $code_ref; - { - package test; - use subs (); - import subs $keyword; - $code_ref = eval "no strict 'vars'; sub { () = $expr }" - or die "$@ in $expr"; - } - my $got_text = $deparse->coderef2text($code_ref); + # lex=0: () = foo($a,$b,$c) + # lex=1: my ($a,$b); () = foo($a,$b,$c) + # lex=2: () = foo(my $a,$b,$c) + for my $lex (0, 1, 2) { + if ($lex) { + next if $keyword =~ /local|our|state|my/; + # XXX glob(my $x) incorrectly becomes <my $x> + next if $keyword eq 'glob'; + } + my $vars = $lex == 1 ? 'my($a, $b, $c, $d, $e);' . "\n " : ""; + + if ($lex == 2) { + my $repl = 'my $a'; + if ($expr =~ /\bmap\(\$a|CORE::(chomp|chop|lstat|stat)\b/) { + # for some reason only these do: + # 'foo my $a, $b,' => foo my($a), $b, ... + # the rest don't parenthesize the my var. + $repl = 'my($a)'; + } + s/\$a/$repl/ for $expr, $expected_expr; + } + + my $desc = "$keyword: lex=$lex $expr => $expected_expr"; - unless ($got_text =~ /^{ + + my $code_ref; + { + package test; + use subs (); + import subs $keyword; + $code_ref = eval "no strict 'vars'; sub { ${vars}() = $expr }" + or die "$@ in $expr"; + } + + my $got_text = $deparse->coderef2text($code_ref); + + unless ($got_text =~ /^{ package test; use strict 'refs', 'subs'; - use feature .* - \(\) = (.*) + use feature [^\n]+ + \Q$vars\E\(\) = (.*) }/s) { - ::fail("$keyword: $expr"); - ::diag("couldn't extract line from boilerplate\n"); - ::diag($got_text); - return; - } + ::fail($desc); + ::diag("couldn't extract line from boilerplate\n"); + ::diag($got_text); + return; + } - my $got_expr = $1; - is $got_expr, $expected_expr, "$keyword: $expr => $expected_expr"; + my $got_expr = $1; + is $got_expr, $expected_expr, $desc; + } } |