Hi,
Class::Std::Slots is broken in the following respect:
although the documentation claims that $ob1->connect('signal',
$ob2,'slot') by default creates only a weak reference to $ob2, it is
not true. The reason is incorrect usage of the function weaken:
Currently the modules does basically the following:
weaken($dst_obj);
push @foo, [$dst_obj,...];
but this stores a strong! reference in [...].
You must do this instead:
my $data = [$dst_obj,...];
weaken($data->[0]);
push @foo, $data;
This is the same as in
$foo = weaken($bar); #INCORRECT
versus
weaken($foo = $bar); #CORRECT
I attach a patch that fixes this. Please consider applying the patch
and making a new release, since this is quite important.
Also, after $ob1->disconnect('signal',$ob2), there still remains
references to $ob2 (preventing it currently from being demolished).
This is because there is a misplaced logical negation in the condition
in a block commented as "Nasty block to filter out matching
connections.". The attached patch fixes this issue as well.
Cheers,
-- Petr
| Subject: | Slots.pm.patch |
--- Slots.pm.orig 2007-07-15 17:46:08.000000000 +0200
+++ Slots.pm 2007-07-15 17:45:17.000000000 +0200
@@ -172,18 +172,15 @@
my $src_id = refaddr($src_obj);
my $caller = ref($src_obj);
- weaken($dst_obj)
- unless $options->{strong}
- || ref($dst_obj) eq 'CODE';
-
_check_signals_exist($caller, $sig_names)
unless $options->{undeclared};
+ my $weaken = !($options->{strong} || ref($dst_obj) eq 'CODE');
for my $sig_name (@{$sig_names}) {
# Stash the object and method so we can call it later.
- push @{$signal_map{$src_id}->{$sig_name}}, [
- $dst_obj, $dst_method, $options
- ];
+ my $dst_data = [ $dst_obj, $dst_method, $options ];
+ weaken($dst_data->[0]) if $weaken;
+ push @{$signal_map{$src_id}->{$sig_name}}, $dst_data;
}
# Now badness: we replace the DESTROY that Class::Std dropped into
@@ -240,9 +237,9 @@
defined $_
&& defined $_->[0]
&& ($dst_id != refaddr($_->[0])
- || (! (defined($dst_method)
+ || ((defined($dst_method)
&& defined($_->[1])
- && ($dst_method eq $_->[1]))) )
+ && ($dst_method ne $_->[1]))) )
} @{$slots};
}
}