1*f2a19305Safresh1use strict; use warnings; 2b39c5158Smillertuse Memoize qw(memoize unmemoize); 3*f2a19305Safresh1use Test::More tests => 26; 4b39c5158Smillert 5*f2a19305Safresh1is eval { unmemoize('u') }, undef, 'trying to unmemoize without memoizing fails'; 6*f2a19305Safresh1my $errx = qr/^Could not unmemoize function `u', because it was not memoized to begin with/; 7*f2a19305Safresh1like $@, $errx, '... with the expected error'; 8b39c5158Smillert 9*f2a19305Safresh1sub u {1} 10*f2a19305Safresh1my $sub = \&u; 11*f2a19305Safresh1my $wrapped = memoize('u'); 12*f2a19305Safresh1is \&u, $wrapped, 'trying to memoize succeeds'; 13b39c5158Smillert 14*f2a19305Safresh1is eval { unmemoize('u') }, $sub, 'trying to unmemoize succeeds' or diag $@; 15*f2a19305Safresh1 16*f2a19305Safresh1is \&u, $sub, '... and does in fact unmemoize it'; 17*f2a19305Safresh1 18*f2a19305Safresh1is eval { unmemoize('u') }, undef, 'trying to unmemoize it again fails'; 19*f2a19305Safresh1like $@, $errx, '... with the expected error'; 20*f2a19305Safresh1 21*f2a19305Safresh1# Memoizing a function multiple times separately is not very useful 22*f2a19305Safresh1# but it should not break unmemoize or make memoization lose its mind 23*f2a19305Safresh1 24*f2a19305Safresh1my $ret; 25*f2a19305Safresh1my $dummy = sub { $ret }; 26*f2a19305Safresh1ok memoize $dummy, INSTALL => 'memo1'; 27*f2a19305Safresh1ok memoize $dummy, INSTALL => 'memo2'; 28*f2a19305Safresh1ok defined &memo1, 'memoized once'; 29*f2a19305Safresh1ok defined &memo2, 'memoized twice'; 30*f2a19305Safresh1$@ = ''; 31*f2a19305Safresh1ok eval { unmemoize 'memo1' }, 'unmemoized once'; 32*f2a19305Safresh1is $@, '', '... and no exception'; 33*f2a19305Safresh1$@ = ''; 34*f2a19305Safresh1ok eval { unmemoize 'memo2' }, 'unmemoized twice'; 35*f2a19305Safresh1is $@, '', '... and no exception'; 36*f2a19305Safresh1is \&memo1, $dummy, 'unmemoized installed once'; 37*f2a19305Safresh1is \&memo2, $dummy, 'unmemoized installed twice'; 38*f2a19305Safresh1 39*f2a19305Safresh1my @quux = qw(foo bar baz); 40*f2a19305Safresh1my %memo = map +($_ => memoize $dummy), @quux; 41*f2a19305Safresh1for (@quux) { $ret = $_; is $memo{$_}->(), $_, "\$memo{$_}->() returns $_" } 42*f2a19305Safresh1for (@quux) { undef $ret; is $memo{$_}->(), $_, "\$memo{$_}->() returns $_" } 43*f2a19305Safresh1 44*f2a19305Safresh1my $destroyed = 0; 45*f2a19305Safresh1sub Counted::DESTROY { ++$destroyed } 46*f2a19305Safresh1{ 47*f2a19305Safresh1 my $memo = memoize $dummy, map +( "$_\_CACHE" => [ HASH => bless {}, 'Counted' ] ), qw(LIST SCALAR); 48*f2a19305Safresh1 ok $memo, 'memoize anon'; 49*f2a19305Safresh1 ok eval { unmemoize $memo }, 'unmemoized anon'; 50b39c5158Smillert} 51*f2a19305Safresh1is $destroyed, 2, 'no cyclic references'; 52