]> git.vpit.fr Git - perl/modules/B-RecDeparse.git/blob - t/15-pkg.t
Update VPIT::TestHelpers to 4fb18792
[perl/modules/B-RecDeparse.git] / t / 15-pkg.t
1 #!perl -T
2
3 use strict;
4 use warnings;
5
6 use Test::More tests => (3 + 3) * 5;
7
8 use B::RecDeparse;
9
10 sub wut { Dongs::fma($_[0], 2, $_[1]) }
11 sub Dongs::fma { Hlagh::add(main::mul($_[0], $_[1]), $_[2]) }
12 sub Hlagh::add { $_[0] + $_[1] }
13 sub mul ($$) { $_[0] * $_[1] }
14
15 sub which {
16  my ($brd, $yes, $no, $l) = @_;
17  my $code = $brd->coderef2text(\&wut);
18  for (@$yes) {
19   like($code, qr/\b$_\b/, "expansion at level $l contains $_");
20  }
21  for (@$no) {
22   unlike($code, qr/\b$_\b/, "expansion at level $l does not contain $_");
23  }
24  $code = eval 'sub ' . $code;
25  is($@, '', "result compiles at level $l");
26  is_deeply( [ defined $code, ref $code ], [ 1, 'CODE' ], "result compiles to a code reference at level $l");
27  is($code->(1, 3), wut(1, 3), "result compiles to the good thing at level $l");
28 }
29
30 my $bd_args = '-sCi0v1';
31
32 my $brd = B::RecDeparse->new(deparse => [ $bd_args ], level => -1);
33 which $brd, [ ], [ qw<Hlagh::add mul Dongs::fma> ], -1;
34
35 $brd = B::RecDeparse->new(deparse => [ $bd_args ], level => 0);
36 which $brd, [ qw<fma> ], [ qw<Hlagh::add mul> ], 0;
37
38 $brd = B::RecDeparse->new(deparse => [ $bd_args ], level => 1);
39 which $brd, [ qw<add mul> ], [ qw<Dongs::fma> ], 1;
40
41 $brd = B::RecDeparse->new(deparse => [ $bd_args ], level => 2);
42 which $brd, [ ], [ qw<Hlagh::add mul Dongs::fma> ], 2;
43
44 $brd = B::RecDeparse->new(deparse => [ $bd_args ], level => 3);
45 which $brd, [ ], [ qw<Hlagh::add mul Dongs::fma> ], 2;