Problem using "local" with "threads::shared" #8207

p5pRT · 2005-11-13T15:13:40Z

Migrated from rt.perl.org#37671 (status was 'open')

Searchable as RT37671$

p5pRT · 2005-11-13T15:13:41Z

From dean@cs.serenevy.net

This is a bug report for perl from dean@cs.serenevy.net,
generated with the help of perlbug 1.35 running under perl v5.8.4.

Localizing variables bound to shared variables can cause the shared
variable to become undefined. The below is a test script which
produces the following output on my machine (tests 9,10 and 19,20
fail):

1..32
Scalars leaked: 1
ok 1 - direct passing (local $_): defined
ok 2 - direct passing (local $_): maintained value
Scalars leaked: 1
ok 3 - direct passing (local $g): defined
ok 4 - direct passing (local $g): maintained value
Scalars leaked: 1
ok 5 - direct passing (my $g): defined
ok 6 - direct passing (my $g): maintained value
Scalars leaked: 1
ok 7 - direct passing (my $x): defined
ok 8 - direct passing (my $x): maintained value
Scalars leaked: 1
not ok 9 - map (local $_): defined
# Failed test at line 42
not ok 10 - map (local $_): maintained value
# Failed test at line 43
Scalars leaked: 1
ok 11 - map (local $g): defined
ok 12 - map (local $g): maintained value
Scalars leaked: 1
ok 13 - map (my $g): defined
ok 14 - map (my $g): maintained value
Scalars leaked: 1
ok 15 - map (my $x): defined
ok 16 - map (my $x): maintained value
ok 17 - for $g (local $_): defined
ok 18 - for $g (local $_): maintained value
not ok 19 - for $g (local $g): defined
# Failed test at line 42
not ok 20 - for $g (local $g): maintained value
# Failed test at line 43
ok 21 - for $g (my $g): defined
ok 22 - for $g (my $g): maintained value
ok 23 - for $g (my $x): defined
ok 24 - for $g (my $x): maintained value
ok 25 - for copy of $g (local $_): defined
ok 26 - for copy of $g (local $_): maintained value
ok 27 - for copy of $g (local $g): defined
ok 28 - for copy of $g (local $g): maintained value
ok 29 - for copy of $g (my $g): defined
ok 30 - for copy of $g (my $g): maintained value
ok 31 - for copy of $g (my $x): defined
ok 32 - for copy of $g (my $x): maintained value

#### BEGIN test script: threads_and_local.t
#!perl -w

# Tests localization in threaded situations
# (localization has been known to cause shared values to become undefined)

use strict;
use Config;

BEGIN {
if (!$Config{useithreads}) {
print "1..0 # Skip: no ithreads\n";
exit;
}
if ($ENV{PERL_CORE_MINITEST}) {
print "1..0 # Skip: no dynamic loading on miniperl, no threads\n";
exit 0;
}
use threads;
use threads::shared;
print "1..32\n";
}

my $value :shared;
our $g;

my $test = 1;
sub ok {
my ($ok, $name) = @_;

# You have to do it this way or VMS will get confused.
print $ok ? "ok $test - $name\n" : "not ok $test - $name\n";

printf "# Failed test at line %d\n", (caller)[2] unless $ok;
$test++;
return $ok;
}

sub test_it {
my ($sub, $message) = @_;
$value = "foo";
threads->create($sub, $value)->join;
ok( defined($value), "$message: defined" );
ok( ($value and $value eq 'foo'), "$message: maintained value" );
}

test_it sub { local__($_[0]) }, 'direct passing (local $_)';
test_it sub { local_g($_[0]) }, 'direct passing (local $g)';
test_it sub { my_g($_[0]) }, 'direct passing (my $g)';
test_it sub { my_x($_[0]) }, 'direct passing (my $x)';

test_it sub { map local__($_), @_ }, 'map (local $_)';
test_it sub { map local_g($_), @_ }, 'map (local $g)';
test_it sub { map my_g($_), @_ }, 'map (my $g)';
test_it sub { map my_x($_), @_ }, 'map (my $x)';

test_it sub { for $g (@_) { local__($g) } }, 'for $g (local $_)';
test_it sub { for $g (@_) { local_g($g) } }, 'for $g (local $g)';
test_it sub { for $g (@_) { my_g($g) } }, 'for $g (my $g)';
test_it sub { for $g (@_) { my_x($g) } }, 'for $g (my $x)';

test_it sub { for (@_) { $g = $_; local__($g) } }, 'for copy of $g (local $_)';
test_it sub { for (@_) { $g = $_; local_g($g) } }, 'for copy of $g (local $g)';
test_it sub { for (@_) { $g = $_; my_g($g) } }, 'for copy of $g (my $g)';
test_it sub { for (@_) { $g = $_; my_x($g) } }, 'for copy of $g (my $x)';

