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

[p5pRT]

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

Searchable as RT37671$

[p5pRT]

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]

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]

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

[p5pRT]

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]

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]

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*22.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]

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]

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]

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