don't regenerate deferred subs, and store deferred in array
Graham Knop [Wed, 24 Jul 2013 17:21:48 +0000 (13:21 -0400)]
lib/Sub/Defer.pm
t/sub-defer.t

index 0ec2c06..d28daf2 100644 (file)
@@ -16,6 +16,8 @@ sub undefer_sub {
   my ($target, $maker, $undeferred_ref) = @{
     $DEFERRED{$deferred}||return $deferred
   };
+  return ${$undeferred_ref}
+    if ${$undeferred_ref};
   ${$undeferred_ref} = my $made = $maker->();
 
   # make sure the method slot has not changed since deferral time
@@ -26,7 +28,7 @@ sub undefer_sub {
     # _install_coderef calls are not necessary --ribasushi
     *{_getglob($target)} = $made;
   }
-  push @{$DEFERRED{$made} = $DEFERRED{$deferred}}, $made;
+  $DEFERRED{$made} = $DEFERRED{$deferred};
 
   return $made;
 }
@@ -44,7 +46,7 @@ sub defer_sub {
     goto &{$undeferred ||= undefer_sub($deferred_string)};
   };
   $deferred_string = "$deferred";
-  $DEFERRED{$deferred} = [ $target, $maker, \$undeferred ];
+  $DEFERRED{$deferred} = [ $target, $maker, \$undeferred, $deferred ];
   _install_coderef($target => $deferred) if defined $target;
   return $deferred;
 }
index ba7f042..5938dd8 100644 (file)
@@ -1,5 +1,6 @@
 use strictures 1;
 use Test::More;
+use Test::Fatal;
 use Sub::Defer;
 
 my %made;
@@ -29,6 +30,9 @@ is(Foo->one, 'one', 'one (undeferred) runs');
 
 is(my $two_made = undefer_sub($two_defer), $made{'Foo::two'}, 'make two');
 
+is exception { undefer_sub($two_defer) }, undef,
+  "repeated undefer doesn't regenerate";
+
 is($two_made, \&Foo::two, 'two installed');
 
 is($two_defer->(), 'two', 'two (deferred) still runs');