t/sub-defer.t

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