1*f2a19305Safresh1use strict; use warnings; 2*f2a19305Safresh1 3*f2a19305Safresh1use Memoize qw(memoize unmemoize); 4*f2a19305Safresh1use Test::More 5*f2a19305Safresh1 ("$]" < 5.009 || "$]" >= 5.010001) && eval { require threads; 1 } 6*f2a19305Safresh1 ? ( tests => 8 ) 7*f2a19305Safresh1 : ( skip_all => $@ ); 8*f2a19305Safresh1 9*f2a19305Safresh1my $i; 10*f2a19305Safresh1sub count_up { ++$i } 11*f2a19305Safresh1 12*f2a19305Safresh1memoize('count_up'); 13*f2a19305Safresh1my $cached = count_up(); 14*f2a19305Safresh1 15*f2a19305Safresh1is count_up(), $cached, 'count_up() is memoized'; 16*f2a19305Safresh1 17*f2a19305Safresh1my $got = threads->new(sub { 18*f2a19305Safresh1 local $@ = ''; 19*f2a19305Safresh1 my $v = eval { count_up() }; 20*f2a19305Safresh1 +{ E => $@, V => $v }; 21*f2a19305Safresh1})->join; 22*f2a19305Safresh1 23*f2a19305Safresh1is $got->{E}, '', 'calling count_up() in another thread works'; 24*f2a19305Safresh1is $got->{V}, $cached, '... and returns the same result'; 25*f2a19305Safresh1is count_up(), $cached, '... whereas count_up() on the main thread is unaffected'; 26*f2a19305Safresh1 27*f2a19305Safresh1$got = threads->new(sub { 28*f2a19305Safresh1 local $@ = ''; 29*f2a19305Safresh1 my $u = eval { unmemoize('count_up') }; 30*f2a19305Safresh1 my $v = eval { count_up() }; 31*f2a19305Safresh1 +{ E => $@, U => $u, V => $v }; 32*f2a19305Safresh1})->join; 33*f2a19305Safresh1 34*f2a19305Safresh1is $got->{E}, '', 'unmemoizing count_up() in another thread works'; 35*f2a19305Safresh1is ref($got->{U}), 'CODE', '... and returns a coderef as expected'; 36*f2a19305Safresh1is $got->{V}, 1+$cached, '... and does in fact unmemoize the function'; 37*f2a19305Safresh1is count_up(), $cached, '... whereas count_up() on the main thread is unaffected'; 38