From: Vincent Pit <vince@profvince.com>
Date: Sat, 1 Nov 2008 15:24:58 +0000 (+0100)
Subject: Test function calls in other packages
X-Git-Tag: v0.04~2
X-Git-Url: http://git.vpit.fr/?a=commitdiff_plain;h=9edb72a0842b163cff03a9d816b577e6660c3670;p=perl%2Fmodules%2FB-RecDeparse.git

Test function calls in other packages
---

diff --git a/MANIFEST b/MANIFEST
index 0c9b3e5..48522c7 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -11,6 +11,7 @@ t/11-args.t
 t/12-level.t
 t/13-prototypes.t
 t/14-refs.t
+t/15-pkg.t
 t/20-compile.t
 t/21-single_delim.t
 t/90-boilerplate.t
diff --git a/t/15-pkg.t b/t/15-pkg.t
new file mode 100644
index 0000000..ac1c241
--- /dev/null
+++ b/t/15-pkg.t
@@ -0,0 +1,45 @@
+#!perl -T
+
+use strict;
+use warnings;
+
+use Test::More tests => (3 + 3) * 5;
+
+use B::RecDeparse;
+
+sub wut { Dongs::fma($_[0], 2, $_[1]) }
+sub Dongs::fma { Hlagh::add(main::mul($_[0], $_[1]), $_[2]) }
+sub Hlagh::add { $_[0] + $_[1] }
+sub mul ($$) { $_[0] * $_[1] }
+
+sub which {
+ my ($brd, $yes, $no, $l) = @_;
+ my $code = $brd->coderef2text(\&wut);
+ for (@$yes) {
+  like($code, qr/\b$_\b/, "expansion at level $l contains $_");
+ }
+ for (@$no) {
+  unlike($code, qr/\b$_\b/, "expansion at level $l does not contain $_");
+ }
+ $code = eval 'sub ' . $code;
+ is($@, '', "result compiles at level $l");
+ is_deeply( [ defined $code, ref $code ], [ 1, 'CODE' ], "result compiles to a code reference at level $l");
+ is($code->(1, 3), wut(1, 3), "result compiles to the good thing at level $l");
+}
+
+my $br_args = '-sCi0v1';
+
+my $brd = B::RecDeparse->new(deparse => [ $br_args ], level => -1);
+which $brd, [ ], [ qw/Hlagh::add mul Dongs::fma/ ], -1;
+
+$brd = B::RecDeparse->new(deparse => [ $br_args ], level => 0);
+which $brd, [ qw/fma/ ], [ qw/Hlagh::add mul/ ], 0;
+
+$brd = B::RecDeparse->new(deparse => [ $br_args ], level => 1);
+which $brd, [ qw/add mul/ ], [ qw/Dongs::fma/ ], 1;
+
+$brd = B::RecDeparse->new(deparse => [ $br_args ], level => 2);
+which $brd, [ ], [ qw/Hlagh::add mul Dongs::fma/ ], 2;
+
+$brd = B::RecDeparse->new(deparse => [ $br_args ], level => 3);
+which $brd, [ ], [ qw/Hlagh::add mul Dongs::fma/ ], 2;