Add a deparse test

diff --git a/MANIFEST b/MANIFEST
index cae08bd758afb7c54e35a86c7ec108d8f6dae293..e6e04a88295a88f8e573fcf41d040d4eaf90e431 100644 (file)
--- 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 (file)
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 (<DATA>) {
+  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;