t/sub-defer.t

   1 use strictures 1;
   2 use Test::More;
   3 use Test::Fatal;
   4 use Sub::Defer;
   5
   6 my %made;
   7
   8 my $one_defer = defer_sub 'Foo::one' => sub {
   9   die "remade - wtf" if $made{'Foo::one'};
  10   $made{'Foo::one'} = sub { 'one' }
  11 };
  12
  13 my $two_defer = defer_sub 'Foo::two' => sub {
  14   die "remade - wtf" if $made{'Foo::two'};
  15   $made{'Foo::two'} = sub { 'two' }
  16 };
  17
  18 is($one_defer, \&Foo::one, 'one defer installed');
  19 is($two_defer, \&Foo::two, 'two defer installed');
  20
  21 is($one_defer->(), 'one', 'one defer runs');
  22
  23 is($made{'Foo::one'}, \&Foo::one, 'one made');
  24
  25 is($made{'Foo::two'}, undef, 'two not made');
  26
  27 is($one_defer->(), 'one', 'one (deferred) still runs');
  28
  29 is(Foo->one, 'one', 'one (undeferred) runs');
  30
  31 is(my $two_made = undefer_sub($two_defer), $made{'Foo::two'}, 'make two');
  32
  33 is exception { undefer_sub($two_defer) }, undef,
  34   "repeated undefer doesn't regenerate";
  35
  36 is($two_made, \&Foo::two, 'two installed');
  37
  38 is($two_defer->(), 'two', 'two (deferred) still runs');
  39
  40 is($two_made->(), 'two', 'two (undeferred) runs');
  41
  42 my $three = sub { 'three' };
  43
  44 is(undefer_sub($three), $three, 'undefer non-deferred is a no-op');
  45
  46 my $four_defer = defer_sub 'Foo::four' => sub {
  47   sub { 'four' }
  48 };
  49 is($four_defer, \&Foo::four, 'four defer installed');
  50
  51 # somebody somewhere wraps up around the deferred installer
  52 no warnings qw/redefine/;
  53 my $orig = Foo->can('four');
  54 *Foo::four = sub {
  55   $orig->() . ' with a twist';
  56 };
  57
  58 is(Foo->four, 'four with a twist', 'around works');
  59 is(Foo->four, 'four with a twist', 'around has not been destroyed by first invocation');
  60
  61 done_testing;