t/16-recurse.t

   1 #!perl -T
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More tests => 3 * 2 * 5;
   7
   8 use B::RecDeparse;
   9
  10 my @brds = map [ B::RecDeparse->new(level => $_), $_ ], 0, 1, 2, 5, -1;
  11
  12 sub fact {
  13  my $n = shift;
  14
  15  if ($n > 0) {
  16   $n * fact($n - 1);
  17  } else {
  18   return 0;
  19  }
  20 }
  21
  22 my $exp_fact = <<'EXP';
  23 if ($n > 0) {
  24   $n * fact($n - 1);
  25 }
  26 else {
  27   return 0;
  28 }
  29 EXP
  30
  31 sub foo { bar($_[0] + 1) }
  32
  33 sub bar { foo($_[0] - 1) }
  34
  35 my $exp_foo0 = <<'EXP';
  36 bar($_[0] + 1);
  37 EXP
  38
  39 my $exp_foo1 = <<'EXP';
  40 sub {
  41   foo($_[0] - 1);
  42 }->($_[0] + 1);
  43 EXP
  44
  45 my $exp_bar0 = <<'EXP';
  46 foo($_[0] - 1);
  47 EXP
  48
  49 my $exp_bar1 = <<'EXP';
  50 sub {
  51   bar($_[0] + 1);
  52 }->($_[0] - 1);
  53 EXP
  54
  55 my @tests = (
  56  [ \&fact, [ $exp_fact            ], 'fact' ],
  57  [ \&foo,  [ $exp_foo0, $exp_foo1 ], 'foo'  ],
  58  [ \&bar,  [ $exp_bar0, $exp_bar1 ], 'bar'  ],
  59 );
  60
  61 for (@tests) {
  62  my ($code, $exps, $desc) = @$_;
  63
  64  s/^\s*//mg, s/\s*$//mg, $_ = qr/\Q$_\E/ for @$exps;
  65
  66  for my $i (0 .. $#brds) {
  67   my ($brd, $level) = @{$brds[$i]};
  68
  69   my $exp = $exps->[$i];
  70   $exp    = $exps->[-1] unless defined $exp;
  71
  72   my $body = eval {
  73    $brd->coderef2text($code);
  74   };
  75   is $@, '', "deparsing $desc at level $level doesn't croak";
  76
  77   s/^\s*//mg, s/\s*$//mg for $body;
  78
  79   like $body, qr/$exp/, "deparsing $desc at level $level correctly";
  80  }
  81 }