sub local__ {
local $_ = shift;
s/o/a/ if $_;
return $_;
}

sub local_g {
local $g = shift;
$g =~ s/o/a/ if $g;
return $g;
}

sub my_g {
my $g = shift;
$g =~ s/o/a/ if $g;
return $g;
}

sub my_x {
my $x = shift;
$x =~ s/o/a/ if $x;
return $x;
}
#### END test script: threads_and_local.t

Flags:
category=library
severity=low

Site configuration information for perl v5.8.4:

Configured by Debian Project at Tue Mar 8 20:31:23 EST 2005.

Summary of my perl5 (revision 5 version 8 subversion 4) configuration:
Platform:
osname=linux, osvers=2.4.27-ti1211, archname=i386-linux-thread-multi
uname='linux kosh 2.4.27-ti1211 #1 sun sep 19 18:17:45 est 2004 i686 gnulinux '
config_args='-Dusethreads -Duselargefiles -Dccflags=-DDEBIAN -Dcccdlflags=-fPIC -Darchname=i386-linux -Dprefix=/usr -Dprivlib=/usr/share/perl/5.8 -Darchlib=/usr/lib/perl/5.8 -Dvendorprefix=/usr -Dvendorlib=/usr/share/perl5 -Dvendorarch=/usr/lib/perl5 -Dsiteprefix=/usr/local -Dsitelib=/usr/local/share/perl/5.8.4 -Dsitearch=/usr/local/lib/perl/5.8.4 -Dman1dir=/usr/share/man/man1 -Dman3dir=/usr/share/man/man3 -Dsiteman1dir=/usr/local/man/man1 -Dsiteman3dir=/usr/local/man/man3 -Dman1ext=1 -Dman3ext=3perl -Dpager=/usr/bin/sensible-pager -Uafs -Ud_csh -Uusesfio -Uusenm -Duseshrplib -Dlibperl=libperl.so.5.8.4 -Dd_dosuid -des'
hint=recommended, useposix=true, d_sigaction=define
usethreads=define use5005threads=undef useithreads=define usemultiplicity=define
useperlio=define d_sfio=undef uselargefiles=define usesocks=undef
use64bitint=undef use64bitall=undef uselongdouble=undef
usemymalloc=n, bincompat5005=undef
Compiler:
cc='cc', ccflags ='-D_REENTRANT -D_GNU_SOURCE -DTHREADS_HAVE_PIDS -DDEBIAN -fno-strict-aliasing -I/usr/local/include -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64',
optimize='-O2',
cppflags='-D_REENTRANT -D_GNU_SOURCE -DTHREADS_HAVE_PIDS -DDEBIAN -fno-strict-aliasing -I/usr/local/include'
ccversion='', gccversion='3.3.5 (Debian 1:3.3.5-9)', gccosandvers=''
intsize=4, longsize=4, ptrsize=4, doublesize=8, byteorder=1234
d_longlong=define, longlongsize=8, d_longdbl=define, longdblsize=12
ivtype='long', ivsize=4, nvtype='double', nvsize=8, Off_t='off_t', lseeksize=8
alignbytes=4, prototype=define
Linker and Libraries:
ld='cc', ldflags =' -L/usr/local/lib'
libpth=/usr/local/lib /lib /usr/lib
libs=-lgdbm -lgdbm_compat -ldb -ldl -lm -lpthread -lc -lcrypt
perllibs=-ldl -lm -lpthread -lc -lcrypt
libc=/lib/libc-2.3.2.so, so=so, useshrplib=true, libperl=libperl.so.5.8.4
gnulibc_version='2.3.2'
Dynamic Linking:
dlsrc=dl_dlopen.xs, dlext=so, d_dlsymun=undef, ccdlflags='-Wl,-E'
cccdlflags='-fPIC', lddlflags='-shared -L/usr/local/lib'

Locally applied patches:

@INC for perl v5.8.4:
/home/duelafn/Perl/lib
/home/duelafn/hyparr/mathlibs/GAP/lib
/home/duelafn/hyparr/mathlibs/Macaulay/lib
/home/duelafn/hyparr/mathlibs/TestIsom/lib
/home/duelafn/hyparr/mathlibs/Result/lib
/home/duelafn/hyparr/mathlibs/InteractiveProgram/lib
/home/duelafn/hyparr/mathlibs/Singular/lib
/home/duelafn/hyparr/mathlibs/Maple/lib
/home/duelafn/hyparr/lib
/etc/perl
/usr/local/lib/perl/5.8.4
/usr/local/share/perl/5.8.4
/usr/lib/perl5
/usr/share/perl5
/usr/lib/perl/5.8
/usr/share/perl/5.8
/usr/local/lib/site_perl
.

