From: Vincent Pit Date: Sat, 2 Jan 2010 21:00:49 +0000 (+0100) Subject: Add a deparse test X-Git-Tag: v0.01~1 X-Git-Url: http://git.vpit.fr/?a=commitdiff_plain;h=7f28e7bb67aa570edf0f62e208ed4da954da07c6;p=perl%2Fmodules%2FSub-Op.git Add a deparse test --- diff --git a/MANIFEST b/MANIFEST index cae08bd..e6e04a8 100644 --- a/MANIFEST +++ b/MANIFEST @@ -11,6 +11,7 @@ sub_op.h samples/try.pl t/10-base.t t/11-existing.t +t/20-deparse.t t/91-pod.t t/92-pod-coverage.t t/95-portability-files.t diff --git a/t/20-deparse.t b/t/20-deparse.t new file mode 100644 index 0000000..199523f --- /dev/null +++ b/t/20-deparse.t @@ -0,0 +1,86 @@ +#!perl + +use strict; +use warnings; + +use blib 't/Sub-Op-LexicalSub'; + +use Test::More tests => 13; + +use Devel::Peek; +use B::Deparse; + +my $bd = B::Deparse->new; + +$bd->ambient_pragmas( + strict => 'all', + warnings => 'all', +); + +{ + local $/ = "####\n"; + while () { + chomp; + s/\s*$//; + my $code = $_; + + my $test = eval <<" TESTCASE"; + sub { + use Sub::Op::LexicalSub f => sub { }; + use Sub::Op::LexicalSub g => sub { }; + $code + } + TESTCASE + if ($@) { + fail "unable to compile testcase: $@"; + next; + } + my $deparsed = $bd->coderef2text($test); + $deparsed =~ s[BEGIN \s* \{ \s* \$\^H \s* \{ .*? \} .*? \} \s*][]gxs; + + my $expected = do { + local *f = sub { }; + local *g = sub { }; + f(); g(); # silence 'once' warnings without setting the bits + my $exp = eval <<" EXPECTED"; + sub { + $code + } + EXPECTED + if ($@) { + fail "unable to compile expected code: $@"; + next; + } + $bd->coderef2text($exp); + }; + + is $deparsed, $expected, "deparsed <$code> is as expected"; + } +} + +__DATA__ +f(); +#### +f; +#### +f(1); +#### +f 1; +#### +f(1, 2); +#### +f 1, 2; +#### +f(1); g(2); +#### +f 1, f(2), 3, g(4, f(g, 5), 6); +#### +&f; +#### +&f(); +#### +&f(1); +#### +&f(1, 2); +#### +my $x = \&f;