This issue was originally posted under the subject Object::InsideOut. The following modified example from jdhedden should illustrate the problem:
#!/usr/bin/perl
use strict;
use warnings;
use threads;
use threads::shared;
package Jar;
{
my @jar : shared;
sub new { bless( &threads::shared::share( {} ), shift ); }
sub store {
my ( $self, $cookie ) = @_;
push( @jar, $cookie );
return $jar[-1];
}
sub consume {
pop(@jar);
}
}
package Cookie;
{
sub new {
my $self = bless( &threads::shared::share( {} ), shift );
$self->{contains} = 'chocolate';
return $self;
}
# explicit destructor like OIO objects used to have
sub DESTROY {
delete shift->{contains};
}
}
package main;
MAIN: {
my $jar = Jar->new();
my $cookie = Cookie->new();
print( "\nI like cookies with ", $cookie->{contains} );
$jar->store($cookie);
print("\n...but the jar eats the chocolate out ot my cookie.")
unless ( $jar->consume()->{contains} );
}
print("\nDONE\n");
I believe that this happens during the copying of the object into the global stash inside of shared.xs.
STATIC void
S_get_RV(pTHX_ SV *sv, SV *ssv) {
...
...
if (SvOBJECT(sobj)) {
/* Add any new old blessing */
STRLEN len;
char* stash_ptr = SvPV((SV*) SvSTASH(sobj), len);
HV* stash = gv_stashpvn(stash_ptr, len, TRUE);
SvOBJECT_on(obj);
SvSTASH_set(obj, (HV*)SvREFCNT_inc(stash));
}
}
I have no experience with xs code, so I'm not sure, but it looks to me that only a thin copy of the object was done, not a deep as needed.
|