Environment for perl v5.8.4:
HOME=/home/duelafn
LANG=en_US.UTF-8
LANGUAGE (unset)
LD_LIBRARY_PATH (unset)
LOGDIR (unset)
PATH=/usr/local/bin:/usr/bin:/bin:/usr/X11R6/bin:/usr/games:/Local/bin:/usr/local/Singular/2-0-5/COMPILE/ix86-Linux:/home/duelafn/extra/bin:/home/duelafn/hyparr/bin:/Local/bin:/usr/local/Singular/2-0-5/COMPILE/ix86-Linux
PERL5LIB=:/home/duelafn/Perl/lib:/home/duelafn/hyparr/mathlibs/GAP/lib:/home/duelafn/hyparr/mathlibs/Macaulay/lib:/home/duelafn/hyparr/mathlibs/TestIsom/lib:/home/duelafn/hyparr/mathlibs/Result/lib:/home/duelafn/hyparr/mathlibs/InteractiveProgram/lib:/home/duelafn/hyparr/mathlibs/Singular/lib:/home/duelafn/hyparr/mathlibs/Maple/lib:/home/duelafn/hyparr/lib
PERL_BADLANG (unset)
SHELL=/bin/bash

p5pRT · 2005-12-16T16:18:35Z

From @smpeters

[dean@cs.serenevy.net - Sun Nov 13 07:13:41 2005]:

This is a bug report for perl from dean@cs.serenevy.net,
generated with the help of perlbug 1.35 running under perl v5.8.4.

-----------------------------------------------------------------
Localizing variables bound to shared variables can cause the shared
variable to become undefined. The below is a test script which
produces the following output on my machine (tests 9,10 and 19,20
fail):

1..32
Scalars leaked: 1
ok 1 - direct passing (local $_): defined
ok 2 - direct passing (local $_): maintained value
Scalars leaked: 1
ok 3 - direct passing (local $g): defined
ok 4 - direct passing (local $g): maintained value
Scalars leaked: 1
ok 5 - direct passing (my $g): defined
ok 6 - direct passing (my $g): maintained value
Scalars leaked: 1
ok 7 - direct passing (my $x): defined
ok 8 - direct passing (my $x): maintained value
Scalars leaked: 1
not ok 9 - map (local $_): defined
# Failed test at line 42
not ok 10 - map (local $_): maintained value
# Failed test at line 43
Scalars leaked: 1
ok 11 - map (local $g): defined
ok 12 - map (local $g): maintained value
Scalars leaked: 1
ok 13 - map (my $g): defined
ok 14 - map (my $g): maintained value
Scalars leaked: 1
ok 15 - map (my $x): defined
ok 16 - map (my $x): maintained value
ok 17 - for $g (local $_): defined
ok 18 - for $g (local $_): maintained value
not ok 19 - for $g (local $g): defined
# Failed test at line 42
not ok 20 - for $g (local $g): maintained value
# Failed test at line 43
ok 21 - for $g (my $g): defined
ok 22 - for $g (my $g): maintained value
ok 23 - for $g (my $x): defined
ok 24 - for $g (my $x): maintained value
ok 25 - for copy of $g (local $_): defined
ok 26 - for copy of $g (local $_): maintained value
ok 27 - for copy of $g (local $g): defined
ok 28 - for copy of $g (local $g): maintained value
ok 29 - for copy of $g (my $g): defined
ok 30 - for copy of $g (my $g): maintained value
ok 31 - for copy of $g (my $x): defined
ok 32 - for copy of $g (my $x): maintained value

#### BEGIN test script: threads_and_local.t
#!perl -w

# Tests localization in threaded situations
# (localization has been known to cause shared values to become
undefined)

use strict;
use Config;

BEGIN {
if (!$Config{useithreads}) {
print "1..0 # Skip: no ithreads\n";
exit;
}
if ($ENV{PERL_CORE_MINITEST}) {
print "1..0 # Skip: no dynamic loading on miniperl, no
threads\n";
exit 0;
}
use threads;
use threads::shared;
print "1..32\n";
}

my $value :shared;
our $g;

my $test = 1;
sub ok {
my ($ok, $name) = @_;
\# You have to do it this way or VMS will get confused\.
print $ok ? "ok $test \- $name\\n" : "not ok $test \- $name\\n";

printf "\# Failed test at line %d\\n"\, $caller$\[2\] unless $ok;
$test\+\+;
return $ok;
}

