On 01/10/12 23.03, ext Jerry D. Hedden via RT wrote:
Show quoted text> It turns out that there are several other places where this type of
> logic needs to be applied (e.g., push, pop). I'm not going to release
> to CPAN until I have it all down.
Sorry, I have overlooked those. The good news is that they are easily
located and fixed. Only PUSH and UNSHIFT required the extra work.
I have also checked operations on hashes and, as expected, it worked
fine. So basically I checked all routines calling
sharedsv_scalar_store() [which is basically where the problem happens]
and added the fix as required.
Please find below a new context diff against shared.xs 1.41 (including
previously submitted changed), test code follows.
I believe that you have it all down now.
Best regards,
/Philippe.
phil$ diff -c ~/threads-shared-1.41/shared.xs shared.xs
*** /Users/phil/threads-shared-1.41/shared.xs 2012-09-05
19:20:53.000000000 +0200
--- shared.xs 2012-10-02 00:17:36.000000000 +0200
***************
*** 963,970 ****
svp = hv_fetch((HV*) saggregate, key, len, 1);
}
CALLER_CONTEXT;
! Perl_sharedsv_associate(aTHX_ sv, *svp);
! sharedsv_scalar_store(aTHX_ sv, *svp);
LEAVE_LOCK;
return (0);
}
--- 963,976 ----
svp = hv_fetch((HV*) saggregate, key, len, 1);
}
CALLER_CONTEXT;
! {
! U32 dualvar_flags = SvFLAGS(sv) & ( SVf_IOK | SVf_NOK );
! Perl_sharedsv_associate(aTHX_ sv, *svp);
! sharedsv_scalar_store(aTHX_ sv, *svp);
! if(SvPOK(*svp)) {
! SvFLAGS(*svp) |= dualvar_flags; /* restore dualvar flags */
! }
! }
LEAVE_LOCK;
return (0);
}
***************
*** 1266,1275 ****
--- 1272,1283 ----
for (i = 1; i < items; i++) {
SV* tmp = newSVsv(ST(i));
SV *stmp;
+ U32 dualvar_flags = SvFLAGS(tmp) & ( SVf_IOK | SVf_NOK );
ENTER_LOCK;
stmp = S_sharedsv_new_shared(aTHX_ tmp);
sharedsv_scalar_store(aTHX_ tmp, stmp);
SHARED_CONTEXT;
+ if( SvPOK( stmp) ) { SvFLAGS(stmp) |= dualvar_flags; }
av_push((AV*) sobj, stmp);
SvREFCNT_inc_void(stmp);
SHARED_RELEASE;
***************
*** 1289,1297 ****
--- 1297,1307 ----
CALLER_CONTEXT;
for (i = 1; i < items; i++) {
SV *tmp = newSVsv(ST(i));
+ U32 dualvar_flags = SvFLAGS(tmp) & ( SVf_IOK | SVf_NOK );
SV *stmp = S_sharedsv_new_shared(aTHX_ tmp);
sharedsv_scalar_store(aTHX_ tmp, stmp);
SHARED_CONTEXT;
+ if( SvPOK( stmp) ) { SvFLAGS(stmp) |= dualvar_flags; }
av_store((AV*) sobj, i - 1, stmp);
SvREFCNT_inc_void(stmp);
CALLER_CONTEXT;
################################################################
## Test set below, use same header as t/sv_simple.t
################################################################
use constant FOURTYTWO => dualvar(42,'Fourty-Two');
use constant PI => dualvar(3.14,'PI');
# This tests the following operations on shared arrays:
# PUSH, UNSHIFT, POP, SHIFT (others are not significant as they won't
take an SV as input)
## Test POP
my @sa2 : shared = ( FOURTYTWO, FOURTYTWO );
ok(2, $sa2[0] == FOURTYTWO && $sa2[0] eq FOURTYTWO, 'SA2[0] contains a
dualvar');
ok(3, $sa2[1] == FOURTYTWO && $sa2[1] eq FOURTYTWO, 'SA2[1] contains a
dualvar');
ok(4, scalar @sa2 == 2 , 'SA2 is 2 elements long');
my $dv = pop @sa2;
ok(5, $dv == FOURTYTWO, 'IV preserved after pop');
ok(6, $dv eq FOURTYTWO, 'PV preserved after pop');
## Test SHIFT
my $dv2 = shift @sa2;
ok(7, $dv2 == FOURTYTWO, 'IV preserved after shift');
ok(8, $dv2 eq FOURTYTWO, 'PV preserved after shift');
## Test PUSH
my @sa : shared;
push @sa , FOURTYTWO;
ok(9, $sa[0] == FOURTYTWO, 'IV preserved after push');
ok(10, $sa[0] eq FOURTYTWO, 'PV preserved after push');
## Test UNSHIFT
unshift @sa, PI;
ok(11, $sa[1] == FOURTYTWO && $sa[1] eq FOURTYTWO , 'Dualvar FOURTYTWO
now in slot 1');
ok(12, $sa[0] == PI, 'PI.NV preserved after unshift');
ok(13, $sa[0] eq PI, 'PI.PV preserved after unshift');
## Test shared-array to shared-array transfer. @sa3 should contain the
same stuff
my @sa3 : shared = @sa;
ok(14, $sa3[0] == PI && $sa3[0] eq PI &&
$sa3[1] == FOURTYTWO && $sa3[1] eq FOURTYTWO,
'Copy of shared array ok');
#----------------------------------------------------------------------
#
# Test operations on hashes.
# Note that using a dualvar as hash key doesn't make sense, so we only
test the value part.
#
my %sh : shared = ( pi => PI, fourtytwo => FOURTYTWO );
ok (15, (2 == scalar grep { $_ >0 && length $_ > 0 } values %sh) ,
'VALUES returns 2 dualvars');
my $elem = delete $sh{ pi };
ok(16, $elem == PI && $elem eq PI, 'DELETE returns a dualvar');
# Test access via EACH (we have only one element, since previous test
has deleted 'pi')
ok( 17, 1 == scalar keys %sh, 'One key left in hash');
my ($k,$v) = each %sh;
ok(18, $k eq 'fourtytwo', 'Key is "fourtytwo"');
ok(19, $v == FOURTYTWO && $v eq FOURTYTWO, 'Dualvar present');
exit(0);
# EOF
