Windows fork emulation's child pseudo process cannot restore local scalar values

[p5pRT]

Migrated from rt.perl.org#40565 (status was 'resolved')

Searchable as RT40565$

[p5pRT]

From ebhanssen@allverden.no

This is a bug report for perl from ebhanssen@​allverden.no,
generated with the help of perlbug 1.35 running under perl v5.8.8.

  I believe this is a bug in the Windows fork emulation.

  Basically, a localized scalar value is not restored in a child
pseudo process. In the simple case, this merely gives an unexpected
undefined value​:

| C​:\>perl -e "$s='outer'; { local $s; exit if fork } print $s, defined($s)"
|
| C​:\>

  Compare the same code with "real" forks​:

| ~$ perl -le '$s="outer"; { local $s; exit if fork } print $s, defined($s)'
| outer1
| ~$

  The following longer example reveals more -- giving us both "Attempt
to free unreferenced scalar" and "Illegal operation" -- and further
demonstrating that the bug does not affect localized array values​:

| #!perl
|
| @​a = $s = '1st';
| {
| local ($s, @​a);
| @​a = $s = '2nd';
| {
| local ($s, @​a);
| @​a = $s = '3rd';
| $me = fork() ? 'parent' : 'child';
| sleep 1 if $me eq 'parent'; # let the child go first
| print "Scalar​: $s - $me$/";
| print "Array​: @​a - $me$/";
| }
| # The scalar is now undefined in the child​:
| print "Scalar​: $s - $me$/";
| print "Array​: @​a - $me$/";
| }
| # Triggers an "illegal operation" in the child​:
| print "Scalar​: $s - $me$/";
| print "Array​: @​a - $me$/";
| wait;

  With real forks, this works just fine, but on Windows, I get the
following output​:

| C​:\Share>perl bug.pl
| Scalar​: 3rd - child
| Array​: 3rd - child
| Scalar​: - child
| Array​: 2nd - child
| Attempt to free unreferenced scalar​: SV 0x1573004, Perl interpreter​: 0x1561790 at bug.pl line 5.
| Scalar​: 3rd - parent
| Array​: 3rd - parent
| Scalar​: 2nd - parent
| Array​: 2nd - parent
| Scalar​: 1st - parent
| Array​: 1st - parent
|
| C​:\Share>

  Similar testing reveals that the bug does not affect array, hash,
nor glob values. (It does of course affect array and hash elements.)

Thanks,
  Eirik

  PS​: Sorry if this is a known issue. I searched "fork local" and
"pseudofork local" on rt.perl.org, got nothing, and could think of no
better search terms.

---

Flags​:
  category=core
  severity=low

---

Site configuration information for perl v5.8.8​:

Configured by SYSTEM at Tue Aug 29 12​:39​:43 2006.

Summary of my perl5 (revision 5 version 8 subversion 8) configuration​:
  Platform​:
  osname=MSWin32, osvers=5.0, archname=MSWin32-x86-multi-thread
  uname=''
  config_args='undef'
  hint=recommended, useposix=true, d_sigaction=undef
  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='cl', ccflags ='-nologo -GF -W3 -MD -Zi -DNDEBUG -O1 -DWIN32 -D_CONSOLE -DNO_STRICT -DHAVE_DES_FCRYPT -DNO_HASH_SEED -DUSE_SITECUSTOMIZE -DPERL_IMPLICIT_CONTEXT -DPERL_IMPLICIT_SYS -DUSE_PERLIO -DPERL_MSVCRT_READFIX',
  optimize='-MD -Zi -DNDEBUG -O1',
  cppflags='-DWIN32'
  ccversion='12.00.8804', gccversion='', gccosandvers=''
  intsize=4, longsize=4, ptrsize=4, doublesize=8, byteorder=1234
  d_longlong=undef, longlongsize=8, d_longdbl=define, longdblsize=10
  ivtype='long', ivsize=4, nvtype='double', nvsize=8, Off_t='__int64', lseeksize=8
  alignbytes=8, prototype=define
  Linker and Libraries​:
  ld='link', ldflags ='-nologo -nodefaultlib -debug -opt​:ref,icf -libpath​:"C​:\Perl\lib\CORE" -machine​:x86'
  libpth=\lib
  libs= oldnames.lib kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib netapi32.lib uuid.lib ws2_32.lib mpr.lib winmm.lib version.lib odbc32.lib odbccp32.lib msvcrt.lib
  perllibs= oldnames.lib kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib netapi32.lib uuid.lib ws2_32.lib mpr.lib winmm.lib version.lib odbc32.lib odbccp32.lib msvcrt.lib
  libc=msvcrt.lib, so=dll, useshrplib=yes, libperl=perl58.lib
  gnulibc_version=''
  Dynamic Linking​:
  dlsrc=dl_win32.xs, dlext=dll, d_dlsymun=undef, ccdlflags=' '
  cccdlflags=' ', lddlflags='-dll -nologo -nodefaultlib -debug -opt​:ref,icf -libpath​:"C​:\Perl\lib\CORE" -machine​:x86'