sub test_it {
my ($sub, $message) = @_;
$value = "foo";
threads->create($sub, $value)->join;
ok( defined($value), "$message: defined" );
ok( ($value and $value eq 'foo'), "$message: maintained value" );
}

test_it sub { local__($_[0]) }, 'direct passing (local
$_)';
test_it sub { local_g($_[0]) }, 'direct passing (local
$g)';
test_it sub { my_g($_[0]) }, 'direct passing (my $g)';
test_it sub { my_x($_[0]) }, 'direct passing (my $x)';

test_it sub { map local__($_), @_ }, 'map (local $_)';
test_it sub { map local_g($_), @_ }, 'map (local $g)';
test_it sub { map my_g($_), @_ }, 'map (my $g)';
test_it sub { map my_x($_), @_ }, 'map (my $x)';

test_it sub { for $g (@_) { local__($g) } }, 'for $g (local $_)';
test_it sub { for $g (@_) { local_g($g) } }, 'for $g (local $g)';
test_it sub { for $g (@_) { my_g($g) } }, 'for $g (my $g)';
test_it sub { for $g (@_) { my_x($g) } }, 'for $g (my $x)';

test_it sub { for (@_) { $g = $_; local__($g) } }, 'for copy of $g
(local $_)';
test_it sub { for (@_) { $g = $_; local_g($g) } }, 'for copy of $g
(local $g)';
test_it sub { for (@_) { $g = $_; my_g($g) } }, 'for copy of $g (my
$g)';
test_it sub { for (@_) { $g = $_; my_x($g) } }, 'for copy of $g (my
$x)';

sub local__ {
local $_ = shift;
s/o/a/ if $_;
return $_;
}

sub local_g {
local $g = shift;
$g =~ s/o/a/ if $g;
return $g;
}

sub my_g {
my $g = shift;
$g =~ s/o/a/ if $g;
return $g;
}

sub my_x {
my $x = shift;
$x =~ s/o/a/ if $x;
return $x;
}
#### END test script: threads_and_local.t

In bleadperl, I get a coredump at test 9 instead of a test failure
(thanks for the script, by the way). Here's what gdb had to say about
the core file.

#0 0x080e48f3 in Perl_mg_find (my_perl=0x81dd008, sv=0x81f4690,
type=126)
at mg.c:346
346 for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
(gdb) bt
#0 0x080e48f3 in Perl_mg_find (my_perl=0x81dd008, sv=0x81f4690,
type=126)
at mg.c:346
#1 0xb7c371c2 in Perl_sharedsv_associate (my_perl=0x81dd008,
psv=0xbff605b4,
ssv=0x81f4690, data=0x0) at shared.xs:290
#2 0xb7c385fd in sharedsv_scalar_mg_get (my_perl=0x81dd008,
sv=0x81de94c,
mg=0x828ed1c) at shared.xs:511
#3 0x080e4226 in Perl_mg_get (my_perl=0x81dd008, sv=0x81de94c) at
mg.c:166
#4 0x080fa98a in Perl_pp_defined (my_perl=0x81dd008) at pp_hot.c:375
#5 0x080dada8 in Perl_runops_debug (my_perl=0x81dd008) at dump.c:1599
#6 0x080671d7 in S_run_body (my_perl=0x81dd008, oldscope=1) at
perl.c:2308
#7 0x08066bb3 in perl_run (my_perl=0x81dd008) at perl.c:2235
#8 0x0806003d in main (argc=3, argv=0xbff60854, env=0xbff60864)
at perlmain.c:103

I decided to Dump out what the $_ looks like in test script and it
confused me.

SV = PVMG(0x8292af8) at 0x82f851c
REFCNT = 1
FLAGS = (TEMP)
IV = 0
NV = 0
PV = 0

So, here's my question. Can you have a PVMG with no magic? If so, do
we want this path of code to be more restrictive by checking SvMAGICAL
(sv) instead of just SvTYPE(sv) >= SVt_PGMG? Or is the whole shared
thing much more complex than my initial uneducated glance through the
code?

p5pRT · 2005-12-16T16:18:39Z

The RT System itself - Status changed from 'new' to 'open'

p5pRT · 2005-12-18T10:23:23Z

From @ysth

On Fri, Dec 16, 2005 at 08:18:36AM -0800, Steve Peters via RT wrote:

So, here's my question. Can you have a PVMG with no magic?

Absolutely. $ perl -we'$x=*x; $x=0; use Devel::Peek; Dump $x'
SV = PVMG(0x474f28) at 0x47eefc
REFCNT = 1
FLAGS = (IOK,pIOK)
IV = 0
NV = 0
PV = 0

