t/sub-quote.t

   1 use strictures 1;
   2 use Test::More;
   3 use Test::Fatal;
   4
   5 use Sub::Quote;
   6
   7 our %EVALED;
   8
   9 my $one = quote_sub q{
  10     BEGIN { $::EVALED{'one'} = 1 }
  11     42
  12 };
  13
  14 my $two = quote_sub q{
  15     BEGIN { $::EVALED{'two'} = 1 }
  16     3 + $x++
  17 } => { '$x' => \do { my $x = 0 } };
  18
  19 ok(!keys %EVALED, 'Nothing evaled yet');
  20
  21 my $u_one = unquote_sub $one;
  22
  23 is_deeply(
  24   [ sort keys %EVALED ], [ qw(one) ],
  25   'subs one evaled'
  26 );
  27
  28 is($one->(), 42, 'One (quoted version)');
  29
  30 is($u_one->(), 42, 'One (unquoted version)');
  31
  32 is($two->(), 3, 'Two (quoted version)');
  33 is(unquote_sub($two)->(), 4, 'Two (unquoted version)');
  34 is($two->(), 5, 'Two (quoted version again)');
  35
  36 my $three = quote_sub 'Foo::three' => q{
  37     $x = $_[1] if $_[1];
  38     die +(caller(0))[3] if @_ > 2;
  39     return $x;
  40 } => { '$x' => \do { my $x = 'spoon' } };
  41
  42 is(Foo->three, 'spoon', 'get ok (named method)');
  43 is(Foo->three('fork'), 'fork', 'set ok (named method)');
  44 is(Foo->three, 'fork', 're-get ok (named method)');
  45 like(
  46   exception { Foo->three(qw(full cutlery set)) }, qr/Foo::three/,
  47   'exception contains correct name'
  48 );
  49
  50 done_testing;