| Subject: | Memoization of object methods |
Memoizing an object method can produce undesirable results if an object
is dereferenced, a new object is created with the same memory address,
and then a memoized method is called on that object: the memoized result
from when this same method was called on a completely different objet
will be returned.
The following test demonstrates, and the patch introduces a new option
to Memoize for memoizing object methods.
| Subject: | test_patch.t |
package Memoize::TEST::JohnObjectPatch;
use strict; use warnings;
use Test::More tests => 12;
sub new {
my($pkg, %args) = @_;
return bless \%args, $pkg;
}
use Memoize;
memoize('_test_method', SCALAR_CACHE => 'IN_OBJECT', LIST_CACHE => 'IN_OBJECT');
sub _test_method {
my($object, $arg) = @_;
$object->{invocation_count} ||= 0;
$object->{invocation_count}++;
return $arg * 2;
}
sub TEST_THIS_BAD_CLASS {
# Make a simple object
my $object = __PACKAGE__->new;
# Call a memoized method
{
my $value = $object->_test_method(10);
is($value, 20);
is($object->{invocation_count}, 1);
}
# Call again with same arg. Invocation count should not change
{
my $value = $object->_test_method(10);
is($value, 20);
is($object->{invocation_count}, 1);
}
# Call again with different arg
{
my $value = $object->_test_method(11);
is($value, 22);
is($object->{invocation_count}, 2);
}
# Now make $object reference a completely different object
# But still at the same refaddress
# This simulates situations where an object is destroyed, but another
# Object is constructed and given same reference address
my $usurper = __PACKAGE__->new;
%$object = %$usurper;
# We should *not* get the memoized value this time
{
is($object->{invocation_count}, undef);
my $value = $object->_test_method(10);
is($value, 20);
is($object->{invocation_count}, 1);
}
eval {
my $value = _test_method(11);
};
like($@, qr/Method .+_test_method was memoized with /);
# Now check scalar context
{
my @value = $object->_test_method(10);
is_deeply(\@value, [20]);
# Since it's called in list context
# Memoize will invoke the actual method again
# To populate list cache
is($object->{invocation_count}, 2);
}
}
&TEST_THIS_BAD_CLASS;
1;
| Subject: | Memoize.pm.patch |
--- /home/y/lib/perl5/5.8.6/Memoize.pm 2005-01-11 13:36:39.000000000 -0800
+++ /home/wardenj/Memoize.pm.patched 2005-12-07 22:24:35.000000000 -0800
@@ -28,6 +28,7 @@
use Exporter;
use vars qw($DEBUG);
use Config; # Dammit.
+use Scalar::Util 'reftype';
@ISA = qw(Exporter);
@EXPORT = qw(memoize);
@EXPORT_OK = qw(unmemoize flush_cache);
@@ -108,13 +109,18 @@
$options{"${context}_CACHE"} ||= '';
my $cache_opt = $options{"${context}_CACHE"};
+
my @cache_opt_args;
if (ref $cache_opt) {
@cache_opt_args = @$cache_opt;
$cache_opt = shift @cache_opt_args;
}
if ($cache_opt eq 'FAULT') { # no cache
- $caches{$context} = undef;
+ $caches{$context} = undef;
+ }
+ # cache in the instance in which the method is invoked
+ elsif($cache_opt eq 'IN_OBJECT') {
+ $caches{$context} = 'IN_OBJECT';
} elsif ($cache_opt eq 'HASH') { # user-supplied hash
my $cache = $cache_opt_args[0];
my $package = ref(tied %$cache);
@@ -215,6 +221,7 @@
}
}
+
# This is the function that manages the memo tables.
sub _memoizer {
my $orig = shift; # stringized version of ref to original func.
@@ -224,6 +231,15 @@
my $argstr;
my $context = (wantarray() ? LIST : SCALAR);
+ # If we are memoizing in the object itself, then don't include
+ # Object reference in argstring.
+ my $store_in_object = 1 if(
+ $context == SCALAR and $info->{S} eq 'IN_OBJECT'
+ ) or (
+ $context == LIST and $info->{L} eq 'IN_OBJECT'
+ );
+ my $object = shift() if $store_in_object;
+
if (defined $normalizer) {
no strict;
if ($context == SCALAR) {
@@ -237,9 +253,22 @@
local $^W = 0;
$argstr = join chr(28),@_;
}
+
+ # Put object back in @_, 'cause we still need to pass it to method
+ unshift(@_, $object) if $store_in_object;
if ($context == SCALAR) {
my $cache = $info->{S};
+ if($cache eq 'IN_OBJECT') {
+ if(
+ !$object
+ or !(reftype($object) eq 'HASH' or ref($object) eq 'HASH')
+ ) {
+ confess "Method $info->{NAME} was memoized with SCALAR_CACHE => 'IN_OBJECT', which means that the method must always be called on an object";
+ } else {
+ $cache = $object->{'_Memoize::SCALAR_CACHE'} ||= {}
+ }
+ }
_crap_out($info->{NAME}, 'scalar') unless $cache;
if (exists $cache->{$argstr}) {
return $cache->{$argstr};
@@ -255,6 +284,16 @@
}
} elsif ($context == LIST) {
my $cache = $info->{L};
+ if($cache eq 'IN_OBJECT') {
+ if(
+ !$object
+ or !(reftype($object) eq 'HASH' or ref($object) eq 'HASH')
+ ) {
+ confess "Method $info->{NAME} was memoized with LIST_CACHE => 'IN_OBJECT', which means that the method must always be called on an object";
+ } else {
+ $cache = $object->{'_Memoize::LIST_CACHE'} ||= {}
+ }
+ }
_crap_out($info->{NAME}, 'list') unless $cache;
if (exists $cache->{$argstr}) {
my $val = $cache->{$argstr};