If so, do we want this path of code to be more restrictive by
checking SvMAGICAL (sv) instead of just SvTYPE(sv) >= SVt_PGMG?

Yes, I'd think so.

Or is the whole shared thing much more complex than my initial
uneducated glance through the code?

p5pRT · 2006-01-02T17:59:48Z

From @iabyn

On Fri, Dec 16, 2005 at 08:18:36AM -0800, Steve Peters via RT wrote:

[dean@cs.serenevy.net - Sun Nov 13 07:13:41 2005]:

This is a bug report for perl from dean@cs.serenevy.net,
generated with the help of perlbug 1.35 running under perl v5.8.4.

-----------------------------------------------------------------
Localizing variables bound to shared variables can cause the shared
variable to become undefined. The below is a test script which
produces the following output on my machine (tests 9,10 and 19,20
fail):

1..32
Scalars leaked: 1
ok 1 - direct passing (local $_): defined
ok 2 - direct passing (local $_): maintained value
Scalars leaked: 1
ok 3 - direct passing (local $g): defined
ok 4 - direct passing (local $g): maintained value
Scalars leaked: 1
ok 5 - direct passing (my $g): defined
ok 6 - direct passing (my $g): maintained value
Scalars leaked: 1
ok 7 - direct passing (my $x): defined
ok 8 - direct passing (my $x): maintained value
Scalars leaked: 1
not ok 9 - map (local $_): defined
# Failed test at line 42
not ok 10 - map (local $_): maintained value
# Failed test at line 43
Scalars leaked: 1
ok 11 - map (local $g): defined
ok 12 - map (local $g): maintained value
Scalars leaked: 1
ok 13 - map (my $g): defined
ok 14 - map (my $g): maintained value
Scalars leaked: 1
ok 15 - map (my $x): defined
ok 16 - map (my $x): maintained value
ok 17 - for $g (local $_): defined
ok 18 - for $g (local $_): maintained value
not ok 19 - for $g (local $g): defined
# Failed test at line 42
not ok 20 - for $g (local $g): maintained value
# Failed test at line 43
ok 21 - for $g (my $g): defined
ok 22 - for $g (my $g): maintained value
ok 23 - for $g (my $x): defined
ok 24 - for $g (my $x): maintained value
ok 25 - for copy of $g (local $_): defined
ok 26 - for copy of $g (local $_): maintained value
ok 27 - for copy of $g (local $g): defined
ok 28 - for copy of $g (local $g): maintained value
ok 29 - for copy of $g (my $g): defined
ok 30 - for copy of $g (my $g): maintained value
ok 31 - for copy of $g (my $x): defined
ok 32 - for copy of $g (my $x): maintained value

#### BEGIN test script: threads_and_local.t
#!perl -w

# Tests localization in threaded situations
# (localization has been known to cause shared values to become
undefined)

use strict;
use Config;

BEGIN {
if (!$Config{useithreads}) {
print "1..0 # Skip: no ithreads\n";
exit;
}
if ($ENV{PERL_CORE_MINITEST}) {
print "1..0 # Skip: no dynamic loading on miniperl, no
threads\n";
exit 0;
}
use threads;
use threads::shared;
print "1..32\n";
}

my $value :shared;
our $g;

my $test = 1;
sub ok {
my ($ok, $name) = @_;
\# You have to do it this way or VMS will get confused\.
print $ok ? "ok $test \- $name\\n" : "not ok $test \- $name\\n";

printf "\# Failed test at line %d\\n"\, $caller$\[2\] unless $ok;
$test\+\+;
return $ok;
}

sub test_it {
my ($sub, $message) = @_;
$value = "foo";
threads->create($sub, $value)->join;
ok( defined($value), "$message: defined" );
ok( ($value and $value eq 'foo'), "$message: maintained value" );
}

test_it sub { local__($_[0]) }, 'direct passing (local
$_)';
test_it sub { local_g($_[0]) }, 'direct passing (local
$g)';
test_it sub { my_g($_[0]) }, 'direct passing (my $g)';
test_it sub { my_x($_[0]) }, 'direct passing (my $x)';

test_it sub { map local__($_), @_ }, 'map (local $_)';
test_it sub { map local_g($_), @_ }, 'map (local $g)';
test_it sub { map my_g($_), @_ }, 'map (my $g)';
test_it sub { map my_x($_), @_ }, 'map (my $x)';

test_it sub { for $g (@_) { local__($g) } }, 'for $g (local $_)';
test_it sub { for $g (@_) { local_g($g) } }, 'for $g (local $g)';
test_it sub { for $g (@_) { my_g($g) } }, 'for $g (my $g)';
test_it sub { for $g (@_) { my_x($g) } }, 'for $g (my $x)';

