t/05-memoize.t

   1 #!/usr/bin/env perl
   2 use strict;
   3 use warnings;
   4 use Test::More;
   5 use Test::Fatal;
   6 use Test::Requires 'Test::Output';
   7
   8 use Eval::Closure;
   9
  10 {
  11     my $source = <<'SOURCE';
  12     sub {
  13         $foo * 2;
  14     };
  15     BEGIN { warn "foo\n" }
  16 SOURCE
  17
  18     my $code;
  19     my $bar = 15;
  20     stderr_is {
  21         $code = eval_closure(
  22             source      => $source,
  23             environment => {
  24                 '$foo' => \$bar,
  25             },
  26         );
  27     } "foo\n", "BEGIN was run";
  28
  29     is($code->(), 30, "got the right sub");
  30
  31     my $code2;
  32     my $baz = 8;
  33     stderr_is {
  34         $code2 = eval_closure(
  35             source      => $source,
  36             environment => {
  37                 '$foo' => \$baz,
  38             },
  39         );
  40     } '', "BEGIN was not run twice";
  41
  42     is($code2->(), 16, "got the right sub");
  43 }
  44
  45 {
  46     my $source = <<'SOURCE';
  47     sub {
  48         $bar * 2;
  49     };
  50     BEGIN { warn "bar\n" }
  51 SOURCE
  52
  53     my $code;
  54     my $foo = 60;
  55     stderr_is {
  56         $code = eval_closure(
  57             source      => $source,
  58             environment => {
  59                 '$bar' => \$foo,
  60             },
  61             description => 'foo',
  62         );
  63     } "bar\n", "BEGIN was run";
  64
  65     is($code->(), 120, "got the right sub");
  66
  67     my $code2;
  68     my $baz = 23;
  69     { local $TODO = $] < 5.010 ? "description breaks memoization on 5.8"
  70                                : undef;
  71     stderr_is {
  72         $code2 = eval_closure(
  73             source      => $source,
  74             environment => {
  75                 '$bar' => \$baz,
  76             },
  77             description => 'baz',
  78         );
  79     } '', "BEGIN was not run twice";
  80     }
  81
  82     is($code2->(), 46, "got the right sub");
  83 }
  84
  85 {
  86     my $source = <<'SOURCE';
  87     sub {
  88         Carp::confess "baz";
  89     };
  90     BEGIN { warn "baz\n" }
  91 SOURCE
  92
  93     my $code;
  94     stderr_is {
  95         $code = eval_closure(
  96             source      => $source,
  97             description => 'first',
  98         );
  99     } "baz\n", "BEGIN was run";
 100
 101     like(exception { $code->() }, qr/baz at first line 1/,
 102          "got the right description");
 103
 104     my $code2;
 105     { local $TODO = $] < 5.010 ? "description breaks memoization on 5.8"
 106                                : undef;
 107     stderr_is {
 108         $code2 = eval_closure(
 109             source      => $source,
 110             description => 'second',
 111         );
 112     } '', "BEGIN was not run twice";
 113     }
 114
 115     like(exception { $code2->() }, qr/baz at second line 1/,
 116          "got the right description");
 117 }
 118
 119 done_testing;