diff --git a/lib/B/Deparse.t b/lib/B/Deparse.t index 2bb77852f1c8..5e10e6049cd3 100644 --- a/lib/B/Deparse.t +++ b/lib/B/Deparse.t @@ -26,20 +26,18 @@ $/ = "\n####\n"; while () { chomp; $tests ++; - # This code is pinched from the t/lib/common.pl for TODO. - # It's not clear how to avoid duplication my %meta = (context => ''); foreach my $what (qw(skip todo context options)) { - s/^#\s*\U$what\E\s*(.*)\n//m and $meta{$what} = $1; - # If the SKIP reason starts ? then it's taken as a code snippet to - # evaluate. This provides the flexibility to have conditional SKIPs - if ($meta{$what} && $meta{$what} =~ s/^\?//) { - my $temp = eval $meta{$what}; - if ($@) { - die "# In \U$what\E code reason:\n# $meta{$what}\n$@"; - } - $meta{$what} = $temp; - } + s/^#\s*\U$what\E\s*(.*)\n//m and $meta{$what} = $1; + # If the SKIP reason starts ? then it's taken as a code snippet to + # evaluate. This provides the flexibility to have conditional SKIPs + if ($meta{$what} && $meta{$what} =~ s/^\?//) { + my $temp = eval $meta{$what}; + if ($@) { + die "# In \U$what\E code reason:\n# $meta{$what}\n$@"; + } + $meta{$what} = $temp; + } } s/^\s*#\s*(.*)$//mg; @@ -47,23 +45,23 @@ while () { die "Missing name in test $_" unless defined $desc; if ($meta{skip}) { - SKIP: { skip($meta{skip}) }; - next; + SKIP: { skip($meta{skip}) }; + next; } my ($input, $expected); if (/(.*)\n>>>>\n(.*)/s) { - ($input, $expected) = ($1, $2); + ($input, $expected) = ($1, $2); } else { - ($input, $expected) = ($_, $_); + ($input, $expected) = ($_, $_); } # parse options if necessary my $deparse = $meta{options} - ? $deparse{$meta{options}} ||= - B::Deparse->new(split /,/, $meta{options}) - : $deparse; + ? $deparse{$meta{options}} ||= + B::Deparse->new(split /,/, $meta{options}) + : $deparse; my $code = "$meta{context};\n" . <<'EOC' . "sub {$input\n}"; # Tell B::Deparse about our ambient pragmas @@ -73,17 +71,17 @@ EOC local $::TODO = $meta{todo}; if ($@) { - is($@, "", "compilation of $desc") + is($@, "", "compilation of $desc") or diag "=============================================\n" . "CODE:\n--------\n$code\n--------\n" . "=============================================\n"; } else { - my $deparsed = $deparse->coderef2text( $coderef ); - my $regex = $expected; - $regex =~ s/(\S+)/\Q$1/g; - $regex =~ s/\s+/\\s+/g; - $regex = '^\{\s*' . $regex . '\s*\}$'; + my $deparsed = $deparse->coderef2text( $coderef ); + my $regex = $expected; + $regex =~ s/(\S+)/\Q$1/g; + $regex =~ s/\s+/\\s+/g; + $regex = '^\{\s*' . $regex . '\s*\}$'; like($deparsed, qr/$regex/, $desc) or diag "=============================================\n" @@ -115,9 +113,9 @@ my $path = join " ", map { qq["-I$_"] } @INC; $a = `$^X $path "-MO=Deparse" -anlwi.bak -e 1 2>&1`; $a =~ s/-e syntax OK\n//g; -$a =~ s/.*possible typo.*\n//; # Remove warning line -$a =~ s/.*-i used with no filenames.*\n//; # Remove warning line -$b = quotemeta <<'EOF'; +$a =~ s/.*possible typo.*\n//; # Remove warning line +$a =~ s/.*-i used with no filenames.*\n//; # Remove warning line +my $b = quotemeta <<'EOF'; BEGIN { $^I = ".bak"; } BEGIN { $^W = 1; } BEGIN { $/ = "\n"; $\ = "\n"; } @@ -178,7 +176,7 @@ sub test { my $val = shift; my $res = B::Deparse::Wrapper::getcode($val); like($res, qr/use warnings/, - '[perl #35857] [PATCH] B::Deparse doesnt handle warnings register properly'); + '[perl #35857] [PATCH] B::Deparse doesnt handle warnings register properly'); } my ($q,$p); my $x=sub { ++$q,++$p }; @@ -267,15 +265,15 @@ unlike($a, qr/BEGIN/, SKIP: { skip "requires 5.11", 1 unless $] >= 5.011; eval q` - BEGIN { - # Clear out all hints - %^H = (); - $^H = 0; - B::Deparse->new->ambient_pragmas(strict => 'all'); - } - use 5.011; # should enable strict - ok !eval '$do_noT_create_a_variable_with_this_name = 1', - 'ambient_pragmas do not mess with compiling scope'; + BEGIN { + # Clear out all hints + %^H = (); + $^H = 0; + B::Deparse->new->ambient_pragmas(strict => 'all'); + } + use 5.011; # should enable strict + ok !eval '$do_noT_create_a_variable_with_this_name = 1', + 'ambient_pragmas do not mess with compiling scope'; `; } @@ -713,7 +711,7 @@ $test /= 2 if ++$test; # lvalue sub { my $test = sub : lvalue { - my $x; + my $x; } ; } @@ -721,7 +719,7 @@ $test /= 2 if ++$test; # method { my $test = sub : method { - my $x; + my $x; } ; } @@ -1372,8 +1370,8 @@ no warnings; foreach (0..3) { my $x = 2; { - my $x if 0; - print ++$x, "\n"; + my $x if 0; + print ++$x, "\n"; } } #### @@ -1505,7 +1503,7 @@ print /a/u, s/b/c/u; } { BEGIN { $^H{'reflags'} = '0'; - $^H{'reflags_charset'} = '2'; } + $^H{'reflags_charset'} = '2'; } print /a/d, s/b/c/d; } { @@ -1696,7 +1694,7 @@ s/@a(??{ die $b; })//; #### # /(?x)/ /(?x) - /; + /; #### # y///r tr/a/b/r + $a =~ tr/p/q/r; @@ -2265,7 +2263,7 @@ my sub f {} print f(); >>>> my sub f { - + } print f(); #### @@ -2277,7 +2275,7 @@ state sub f {} print f(); >>>> state sub f { - + } print f(); ####