test_it sub { for (@_) { $g = $_; local__($g) } }, 'for copy of $g
(local $_)';
test_it sub { for (@_) { $g = $_; local_g($g) } }, 'for copy of $g
(local $g)';
test_it sub { for (@_) { $g = $_; my_g($g) } }, 'for copy of $g (my
$g)';
test_it sub { for (@_) { $g = $_; my_x($g) } }, 'for copy of $g (my
$x)';

sub local__ {
local $_ = shift;
s/o/a/ if $_;
return $_;
}

sub local_g {
local $g = shift;
$g =~ s/o/a/ if $g;
return $g;
}

sub my_g {
my $g = shift;
$g =~ s/o/a/ if $g;
return $g;
}

sub my_x {
my $x = shift;
$x =~ s/o/a/ if $x;
return $x;
}
#### END test script: threads_and_local.t
In bleadperl, I get a coredump at test 9 instead of a test failure

There are two separate issues here.

The OP's test code failures are in essence variants of
local $foo = $foo;
where $foo is something that acts as a proxy object, such as a shared
scalar, scalar tie or magic; it is not specific to threads::shared. eg

$ perl -e '$! = 1; print "[$!]\n"; local $! = $!; print "[$!]\n"'
[Operation not permitted]
[]
$

$ perl -e 'use Tie::Scalar; tie $s, "Tie::StdScalar"; $s = 1; print "[$s]\n"; local $s = $s; print "[$s]\n"'
[1]
[]
$

I can't yet think of an easy way of fixing this.

The second isssue is the coredump in bleedperl. This is because I
(consciously) broke local on shared variables whilst providing a general
fix for various local/magic issues in change #24942. It's been on my list
of things to fix for while, and having obtaining some tuits recently, I've
now commited the following change.

It adds an optional new slot to the magic vtable, svt_local, that can be
called when magic is being copied to the new SV. A new flag, MGf_LOCAL
indicates the presence of this slot, so that backwards src comaptibility
isn't affected.

This currently only fixes local $scalar; I still need to check out local
@array and local $array[N]. I'll do this something soon, along with adding
tests, documntaion etc.

Dave

--
Little fly, thy summer's play my thoughtless hand
has terminated with extreme prejudice.
(with apologies to William Blake)

Change 26569 by davem@davem-cyril on 2006/01/02 12:09:37

add svt_local slot to magic vtable, and fix local $shared

Affected files ...

... //depot/perl/ext/threads/shared/shared.xs#53 edit
... //depot/perl/mg.c#393 edit
... //depot/perl/mg.h#24 edit

Differences ...

==== //depot/perl/ext/threads/shared/shared.xs#53 (text) ====

@@ -196,6 +196,7 @@
sharedsv_shared_mg_free, /* free */
0, /* copy */
0, /* dup */
+ 0 /* local */
};

/* Access to shared things is heavily based on MAGIC - in mg.h/mg.c/sv.c sense */
@@ -376,7 +377,7 @@
}
mg = sv_magicext(sv, Nullsv, PERL_MAGIC_shared_scalar,
&sharedsv_scalar_vtbl, (char *)data, 0);
- mg->mg_flags |= (MGf_COPY|MGf_DUP);
+ mg->mg_flags |= (MGf_COPY|MGf_DUP|MGf_LOCAL);
SvREFCNT_inc(ssv);
if(SvOBJECT(ssv)) {
STRLEN len;
@@ -605,6 +606,28 @@
return 0;
}

+
+/*
+ * Called during local $shared
+ */
+int
+sharedsv_scalar_mg_local(pTHX_ SV* nsv, MAGIC *mg)
+{
+ MAGIC *nmg;
+ shared_sv *shared = (shared_sv *) mg->mg_ptr;
+ if (shared) {
+ ENTER_LOCK;
+ SvREFCNT_inc(SHAREDSvPTR(shared));
+ LEAVE_LOCK;
+ }
+ nmg = sv_magicext(nsv, mg->mg_obj, mg->mg_type, mg->mg_virtual,
+ mg->mg_ptr, mg->mg_len);
+ nmg->mg_flags = mg->mg_flags;
+ nmg->mg_private = mg->mg_private;
+
+ return 0;
+}
+
MGVTBL sharedsv_scalar_vtbl = {
sharedsv_scalar_mg_get, /* get */
sharedsv_scalar_mg_set, /* set */
@@ -612,7 +635,8 @@
sharedsv_scalar_mg_clear, /* clear */
sharedsv_scalar_mg_free, /* free */
0, /* copy */
- sharedsv_scalar_mg_dup /* dup */
+ sharedsv_scalar_mg_dup, /* dup */
+ sharedsv_scalar_mg_local /* local */
};

