t/11-args.t

   1 #!perl -T
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More tests => 4 * 4 + 4 * 2;
   7
   8 use B::Deparse;
   9 use B::RecDeparse;
  10
  11 my $bd_version = $B::Deparse::VERSION;
  12 {
  13  local $@;
  14  $bd_version = eval $bd_version;
  15  die $@ if $@;
  16 }
  17
  18 sub add ($$) { $_[0] + $_[1] }
  19 sub mul { $_[0] * $_[1] }
  20 sub fma { add mul($_[0], $_[1]), $_[2] }
  21 sub wut { fma $_[0], 2, $_[1] }
  22
  23 my @bd_args = ('', '-sCi0v1');
  24 my @brd_args = ({ }, { deparse => undef }, { deparse => { } }, { deparse => [ ] });
  25
  26 my $bd = B::Deparse->new();
  27 my $reference = $bd->coderef2text(\&wut);
  28 my $i = 1;
  29 for (@brd_args) {
  30  my $brd = B::RecDeparse->new(%$_, level => 0);
  31  my $code = $brd->coderef2text(\&wut);
  32 SKIP: {
  33  skip 'Harmless mismatch on "use warnings" code generation with olders B::Deparse' => 1 if $bd_version < 0.71;
  34  is($code, $reference, "empty deparse and level 0 does the same thing as B::Deparse ($i)");
  35 }
  36  $code = eval 'sub ' . $code;
  37  is($@, '', "result compiles ($i)");
  38  is_deeply( [ defined $code, ref $code ], [ 1, 'CODE' ], "result compiles to a code reference ($i)");
  39  is($code->(1, 3), wut(1, 3), "result compiles to the good thing ($i)");
  40  ++$i;
  41 }
  42
  43 my $bd_opts = '-sCi0v1';
  44 @brd_args = ({ deparse => $bd_opts }, { deparse => [ $bd_opts ] });
  45 for (@brd_args) {
  46  $bd = B::Deparse->new($bd_opts);
  47  my $brd = B::RecDeparse->new(%$_, level => 0);
  48  my $code = $brd->coderef2text(\&wut);
  49  is($code, $bd->coderef2text(\&wut), "B::RecDeparse->new(deparse => '$bd_opts' ), level => 0) does the same thing as B::Deparse->new('$bd_opts') ($i)");
  50  $code = eval 'sub ' . $code;
  51  is($@, '', "result compiles ($i)");
  52  is_deeply( [ defined $code, ref $code ], [ 1, 'CODE' ], "result compiles to a code reference ($i)");
  53  is($code->(1, 3), wut(1, 3), "result compiles to the good thing ($i)");
  54  ++$i;
  55 }