Locally applied patches​:
  ACTIVEPERL_LOCAL_PATCHES_ENTRY
  Iin_load_module moved for compatibility with build 806
  Avoid signal flag SA_RESTART for older versions of HP-UX
  PerlEx support in CGI​::Carp
  Less verbose ExtUtils​::Install and Pod​::Find
  Patch for CAN-2005-0448 from Debian with modifications
  Rearrange @​INC so that 'site' is searched before 'perl'
  Partly reverted 24733 to preserve binary compatibility
  28671 Define PERL_NO_DEV_RANDOM on Windows
  28376 Add error checks after execing PL_cshname or PL_sh_path
  28305 Pod​::Html should not convert \"foo\" into ``foo''
  27736 Make perl_fini() run with Sun WorkShop compiler
  27619 Bug in Term​::ReadKey being triggered by a bug in Term​::ReadLine
  27549 Move DynaLoader.o into libperl.so
  27528 win32_pclose() error exit doesn't unlock mutex
  27527 win32_async_check() can loop indefinitely
  27515 ignore directories when searching @​INC
  27359 Fix -d​:Foo=bar syntax
  27210 Fix quote typo in c2ph
  27203 Allow compiling swigged C++ code
  27200 Make stat() on Windows handle trailing slashes correctly
  27194 Get perl_fini() running on HP-UX again
  27133 Initialise lastparen in the regexp structure
  27034 Avoid \"Prototype mismatch\" warnings with autouse
  26970 Make Passive mode the default for Net​::FTP
  26921 Avoid getprotobyname/number calls in IO​::Socket​::INET
  26897,26903 Make common IPPROTO_* constants always available
  26670 Make '-s' on the shebang line parse -foo=bar switches
  26536 INSTALLSCRIPT versus INSTALLDIRS
  26379 Fix alarm() for Windows 2003
  26087 Storable 0.1 compatibility
  25861 IO​::File performace issue
  25084 long groups entry could cause memory exhaustion
  24699 ICMP_UNREACHABLE handling in Net​::Ping

---

@​INC for perl v5.8.8​:
  C​:/Perl/site/lib
  C​:/Perl/lib
  .

---

Environment for perl v5.8.8​:
  HOME (unset)
  LANG (unset)
  LANGUAGE (unset)
  LD_LIBRARY_PATH (unset)
  LOGDIR (unset)
  PATH=C​:\PERL\BIN\;C​:\WINDOWS;C​:\WINDOWS;C​:\WINDOWS\COMMAND
  PERL_BADLANG (unset)
  SHELL (unset)

[p5pRT]

From @bulk88

On Wed Oct 18 19​:27​:09 2006, ebhanssen wrote​:

This is a bug report for perl from ebhanssen@​allverden.no,
generated with the help of perlbug 1.35 running under perl v5.8.8.

The following longer example reveals more -- giving us both "Attempt
to free unreferenced scalar" and "Illegal operation" -- and further
demonstrating that the bug does not affect localized array values​:

| #!perl
|
| @​a = $s = '1st';
| {
| local ($s, @​a);
| @​a = $s = '2nd';
| {
| local ($s, @​a);
| @​a = $s = '3rd';
| $me = fork() ? 'parent' : 'child';
| sleep 1 if $me eq 'parent'; # let the child go first
| print "Scalar​: $s - $me$/";
| print "Array​: @​a - $me$/";
| }
| # The scalar is now undefined in the child​:
| print "Scalar​: $s - $me$/";
| print "Array​: @​a - $me$/";
| }
| # Triggers an "illegal operation" in the child​:
| print "Scalar​: $s - $me$/";
| print "Array​: @​a - $me$/";
| wait;

Using the above script with a DEBUG_LEAKING_SCALARS perl 5.17.6 no
DEBUGGING. The unreferenced scalar was created at
_________________________________________________________________

perl517.dll!S_new_SV(interpreter * my_perl=0x009504ac, const char *
file=0x2818be28, int line=8419, const char * func=0x2818b9f4) Line 288 C
  perl517.dll!Perl_sv_newmortal(interpreter * my_perl=0x009504ac) Line