/* Now the arrays/hashes stuff */
@@ -753,7 +777,8 @@
sharedsv_elem_mg_DELETE, /* clear */
sharedsv_elem_mg_free, /* free */
0, /* copy */
- sharedsv_elem_mg_dup /* dup */
+ sharedsv_elem_mg_dup, /* dup */
+ 0 /* local */
};

U32
@@ -832,7 +857,8 @@
sharedsv_array_mg_CLEAR, /* clear */
sharedsv_array_mg_free, /* free */
sharedsv_array_mg_copy, /* copy */
- sharedsv_array_mg_dup /* dup */
+ sharedsv_array_mg_dup, /* dup */
+ 0 /* local */
};

=for apidoc sharedsv_unlock

==== //depot/perl/mg.c#393 (text) ====

@@ -430,15 +430,12 @@
continue;
}

- if ((mg->mg_flags & MGf_COPY) && vtbl->svt_copy) {
- /* XXX calling the copy method is probably not correct. DAPM */
- (void)CALL_FPTR(vtbl->svt_copy)(aTHX_ sv, mg, nsv,
- mg->mg_ptr, mg->mg_len);
- }
- else {
+ if ((mg->mg_flags & MGf_LOCAL) && vtbl->svt_local)
+ (void)CALL_FPTR(vtbl->svt_local)(aTHX_ nsv, mg);
+ else
sv_magicext(nsv, mg->mg_obj, mg->mg_type, vtbl,
mg->mg_ptr, mg->mg_len);
- }
+
/* container types should remain read-only across localization */
SvFLAGS(nsv) |= SvREADONLY(sv);
}

==== //depot/perl/mg.h#24 (text) ====

@@ -20,6 +20,7 @@
int (CPERLscope(*svt_copy)) (pTHX_ SV *sv, MAGIC* mg,
SV *nsv, const char *name, int namlen);
int (CPERLscope(*svt_dup)) (pTHX_ MAGIC *mg, CLONE_PARAMS *param);
+ int (CPERLscope(*svt_local))(pTHX_ SV *nsv, MAGIC *mg);
};
#endif

@@ -38,8 +39,9 @@
#define MGf_MINMATCH 1 /* PERL_MAGIC_regex_global only */
#define MGf_REFCOUNTED 2
#define MGf_GSKIP 4
-#define MGf_COPY 8
-#define MGf_DUP 16
+#define MGf_COPY 8 /* has an svt_copy MGVTBL entry */
+#define MGf_DUP 0x10 /* has an svt_dup MGVTBL entry */
+#define MGf_LOCAL 0x20 /* has an svt_local MGVTBL entry */

#define MgTAINTEDDIR(mg) (mg->mg_flags & MGf_TAINTEDDIR)
#define MgTAINTEDDIR_on(mg) (mg->mg_flags |= MGf_TAINTEDDIR)

p5pRT · 2006-01-03T02:29:16Z

From @iabyn

On Mon, Jan 02, 2006 at 06:00:43PM +0000, Dave Mitchell wrote:

1..32
Scalars leaked: 1
ok 1 - direct passing (local $_): defined
ok 2 - direct passing (local $_): maintained value
[snip]
There are two separate issues here.

Actually there are three issues, the third one being the 'scalars leaked'
error. Fixed by the change below.

Basically something like

foo(\@a);
sub foo {threads->new(...)}

would create a tmp ref, which then gets added to @_ (but not refcounted).
When the interpreter is cloned, the tmps stack isn't copied, so the tmp
ref gets copied curtesy of @_, but keeps a refcount of 0, curtesy of @_'s
!AvREAL status.

Dave

--
print+qq&$}$"$/$s$,$*${d}$g$s$@$.$q$,$:$.$q$^$,$@$*$~~$;$.$q$m&if+map{m,^\d{0\,},,${$::{$'}}=chr($"+=$&||1)}q&10m22,42}6:17*2~~2.3@3;^2dg3q/s"&=~m*\d\*.*g

Change 26591 by davem@davem-cyril on 2006/01/03 02:20:28

ithreads: SVs that were only on the tmps stack leaked

Affected files ...

... //depot/perl/sv.c#1092 edit

Differences ...

==== //depot/perl/sv.c#1092 (text) ====

@@ -10767,6 +10767,20 @@
else {
init_stacks();
ENTER; /* perl_destruct() wants to LEAVE; */
+
+ /* although we're not duplicating the tmps stack, we should still
+ * add entries for any SVs on the tmps stack that got cloned by a
+ * non-refcount means (eg a temp in @_); otherwise they will be
+ * orphaned
+ */
+ for (i = 0; i<= proto_perl->Ttmps_ix; i++) {
+ SV *nsv = (SV*)ptr_table_fetch(PL_ptr_table,
+ proto_perl->Ttmps_stack[i]);
+ if (nsv && !SvREFCNT(nsv)) {
+ EXTEND_MORTAL(1);
+ PL_tmps_stack[++PL_tmps_ix] = SvREFCNT_inc(nsv);
+ }
+ }
}

PL_start_env = proto_perl->Tstart_env; /* XXXXXX */

p5pRT · 2006-01-07T01:26:18Z

From @iabyn

On Mon, Jan 02, 2006 at 06:00:43PM +0000, Dave Mitchell wrote:

The second isssue is the coredump in bleedperl. This is because I
(consciously) broke local on shared variables whilst providing a general
fix for various local/magic issues in change #24942. It's been on my list
of things to fix for while, and having obtaining some tuits recently, I've
now commited the following change.

It adds an optional new slot to the magic vtable, svt_local, that can be
called when magic is being copied to the new SV. A new flag, MGf_LOCAL
indicates the presence of this slot, so that backwards src comaptibility
isn't affected.

This currently only fixes local $scalar; I still need to check out local
@array and local $array[N]. I'll do this something soon, along with adding
tests, documntaion etc.

local $shared[N] now fixed by change #26693 (local @shared wasn't broken).
Tests + documentation still to come.

--
"The GPL violates the U.S. Constitution, together with copyright,
antitrust and export control laws"
-- SCO smoking crack again.

p5pRT · 2012-04-21T01:31:58Z

From @jkeenan

On Fri Jan 06 17:26:18 2006, davem@iabyn.com wrote:

On Mon, Jan 02, 2006 at 06:00:43PM +0000, Dave Mitchell wrote:

[snip]

This currently only fixes local $scalar; I still need to check out local
@array and local $array[N]. I'll do this something soon, along with
adding
tests, documntaion etc.

local $shared[N] now fixed by change #26693 (local @shared wasn't broken).
Tests + documentation still to come.

Were those tests and documentation ever added?

Are there still issues outstanding in this ticket?

Thank you very much.

Jim Keenan

p5pRT · 2012-04-21T15:15:05Z

From @iabyn

On Fri, Apr 20, 2012 at 06:31:58PM -0700, James E Keenan via RT wrote:

On Fri Jan 06 17:26:18 2006, davem@iabyn.com wrote:

On Mon, Jan 02, 2006 at 06:00:43PM +0000, Dave Mitchell wrote:

[snip]

This currently only fixes local $scalar; I still need to check out local
@array and local $array[N]. I'll do this something soon, along with
adding
tests, documntaion etc.

local $shared[N] now fixed by change #26693 (local @shared wasn't broken).
Tests + documentation still to come.

Were those tests and documentation ever added?

A quick look shows that MGf_LOCAL is now documented, but by removing its
setting from shared.xs, no tests fail; so I guess tests were never
added.

--
All wight. I will give you one more chance. This time, I want to hear
no Wubens. No Weginalds. No Wudolf the wed-nosed weindeers.
-- Life of Brian

p5pRT added Severity Low hasCoreDump type-ithreads labels Oct 18, 2019

xenu removed the Severity Low label Dec 29, 2021

Provide feedback

Saved searches

Use saved searches to filter your results more quickly

Problem using "local" with "threads::shared" #8207

Problem using "local" with "threads::shared" #8207

p5pRT commented Nov 13, 2005

p5pRT commented Nov 13, 2005

p5pRT commented Dec 16, 2005

p5pRT commented Dec 16, 2005

p5pRT commented Dec 18, 2005

p5pRT commented Jan 2, 2006

p5pRT commented Jan 3, 2006

p5pRT commented Jan 7, 2006

p5pRT commented Apr 21, 2012

p5pRT commented Apr 21, 2012

Problem using "local" with "threads::shared" #8207

Problem using "local" with "threads::shared" #8207

Comments

p5pRT commented Nov 13, 2005

p5pRT commented Nov 13, 2005

From dean@cs.serenevy.net

p5pRT commented Dec 16, 2005

From @smpeters

p5pRT commented Dec 16, 2005

p5pRT commented Dec 18, 2005

From @ysth

p5pRT commented Jan 2, 2006

From @iabyn

p5pRT commented Jan 3, 2006

From @iabyn

p5pRT commented Jan 7, 2006

From @iabyn

p5pRT commented Apr 21, 2012

From @jkeenan

p5pRT commented Apr 21, 2012

From @iabyn