8419 + 0x18 C
  perl517.dll!Perl_varname(interpreter * my_perl=0x009504ac, const gv *
const gv=0x00973f2c, const char gvtype='$', unsigned long targ=0, const
sv * const keyname=0x00000000, long aindex=0, int subscript_type=1)
Line 14078 + 0x9 C
  perl517.dll!S_find_uninit_var(interpreter * my_perl=0x009504ac, const
op * const obase=0x009141c4, const sv * const uninit_sv=0x0098705c, char
match=0) Line 14247 + 0x17 C
  perl517.dll!S_find_uninit_var(interpreter * my_perl=0x009504ac, const
op * const obase=0x009141a4, const sv * const uninit_sv=0x0098705c, char
match=0) Line 14587 + 0x15 C
  perl517.dll!S_find_uninit_var(interpreter * my_perl=0x009504ac, const
op * const obase=0x00914160, const sv * const uninit_sv=0x0098705c, char
match=0) Line 14587 + 0x15 C
  perl517.dll!Perl_report_uninit(interpreter * my_perl=0x009504ac, const
sv * uninit_sv=0x0098705c) Line 14617 + 0x16 C
  perl517.dll!Perl_sv_2pv_flags(interpreter * my_perl=0x009504ac, sv *
const sv=0x0098705c, unsigned int * const lp=0x00aefef8, const long
flags=32) Line 2942 + 0xd C
  perl517.dll!Perl_pp_concat(interpreter * my_perl=0x009504ac) Line
297 + 0x3d C
  perl517.dll!Perl_runops_standard(interpreter * my_perl=0x009504ac)
Line 42 + 0xa C
  perl517.dll!win32_start_child(void * arg=0x009504ac) Line 1740 + 0xd C
  kernel32.dll!_BaseThreadStart@​8() + 0x37
_________________________________________________________________
curcop points to
_________________________________________________________________
  # The scalar is now undefined in the child​:

print "Scalar​: $s - $me$/";
  print "Array​: @​a - $me$/";
}
_________________________________________________________________

The scalar was actually freeded at
___________________________________________________________________

perl517.dll!S_SvREFCNT_dec_NN(interpreter * my_perl=0x009504ac, sv *
sv=0x0098705c) Line 69 C
  perl517.dll!Perl_free_tmps(interpreter * my_perl=0x009504ac) Line
169 + 0xd C
  perl517.dll!Perl_pp_nextstate(interpreter * my_perl=0x009504ac) Line
54 + 0x17 C
  perl517.dll!Perl_runops_standard(interpreter * my_perl=0x009504ac)
Line 42 + 0xa C
  perl517.dll!win32_start_child(void * arg=0x009504ac) Line 1740 + 0xd C
  kernel32.dll!_BaseThreadStart@​8() + 0x37
_____________________________________________________________
curcop says
_____________________________________________________________
  # The scalar is now undefined in the child​:
  print "Scalar​: $s - $me$/";

print "Array​: @​a - $me$/";
}
# Triggers an "illegal operation" in the child​:
_____________________________________________________________

The scalar was attempted to be freeded at
_________________________________________________________________

perl517.dll!Perl_sv_free2(interpreter * my_perl=0x009504ac, sv * const
sv=0x0098705c, const unsigned long rc=0) Line 6621 C
  perl517.dll!S_SvREFCNT_dec(interpreter * my_perl=0x009504ac, sv *
sv=0x0098705c) Line 62 + 0x11 C
  perl517.dll!Perl_leave_scope(interpreter * my_perl=0x009504ac, long
base=6) Line 835 + 0xd C
  perl517.dll!Perl_pop_scope(interpreter * my_perl=0x009504ac) Line
110 + 0x18 C
  perl517.dll!Perl_pp_leaveloop(interpreter * my_perl=0x009504ac) Line
2255 + 0x9 C
  perl517.dll!Perl_runops_standard(interpreter * my_perl=0x009504ac)
Line 42 + 0xa C
  perl517.dll!win32_start_child(void * arg=0x009504ac) Line 1740 + 0xd C
  kernel32.dll!_BaseThreadStart@​8() + 0x37
___________________________________________________________________
In leave_scope, the SvREFCNT_dec call is
___________________________________________________________________

  case SAVEt_SV​: /* scalar reference */
  svp = &GvSV(ARG1_GV);
  refsv = ARG1_SV; /* what to refcnt_dec */
  restore_sv​:
  {
  SV * const sv = *svp;
  *svp = ARG0_SV;

   SvREFCNT\_dec\(sv\);

  if (SvSMAGICAL(ARG0_SV)) {
  PL_localizing = 2;
  mg_set(ARG0_SV);
  PL_localizing = 0;
  }
  SvREFCNT_dec_NN(ARG0_SV);
  SvREFCNT_dec(refsv);
  break;
  }
___________________________________________________________________
curcop points to
___________________________________________________________________
@​a = $s = '1st';
{

local ($s, @​a);
  @​a = $s = '2nd';
  {
___________________________________________________________________

The rogue savestack entry came from Perl_ss_dup during the fork, the
child interp did not call Perl_save_scalar . I am still investigating.

--
bulk88 ~ bulk88 at hotmail.com

[p5pRT]

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

[p5pRT]

From @bulk88

On Mon Dec 24 16​:55​:40 2012, bulk88 wrote​:

The rogue savestack entry came from Perl_ss_dup during the fork, the
child interp did not call Perl_save_scalar . I am still investigating.

The bug seems to be, the SV given to ss_dup, for duplicating a SAVEt_SV,
the parent interp SV has a refcount of 2, but after cloning, in the
child, the child SV that is the clone, has only a refcount of 1. I guess
the forking/cloning code somehow didn't see the holder of the 2nd
refcount so it was never upped. I am not sure who the 2 owners are in
the parent interp. When the SS entry is undone in the child, the
restored SV to the GV, has a refcount of 0. If add a croak to
Perl_leave_scope, the croak will happen in the child interp. Later on a
2nd SS entry attempts to change that GV again, and it goes refcnt -1.
__________________________________________________________________
  case SAVEt_SV​: /* scalar reference */
  svp = &GvSV(ARG1_GV);
  refsv = ARG1_SV; /* what to refcnt_dec */
  restore_sv​:
  {
  SV * const sv = *svp;
  *svp = ARG0_SV;
  SvREFCNT_dec(sv);
  if (SvSMAGICAL(ARG0_SV)) {
  PL_localizing = 2;
  mg_set(ARG0_SV);
  PL_localizing = 0;
  }
  SvREFCNT_dec_NN(ARG0_SV);
  SvREFCNT_dec(refsv);
  if(SvREFCNT(GvSV(ARG1_GV)) == 0) Perl_croak(aTHX_ "bad
refcnt" );
  break;
  }
__________________________________________________________________
The croak will happen.

In the child is goes like this,
-restore the SV once from save stack, dec ref count, reaches 1->0
-sv_newmortal call, alloc the SV head 0->1
-freetmps the head 1->0
-restore the SV again from save stack, dec ref count, warn attempt to
free unreferenced scalar 0->-1

The SV head being alloced again quickly happens to be by chance.

There is also a 2nd free unreferenced scalar warning that never makes it
to console ( I think perl IO is shut down already or something).
__________________________________________________________________

perl517.dll!Perl_sv_free2(interpreter * my_perl=0x009504ac, sv * const
sv=0x00981324, const unsigned long rc=0) Line 6621 C
  perl517.dll!S_SvREFCNT_dec(interpreter * my_perl=0x009504ac, sv *
sv=0x00981324) Line 62 + 0x11 C
  perl517.dll!Perl_sv_free(interpreter * my_perl=0x009504ac, sv * const
sv=0x00981324) Line 6552 + 0xd C
  perl517.dll!Perl_sv_clear(interpreter * my_perl=0x009504ac, sv * const
orig_sv=0x00989c54) Line 6399 + 0xd C
  perl517.dll!Perl_sv_free2(interpreter * my_perl=0x009504ac, sv * const
sv=0x00989c54, const unsigned long rc=1) Line 6583 + 0xd C
  perl517.dll!S_SvREFCNT_dec(interpreter * my_perl=0x009504ac, sv *
sv=0x00989c54) Line 62 + 0x11 C
  perl517.dll!Perl_cv_undef(interpreter * my_perl=0x009504ac, cv *
cv=0x00989c14) Line 460 + 0xd C
  perl517.dll!Perl_sv_clear(interpreter * my_perl=0x009504ac, sv * const
orig_sv=0x00989c14) Line 6165 + 0xd C
  perl517.dll!Perl_sv_free2(interpreter * my_perl=0x009504ac, sv * const
sv=0x00989c14, const unsigned long rc=1) Line 6583 + 0xd C
  perl517.dll!S_SvREFCNT_dec(interpreter * my_perl=0x009504ac, sv *
sv=0x00989c14) Line 62 + 0x11 C
  perl517.dll!perl_destruct(interpreter * my_perl=0x009504ac) Line
754 + 0x13 C
  perl517.dll!win32_start_child(void * arg=0x009504ac) Line 1795 + 0x9 C
  kernel32.dll!_BaseThreadStart@​8() + 0x37
___________________________________________________________________

In cv_undef, the _dec call came from
____________________________________________________________________
  ix = PadlistMAX(padlist);
  while (ix > 0) {
  PAD * const sv = PadlistARRAY(padlist)[ix--];
  if (sv) {
  if (sv == PL_comppad) {
  PL_comppad = NULL;
  PL_curpad = NULL;
  }

   SvREFCNT\_dec\(sv\);

  }
  }
____________________________________________________________________
That ive not investigated that beyond the above.
--
bulk88 ~ bulk88 at hotmail.com

[p5pRT]

From @bulk88

On Wed Dec 26 01​:12​:28 2012, bulk88 wrote​:

On Mon Dec 24 16​:55​:40 2012, bulk88 wrote​:

The rogue savestack entry came from Perl_ss_dup during the fork, the
child interp did not call Perl_save_scalar . I am still investigating.

The bug seems to be, the SV given to ss_dup, for duplicating a SAVEt_SV,
the parent interp SV has a refcount of 2, but after cloning, in the
child, the child SV that is the clone, has only a refcount of 1. I guess
the forking/cloning code somehow didn't see the holder of the 2nd
refcount so it was never upped. I am not sure who the 2 owners are in
the parent interp. When the SS entry is undone in the child, the
restored SV to the GV, has a refcount of 0. If add a croak to
Perl_leave_scope, the croak will happen in the child interp. Later on a
2nd SS entry attempts to change that GV again, and it goes refcnt -1.

The problem I think is that
http​://perl5.git.perl.org/perl.git/blob/f6a6501216dee24e251d4482bd3a1f6daf4ac0da​:/scope.c#l222
++s refcnt of the GV's sv, to make the SV have the save stack as one of
its owners. The problem is, this SV was just REMOVED from the GV, yet
the GV still have another notch on the refcount, but now the GV has no
pointers to that SV anymore. Therefore cloning the GV will not clone the
phantom SV that now lives in the save stack, since the SV in save stack
has no paths to it, except from the save stack (one ++), the GV ++ path
doesn't anymore due to the local/saving so psudo fork will never see the
SV a 2nd time anywhere, bumping its refcount to 2 in the child.

This patch stops the unreferenced warnings with
___________________________________________________
| #!perl
|
| @​a = $s = '1st';
| {
| local ($s, @​a);
| @​a = $s = '2nd';
| {
| local ($s, @​a);
| @​a = $s = '3rd';
| $me = fork() ? 'parent' : 'child';
| sleep 1 if $me eq 'parent'; # let the child go first
| print "Scalar​: $s - $me$/";
| print "Array​: @​a - $me$/";
| }
| # The scalar is now undefined in the child​:
| print "Scalar​: $s - $me$/";
| print "Array​: @​a - $me$/";
| }
| # Triggers an "illegal operation" in the child​:
| print "Scalar​: $s - $me$/";
| print "Array​: @​a - $me$/";
| wait;
__________________________________________________
and fixes
__________________________________________________
C​:\>perl -e "$s='outer'; { local $s; exit if fork } print $s, defined($s)"
__________________________________________________
to print "outer1".

Now, I have no idea if this is the correct fix, or side effects of this
patch. The problem that savestack gets an additional refcnt ++, instead
of taking over the GV's refcount ++ I've git blamed to
http​://perl5.git.perl.org/perl.git/commitdiff/4e4c362ec2e3f4b5f5c23aa83a26a13b85d0c2c1
by Gurusamy Sarathy . I can't find (the commit has no comments, google
didn't show any ML list discussions over this commit or I searched
poorly), or think of any explanation on why the save stack needs to
leave ownership of the SV being removed from the GV, as part of the GV.
Is Gurusamy Sarathy available to comment on why the savestack needs
ownership, or why the GV needs ownership of the SV that was removed, or
not available for comments anymore on his code? I am listing him as a CC
to this post.

The other choice is to reverse 4e4c362 .

Another choice would be to add a localize stack/array to a GP/GV
containing the localized and temporarily removed SVs. The psuedo fork
code will see this list, and sv_dup_inc all the elements on it. This
will raise the refcnts on the localized SVs to the correct level (2) in
the child interp. Adding SvREFCNT_inc_simple_void_NN to ss_dup sounds
hackish/least professional way of fixing it, since it doesn't fix the
problem that a GV owns refcount ++ on a SV that is doesn't know of/has
no link to.

--
bulk88 ~ bulk88 at hotmail.com

[p5pRT]

From @bulk88

0001-fix-40565-a-SV-on-save-stack-entry-for-SAVEt_SV-need.patch

From e07cf8c395d2c4dca2d22fd5b40fc9372b8b712a Mon Sep 17 00:00:00 2001
From: Daniel Dragan <bulk88@hotmail.com>
Date: Wed, 26 Dec 2012 06:51:28 -0500
Subject: [PATCH] fix #40565, a SV on save stack entry for SAVEt_SV needs 2
 refcount ++s

I dont know if this is the correct fix. Commit 4e4c362ec2e gave the save
stack entry a refcnt ownership (++) on the SV removed from the GV, yet
the GV still owns a different ownership (++) on the same SV. The SV has
only one reachable link now that it was removed from the GV, through the SS
entry. So during a clone/psudofork, the SV will not be found from the GV,
it will be found only through duping the SS entry, so the SS entry needs 2
++s, not 1 ++.
---
 sv.c |   11 +++++++++--
 1 files changed, 9 insertions(+), 2 deletions(-)

diff --git a/sv.c b/sv.c
index 9fc807a..e95d333 100644
--- a/sv.c
+++ b/sv.c
@@ -12699,12 +12699,19 @@ Perl_ss_dup(pTHX_ PerlInterpreter *proto_perl, CLONE_PARAMS* param)
         case SAVEt_GVSV:			/* scalar slot in GV */
         case SAVEt_SV:				/* scalar reference */
 	    sv = (const SV *)POPPTR(ss,ix);
-	    TOPPTR(nss,ix) = sv_dup_inc(sv, param);
+	    {
+		SV * sv2 = sv_dup_inc(sv, param);
+		SvREFCNT_inc_simple_void_NN(sv2);
+		TOPPTR(nss,ix) = sv2;
+	    }
 	    /* fall through */
 	case SAVEt_FREESV:
 	case SAVEt_MORTALIZESV:
 	    sv = (const SV *)POPPTR(ss,ix);
-	    TOPPTR(nss,ix) = sv_dup_inc(sv, param);
+	    {
+		SV * sv2 = sv_dup_inc(sv, param);
+		TOPPTR(nss,ix) = sv2;
+	    }
 	    break;
 	case SAVEt_SHARED_PVREF:		/* char* in shared space */
 	    c = (char*)POPPTR(ss,ix);
-- 
1.7.9.msysgit.0

[p5pRT]

From @iabyn

On Wed, Dec 26, 2012 at 04​:01​:11AM -0800, bulk88 via RT wrote​:

The problem I think is that
http​://perl5.git.perl.org/perl.git/blob/f6a6501216dee24e251d4482bd3a1f6daf4ac0da​:/scope.c#l222
++s refcnt of the GV's sv, to make the SV have the save stack as one of
its owners. The problem is, this SV was just REMOVED from the GV, yet
the GV still have another notch on the refcount, but now the GV has no
pointers to that SV anymore.

I think the issue is not so much Perl_save_scalar() incrementing the ref
count of the scalar (which is correct), as of S_save_scalar_at() failing
to decrement the refcount of the SV when it removes it from the GvSV slot.

I suspect (although this is based on a cursory look at the issue) that
making S_save_scalar_at() decrement the refcnt if it removed the SV from
the slot, and then incrementing the refcount when the SV is restored to
the slot, would make the problem go away - and not require a hack in
dup_ss().

But given that S_save_scalar_at() isn't just used to save GVSV slots, but
also array elements etc, its not clear to me why the issue affects one but
not the rest. So the fix might require more careful consideration.

But I think the basic principle is sound​: i.e. the SV always has a
refcount per pointer, which may be a pointer from GVSV, SvARRAY[n] or the
savestack.

--
Lear​: Dost thou call me fool, boy?
Fool​: All thy other titles thou hast given away; that thou wast born with.

[p5pRT]

From @bulk88

On Wed Dec 26 04​:01​:10 2012, bulk88 wrote​:

On Wed Dec 26 01​:12​:28 2012, bulk88 wrote​:

The bug seems to be, the SV given to ss_dup, for duplicating a
SAVEt_SV,
the parent interp SV has a refcount of 2, but after cloning, in the
child, the child SV that is the clone, has only a refcount of 1. I
guess
the forking/cloning code somehow didn't see the holder of the 2nd
refcount so it was never upped. I am not sure who the 2 owners are in
the parent interp. When the SS entry is undone in the child, the
restored SV to the GV, has a refcount of 0. If add a croak to
Perl_leave_scope, the croak will happen in the child interp. Later on
a
2nd SS entry attempts to change that GV again, and it goes refcnt -1.

The problem I think is that
http​://perl5.git.perl.org/perl.git/blob/f6a6501216dee24e251d4482bd3a1f6daf4ac0da​:/scope.c#l222
++s refcnt of the GV's sv, to make the SV have the save stack as one
of
its owners. The problem is, this SV was just REMOVED from the GV, yet
the GV still have another notch on the refcount, but now the GV has no
pointers to that SV anymore. Therefore cloning the GV will not clone
the
phantom SV that now lives in the save stack, since the SV in save
stack
has no paths to it, except from the save stack (one ++), the GV ++
path
doesn't anymore due to the local/saving so psudo fork will never see
the
SV a 2nd time anywhere, bumping its refcount to 2 in the child.

This patch stops the unreferenced warnings with
___________________________________________________
| #!perl
|
| @​a = $s = '1st';
| {
| local ($s, @​a);
| @​a = $s = '2nd';
| {
| local ($s, @​a);
| @​a = $s = '3rd';
| $me = fork() ? 'parent' : 'child';
| sleep 1 if $me eq 'parent'; # let the child go first
| print "Scalar​: $s - $me$/";
| print "Array​: @​a - $me$/";
| }
| # The scalar is now undefined in the child​:
| print "Scalar​: $s - $me$/";
| print "Array​: @​a - $me$/";
| }
| # Triggers an "illegal operation" in the child​:
| print "Scalar​: $s - $me$/";
| print "Array​: @​a - $me$/";
| wait;
__________________________________________________
and fixes
__________________________________________________
C​:\>perl -e "$s='outer'; { local $s; exit if fork } print $s,
defined($s)"
__________________________________________________
to print "outer1".

Now, I have no idea if this is the correct fix, or side effects of
this
patch. The problem that savestack gets an additional refcnt ++,
instead
of taking over the GV's refcount ++ I've git blamed to
http​://perl5.git.perl.org/perl.git/commitdiff/4e4c362ec2e3f4b5f5c23aa83a26a13b85d0c2c1
by Gurusamy Sarathy . I can't find (the commit has no comments,
google
didn't show any ML list discussions over this commit or I searched
poorly), or think of any explanation on why the save stack needs to
leave ownership of the SV being removed from the GV, as part of the
GV.
Is Gurusamy Sarathy available to comment on why the savestack needs
ownership, or why the GV needs ownership of the SV that was removed,
or
not available for comments anymore on his code? I am listing him as a
CC
to this post.

The other choice is to reverse
4e4c362 .

Another choice would be to add a localize stack/array to a GP/GV
containing the localized and temporarily removed SVs. The psuedo fork
code will see this list, and sv_dup_inc all the elements on it. This
will raise the refcnts on the localized SVs to the correct level (2)
in
the child interp. Adding SvREFCNT_inc_simple_void_NN to ss_dup sounds
hackish/least professional way of fixing it, since it doesn't fix the
problem that a GV owns refcount ++ on a SV that is doesn't know of/has
no link to.

Bump. This bug is fully diagnosed with a but maybe not the best patch for a fix. Can we this ticket rolling to be fixed for 5.20?

--
bulk88 ~ bulk88 at hotmail.com

[p5pRT]

From @tonycoz

On Tue Jan 21 12​:05​:17 2014, bulk88 wrote​:

Bump. This bug is fully diagnosed with a but maybe not the best patch
for a fix. Can we this ticket rolling to be fixed for 5.20?

I don't think your patch is correct - did you notice Dave's response?

I'll look at producing a fix, but I'm not sure it will happen for 5.20.

Tony

[p5pRT]

From @bulk88

On Tue Jan 21 16​:05​:09 2014, tonyc wrote​:

On Tue Jan 21 12​:05​:17 2014, bulk88 wrote​:

Bump. This bug is fully diagnosed with a but maybe not the best patch
for a fix. Can we this ticket rolling to be fixed for 5.20?

I don't think your patch is correct - did you notice Dave's response?

I didn't fully understand davem's response. So under his solution, S_save_scalar_at will sometimes -- the old SV, even though a couple lines earlier in execution, in Perl_save_scalar, the old SV got unconditionally ++ed, AND http​://perl5.git.perl.org/perl.git/commitdiff/4e4c362ec2e3f4b5f5c23aa83a26a13b85d0c2c1 is not reverted?

I'll look at producing a fix, but I'm not sure it will happen for 5.20.

There is a 1% chance I might do a fix, if you beat me to it, I'm fine with it.

--
bulk88 ~ bulk88 at hotmail.com

[p5pRT]

From @iabyn

On Tue, Jan 21, 2014 at 05​:07​:53PM -0800, bulk88 via RT wrote​:

On Tue Jan 21 16​:05​:09 2014, tonyc wrote​:

On Tue Jan 21 12​:05​:17 2014, bulk88 wrote​:

Bump. This bug is fully diagnosed with a but maybe not the best patch
for a fix. Can we this ticket rolling to be fixed for 5.20?

I don't think your patch is correct - did you notice Dave's response?

I didn't fully understand davem's response. So under his solution, S_save_scalar_at will sometimes -- the old SV, even though a couple lines earlier in execution, in Perl_save_scalar, the old SV got unconditionally ++ed, AND http​://perl5.git.perl.org/perl.git/commitdiff/4e4c362ec2e3f4b5f5c23aa83a26a13b85d0c2c1 is not reverted?

I'll look at producing a fix, but I'm not sure it will happen for 5.20.

There is a 1% chance I might do a fix, if you beat me to it, I'm fine with it.

I'm looking at at the moment.

--
"I do not resent criticism, even when, for the sake of emphasis,
it parts for the time with reality".
  -- Winston Churchill, House of Commons, 22nd Jan 1941.

[p5pRT]

From @iabyn

On Wed, Dec 26, 2012 at 04​:01​:11AM -0800, bulk88 via RT wrote​:

The problem I think is that
http​://perl5.git.perl.org/perl.git/blob/f6a6501216dee24e251d4482bd3a1f6daf4ac0da​:/scope.c#l222
++s refcnt of the GV's sv, to make the SV have the save stack as one of
its owners. The problem is, this SV was just REMOVED from the GV, yet
the GV still have another notch on the refcount, but now the GV has no
pointers to that SV anymore.

This description is correct, but it turns out that this extra ref count is
necessary in the case of tied arrays and hashes with SAVEt_AELEM /
SAVEt_HELEM, and with SAVEt_SVREF. I'm not sure whether its strictly
necessary with SAVEt_SV too, but all four save types currently share
the same restore code in leave_scope() - the restore_sv​: block.

Its needed for the tied array/hash element localisation, because when
you're presented with svp, which you assume is a pointer to a slot in the
array or hash, for tiedness, its actually a pointer to the LvTARG slot of
a PVLV that's on the tmps stack. In this case, the "old" sv isn't "owned"
apart from being on the tmps stack, and will likely be freed before
leave_scope() is called. So an extra ref count is needed to keep it alive
long enough.

So the extra ref needs to stay, and instead the fixup needs doing in
ss_dup(), similar to your suggested patch.

--- a/sv.c
+++ b/sv.c
@​@​ -12699,12 +12699,19 @​@​ Perl_ss_dup(pTHX_ PerlInterpreter *proto_perl, CLONE_PARAMS* param)
case SAVEt_GVSV​: /* scalar slot in GV */
case SAVEt_SV​: /* scalar reference */
sv = (const SV *)POPPTR(ss,ix);
- TOPPTR(nss,ix) = sv_dup_inc(sv, param);
+ {
+ SV * sv2 = sv_dup_inc(sv, param);
+ SvREFCNT_inc_simple_void_NN(sv2);
+ TOPPTR(nss,ix) = sv2;
+ }
/* fall through */
case SAVEt_FREESV​:
case SAVEt_MORTALIZESV​:
sv = (const SV *)POPPTR(ss,ix);
- TOPPTR(nss,ix) = sv_dup_inc(sv, param);
+ {
+ SV * sv2 = sv_dup_inc(sv, param);
+ TOPPTR(nss,ix) = sv2;
+ }
break;
case SAVEt_SHARED_PVREF​: /* char* in shared space */
c = (char*)POPPTR(ss,ix);

However, the above is wrong in several ways (I'm not sure whether this is
just because its proof of concept). As well doing an extra ++ for the old
SV in the SAVEt_SV case, you're also doing a ++ for the SAVEt_SV's gv,
which is unnecessary, and also doing a bunch of ++'s for lots of other
save types which happen to fall through in that switch.

Can you rework this so that it does only the sv arg of SAVEt_SV, and
extend it to do the same for SAVEt_AELEM, SAVEt_HELEM and SAVEt_SVREF with
tests? I don't work on Windows, so I'm not in a position to do this.
(Note that SAVEt_SVREF isn't used in the core, so would be hard to test).

--
A major Starfleet emergency breaks out near the Enterprise, but
fortunately some other ships in the area are able to deal with it to
everyone's satisfaction.
  -- Things That Never Happen in "Star Trek" #13

[p5pRT]

From @dex4er

2014/1/23 Dave Mitchell <davem@​iabyn.com>​:

tests? I don't work on Windows, so I'm not in a position to do this.
(Note that SAVEt_SVREF isn't used in the core, so would be hard to test).

I've noticed that Strawberry Perl can be run with wine on Linux. I've
tried to run the example scripts from this bugreport​:

  dexter@​pepper​:~$ wine cmd
  CMD Version 1.4.1

  Z​:\home\dexter>set PATH=C​:\strawberry\perl\bin;%PATH%

  Z​:\home\dexter>perl -v

  This is perl 5, version 18, subversion 2 (v5.18.2) built for
MSWin32-x86-multi-thread-64int

  Z​:\home\dexter>perl test_fork_exit.pl

  Z​:\home\dexter>perl test_rt40565.pl
  Scalar​: 3rd - child
  Array​: 3rd - child
  Scalar​: - child
  Array​: 2nd - child
  Attempt to free unreferenced scalar​: SV 0x18486c, Perl interpreter​:
0x15c7cc at test_rt40565.pl line 5.
  Scalar​: - child
  Array​: 1st - child
  Scalar​: 3rd - parent
  Array​: 3rd - parent
  Scalar​: 2nd - parent
  Array​: 2nd - parent
  Scalar​: 1st - parent
  Array​: 1st - parent

I've put the test scripts also to my repo. This bug causes that my
pre-forking server work incorrectly on Windows and fails on exit
function.

https://github.com/dex4er/Stardust/blob/master/examples/test_fork_exit.pl
https://github.com/dex4er/Stardust/blob/master/examples/test_rt40565.pl

Seems that it is a way to test Windows implementation on Linux too.

--
Piotr Roszatycki

[p5pRT]

From @iabyn

On Thu, Jan 23, 2014 at 04​:46​:54PM +0100, Piotr Roszatycki wrote​:

2014/1/23 Dave Mitchell <davem@​iabyn.com>​:

tests? I don't work on Windows, so I'm not in a position to do this.
(Note that SAVEt_SVREF isn't used in the core, so would be hard to test).

I've noticed that Strawberry Perl can be run with wine on Linux. I've
tried to run the example scripts from this bugreport​:

There's a big difference between installing Strawberry Perl under wine,
and installing a compiler, debugging tools etc, and building bleed.

--
The Enterprise successfully ferries an alien VIP from one place to another
without serious incident.
  -- Things That Never Happen in "Star Trek" #7

[p5pRT]

From @bulk88

Another report of this bug https​://rt.perl.org/Ticket/Display.html?id=123277 . 8 years and counting on this ticket. My first try at fixing it was ruled wrong https://rt-archive.perl.org/perl5/Ticket/Display.html?id=40565#txn-1277127 , and I am not confident enough to rework it.

--
bulk88 ~ bulk88 at hotmail.com