Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

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

Closed
p5pRT opened this issue Oct 19, 2006 · 53 comments

Comments

@p5pRT
Copy link
Collaborator

@p5pRT p5pRT commented Oct 19, 2006

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

Searchable as RT40565$

@p5pRT

This comment has been minimized.

Copy link
Collaborator Author

@p5pRT p5pRT commented Oct 19, 2006

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

This comment has been minimized.

Copy link
Collaborator Author

@p5pRT p5pRT commented Dec 25, 2012

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

This comment has been minimized.

Copy link
Collaborator Author

@p5pRT p5pRT commented Dec 25, 2012

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

@p5pRT

This comment has been minimized.

Copy link
Collaborator Author

@p5pRT p5pRT commented Dec 26, 2012

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

This comment has been minimized.

Copy link
Collaborator Author

@p5pRT p5pRT commented Dec 26, 2012

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

This comment has been minimized.

Copy link
Collaborator Author

@p5pRT p5pRT commented Dec 26, 2012

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

This comment has been minimized.

Copy link
Collaborator Author

@p5pRT p5pRT commented Dec 26, 2012

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

This comment has been minimized.

Copy link
Collaborator Author

@p5pRT p5pRT commented Jan 21, 2014

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

This comment has been minimized.

Copy link
Collaborator Author

@p5pRT p5pRT commented Jan 22, 2014

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

This comment has been minimized.

Copy link
Collaborator Author

@p5pRT p5pRT commented Jan 22, 2014

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

This comment has been minimized.

Copy link
Collaborator Author

@p5pRT p5pRT commented Jan 22, 2014

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

This comment has been minimized.

Copy link
Collaborator Author

@p5pRT p5pRT commented Jan 23, 2014

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

This comment has been minimized.

Copy link
Collaborator Author

@p5pRT p5pRT commented Jan 23, 2014

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

This comment has been minimized.

Copy link
Collaborator Author

@p5pRT p5pRT commented Jan 23, 2014

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

This comment has been minimized.

Copy link
Collaborator Author

@p5pRT p5pRT commented Nov 23, 2014

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

@p5pRT

This comment has been minimized.

Copy link
Collaborator Author

@p5pRT p5pRT commented Nov 26, 2014

From @cpansprout

On Sat Nov 22 22​:00​:47 2014, bulk88 wrote​:

Another report of this bug
https://rt-archive.perl.org/perl5/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.

Does this patch work for you?

--

Father Chrysostomos

@p5pRT

This comment has been minimized.

Copy link
Collaborator Author

@p5pRT p5pRT commented Nov 26, 2014

From @cpansprout

Inline Patch
diff --git a/ext/XS-APItest/t/clone-with-stack.t b/ext/XS-APItest/t/clone-with-stack.t
index 3f68c93..179fba0 100644
--- a/ext/XS-APItest/t/clone-with-stack.t
+++ b/ext/XS-APItest/t/clone-with-stack.t
@@ -17,7 +17,7 @@ if (not $Config{'useithreads'}) {
     skip_all("clone_with_stack requires threads");
 }
 
-plan(5);
+plan(6);
 
 fresh_perl_is( <<'----', <<'====', undef, "minimal clone_with_stack" );
 use XS::APItest;
@@ -78,3 +78,26 @@ f();
 ====
 
 }
+
+{
+    fresh_perl_is( <<'----', <<'====', undef, "with localised stuff" );
+use XS::APItest;
+$s = "outer";
+$a[0] = "anterior";
+$h{k} = "hale";
+{
+    local $s = "inner";
+    local $a[0] = 'posterior';
+    local $h{k} = "halt";
+    clone_with_stack();
+}
+print "scl: $s\n";
+print "ary: $a[0]\n";
+print "hsh: $h{k}\n";
+----
+scl: outer
+ary: anterior
+hsh: hale
+====
+
+}
diff --git a/sv.c b/sv.c
index c94a529..820cdc4 100644
--- a/sv.c
+++ b/sv.c
@@ -13910,14 +13910,16 @@ Perl_ss_dup(pTHX_ PerlInterpreter *proto_perl, CLONE_PARAMS* param)
 	case SAVEt_CLEARPADRANGE:
 	    break;
 	case SAVEt_HELEM:		/* hash element */
+	case SAVEt_SV:			/* scalar reference */
 	    sv = (const SV *)POPPTR(ss,ix);
-	    TOPPTR(nss,ix) = sv_dup_inc(sv, param);
+	    TOPPTR(nss,ix) = SvREFCNT_inc(sv_dup_inc(sv, param));
 	    /* FALLTHROUGH */
 	case SAVEt_ITEM:			/* normal string */
         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);
+	    if (type == SAVEt_SV)
+		break;
 	    /* FALLTHROUGH */
 	case SAVEt_FREESV:
 	case SAVEt_MORTALIZESV:
@@ -13935,6 +13937,8 @@ Perl_ss_dup(pTHX_ PerlInterpreter *proto_perl, CLONE_PARAMS* param)
         case SAVEt_SVREF:			/* scalar reference */
 	    sv = (const SV *)POPPTR(ss,ix);
 	    TOPPTR(nss,ix) = sv_dup_inc(sv, param);
+	    if (type == SAVEt_SVREF)
+		SvREFCNT_inc_simple_void((SV *)TOPPTR(nss,ix));
 	    ptr = POPPTR(ss,ix);
 	    TOPPTR(nss,ix) = svp_dup_inc((SV**)ptr, proto_perl);/* XXXXX */
 	    break;
@@ -14087,7 +14091,7 @@ Perl_ss_dup(pTHX_ PerlInterpreter *proto_perl, CLONE_PARAMS* param)
 	    break;
 	case SAVEt_AELEM:		/* array element */
 	    sv = (const SV *)POPPTR(ss,ix);
-	    TOPPTR(nss,ix) = sv_dup_inc(sv, param);
+	    TOPPTR(nss,ix) = SvREFCNT_inc(sv_dup_inc(sv, param));
 	    i = POPINT(ss,ix);
 	    TOPINT(nss,ix) = i;
 	    av = (const AV *)POPPTR(ss,ix);
@p5pRT

This comment has been minimized.

Copy link
Collaborator Author

@p5pRT p5pRT commented Dec 1, 2014

From @bulk88

On Tue Nov 25 21​:44​:46 2014, sprout wrote​:

On Sat Nov 22 22​:00​:47 2014, bulk88 wrote​:

Another report of this bug
https://rt-archive.perl.org/perl5/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.

Does this patch work for you?

Yes and no.

before with patched .t (to prove it fails since Father C doesn't have a Win32 machine)

C​:\perl521\srcnewb4opt\t>perl -I..\lib harness -v ext\XS-APItest\t\clone-with-st
ack.t
../ext/XS-APItest/t/clone-with-stack.t ..
1..6
ok 1 - minimal clone_with_stack
ok 2 - inside a subroutine
not ok 3 - inside a BEGIN block # TODO clone_with_stack inside a begin block
# Failed test 3 - inside a BEGIN block at ../../t/test.pl line 1019
# got ""
# expected "ok"
# PROG​:
# use XS​::APItest;
# BEGIN {
# clone_with_stack();
# }
# print "ok\n";
# STATUS​: 0
ok 4 - clone stack
ok 5 - with a lexical sub
# Failed test 6 - with localised stuff at ../../t/test.pl line 1019
# got "scl​: \nary​: \nhsh​: "
# expected "scl​: outer\nary​: anterior\nhsh​: hale"
# PROG​:
# use XS​::APItest;
# $s = "outer";
# $a[0] = "anterior";
# $h{k} = "hale";
# {
# local $s = "inner";
# local $a[0] = 'posterior';
# local $h{k} = "halt";
# clone_with_stack();
# }
# print "scl​: $s\n";
# print "ary​: $a[0]\n";
# print "hsh​: $h{k}\n";
# STATUS​: 0
not ok 6 - with localised stuff
Failed 1/6 subtests

Test Summary Report


../ext/XS-APItest/t/clone-with-stack.t (Wstat​: 0 Tests​: 6 Failed​: 1)
  Failed test​: 6
Files=1, Tests=6, 0 wallclock secs ( 0.02 usr + 0.00 sys = 0.02 CPU)
Result​: FAIL

C​:\perl521\srcnewb4opt\t>

After

C​:\perl521\srcnewb4opt\t>perl -I..\lib harness -v ext\XS-APItest\t\clone-with-st
ack.t
../ext/XS-APItest/t/clone-with-stack.t ..
1..6
ok 1 - minimal clone_with_stack
ok 2 - inside a subroutine
not ok 3 - inside a BEGIN block # TODO clone_with_stack inside a begin block
# Failed test 3 - inside a BEGIN block at ../../t/test.pl line 1019
# got ""
# expected "ok"
# PROG​:
# use XS​::APItest;
# BEGIN {
# clone_with_stack();
# }
# print "ok\n";
# STATUS​: 0
ok 4 - clone stack
ok 5 - with a lexical sub
ok 6 - with localised stuff
ok
All tests successful.
Files=1, Tests=6, 1 wallclock secs ( 0.03 usr + 0.00 sys = 0.03 CPU)
Result​: PASS

C​:\perl521\srcnewb4opt\t>

There is another crash in op/fork.t that this patch doesn't fix.

before, a op/fork.t crash, the crash isn't in fork.t but a child proc since all the tests use a fresh perl


C​:\perl521\srcnewb4opt\t>perl -I..\lib harness -v op\fork.t
op/fork.t ..
ok 1
ok 2
ok 3
ok 4
ok 5
PROG​:
$| = 1;
@​a = (1..3);
for (@​a) {
  if (fork) {
  print "parent $_\n";
  $_ = "[$_]";
  }
  else {
  print "child $_\n";
  $_ = "-$_-";
  }
}
print "@​a\n";
EXPECTED​:
parent 1
child 1
parent 2
child 2
parent 2
child 2
parent 3
child 3
parent 3
child 3
parent 3
child 3
parent 3
child 3
[1] [2] [3]
-1- [2] [3]
[1] -2- [3]
[1] [2] -3-
-1- -2- [3]
-1- [2] -3-
[1] -2- -3-
-1- -2- -3-
GOT​:
parent 1
child 1
parent 2
child 2
parent 2
child 2
parent 3
child 3
[1] -2- [3]
parent 3
-1- -2- [3]
child 3
parent 3
-1- [2] [3]
parent 3
[1] [2] [3]
child 3
child 3
# Failed test 6 - at op/fork.t line 16
not ok 6
ok 7
ok 8
ok 9
ok 10
ok 11
ok 12
ok 13
ok 14
ok 15
ok 16
ok 17
ok 18
ok 19
ok 20
ok 21
ok 22
ok 23
ok 24
ok 25
ok 26
ok 27
ok 28 # skip This test can only be run under bash or zsh
1..28
Failed 1/28 subtests
  (less 1 skipped subtest​: 26 okay)

Test Summary Report


op/fork.t (Wstat​: 0 Tests​: 28 Failed​: 1)
  Failed test​: 6
Files=1, Tests=28, 121 wallclock secs (37.05 usr + 0.00 sys = 37.05 CPU)
Result​: FAIL

C​:\perl521\srcnewb4opt\t>


crash code isolated


$| = 1;
@​a = (1..3);
for (@​a) {
  if (fork) {
  print "parent $_\n";
  $_ = "[$_]";
  }
  else {
  print "child $_\n";
  $_ = "-$_-";
  }
}
print "@​a\n";


with debugging [Win32's OS poisoning, not perl's poisoning] Heap on Win32 reliable causes a crash with

"Unhandled exception at 0x280882b6 (perl521.dll) in perl.exe​: 0xC0000005​: Access violation reading location 0xfeeefef2."

Pointer 0xfeeefef2 is freed memory obviously. Without debugging heap, this very very rarely and randomly crashes for me

crash call stack

  perl521.dll!S_SvREFCNT_dec(interpreter * my_perl=0x0096173c, sv * sv=0x0000001d) Line 162 C
  perl521.dll!Perl_leave_scope(interpreter * my_perl=0x009d382c, long base=3) Line 1162 C
  perl521.dll!Perl_pop_scope(interpreter * my_perl=0x0096173c) Line 104 + 0xc C
  perl521.dll!Perl_pp_leaveloop(interpreter * my_perl=0x009ef6e8) Line 2266 C
  perl521.dll!Perl_runops_standard(interpreter * my_perl=0x0096173c) Line 41 + 0x4 C
  perl521.dll!win32_start_child(void * arg=0x0096173c) Line 1779 C
  kernel32.dll!_BaseThreadStart@​8() + 0x37

IDK whether the patch should be applied, it fixes the local bug, but a similar save stack refcount bug still exists somewhere else.

--
bulk88 ~ bulk88 at hotmail.com

@p5pRT

This comment has been minimized.

Copy link
Collaborator Author

@p5pRT p5pRT commented Dec 1, 2014

From @cpansprout

On Sun Nov 30 18​:55​:18 2014, bulk88 wrote​:

On Tue Nov 25 21​:44​:46 2014, sprout wrote​:

On Sat Nov 22 22​:00​:47 2014, bulk88 wrote​:

Another report of this bug
https://rt-archive.perl.org/perl5/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.

Does this patch work for you?

Yes and no.

before with patched .t (to prove it fails since Father C doesn't have
a Win32 machine)

C​:\perl521\srcnewb4opt\t>perl -I..\lib harness -v ext\XS-
APItest\t\clone-with-st
ack.t
../ext/XS-APItest/t/clone-with-stack.t ..
1..6
ok 1 - minimal clone_with_stack
ok 2 - inside a subroutine
not ok 3 - inside a BEGIN block # TODO clone_with_stack inside a begin
block
# Failed test 3 - inside a BEGIN block at ../../t/test.pl line 1019
# got ""
# expected "ok"
# PROG​:
# use XS​::APItest;
# BEGIN {
# clone_with_stack();
# }
# print "ok\n";
# STATUS​: 0
ok 4 - clone stack
ok 5 - with a lexical sub
# Failed test 6 - with localised stuff at ../../t/test.pl line 1019
# got "scl​: \nary​: \nhsh​: "
# expected "scl​: outer\nary​: anterior\nhsh​: hale"
# PROG​:
# use XS​::APItest;
# $s = "outer";
# $a[0] = "anterior";
# $h{k} = "hale";
# {
# local $s = "inner";
# local $a[0] = 'posterior';
# local $h{k} = "halt";
# clone_with_stack();
# }
# print "scl​: $s\n";
# print "ary​: $a[0]\n";
# print "hsh​: $h{k}\n";
# STATUS​: 0
not ok 6 - with localised stuff
Failed 1/6 subtests

Test Summary Report
-------------------
../ext/XS-APItest/t/clone-with-stack.t (Wstat​: 0 Tests​: 6 Failed​: 1)
Failed test​: 6
Files=1, Tests=6, 0 wallclock secs ( 0.02 usr + 0.00 sys = 0.02
CPU)
Result​: FAIL

C​:\perl521\srcnewb4opt\t>

After

C​:\perl521\srcnewb4opt\t>perl -I..\lib harness -v ext\XS-
APItest\t\clone-with-st
ack.t
../ext/XS-APItest/t/clone-with-stack.t ..
1..6
ok 1 - minimal clone_with_stack
ok 2 - inside a subroutine
not ok 3 - inside a BEGIN block # TODO clone_with_stack inside a begin
block
# Failed test 3 - inside a BEGIN block at ../../t/test.pl line 1019
# got ""
# expected "ok"
# PROG​:
# use XS​::APItest;
# BEGIN {
# clone_with_stack();
# }
# print "ok\n";
# STATUS​: 0
ok 4 - clone stack
ok 5 - with a lexical sub
ok 6 - with localised stuff
ok
All tests successful.
Files=1, Tests=6, 1 wallclock secs ( 0.03 usr + 0.00 sys = 0.03
CPU)
Result​: PASS

C​:\perl521\srcnewb4opt\t>

There is another crash in op/fork.t that this patch doesn't fix.
...
crash code isolated
--------------------------------------------------
$| = 1;
@​a = (1..3);
for (@​a) {
if (fork) {
print "parent $_\n";
$_ = "[$_]";
}
else {
print "child $_\n";
$_ = "-$_-";
}
}
print "@​a\n";
--------------------------------------------------
with debugging [Win32's OS poisoning, not perl's poisoning] Heap on
Win32 reliable causes a crash with

"Unhandled exception at 0x280882b6 (perl521.dll) in perl.exe​:
0xC0000005​: Access violation reading location 0xfeeefef2."

Pointer 0xfeeefef2 is freed memory obviously. Without debugging heap,
this very very rarely and randomly crashes for me

crash call stack

perl521.dll!S_SvREFCNT_dec(interpreter * my_perl=0x0096173c, sv *
sv=0x0000001d) Line 162 C
perl521.dll!Perl_leave_scope(interpreter * my_perl=0x009d382c, long
base=3) Line 1162 C
perl521.dll!Perl_pop_scope(interpreter * my_perl=0x0096173c) Line 104
+ 0xc C
perl521.dll!Perl_pp_leaveloop(interpreter * my_perl=0x009ef6e8) Line
2266 C
perl521.dll!Perl_runops_standard(interpreter * my_perl=0x0096173c)
Line 41 + 0x4 C
perl521.dll!win32_start_child(void * arg=0x0096173c) Line 1779 C
kernel32.dll!_BaseThreadStart@​8() + 0x37

IDK whether the patch should be applied, it fixes the local bug, but a
similar save stack refcount bug still exists somewhere else.

Does this fork test fail the same way without my patch?

--

Father Chrysostomos

@p5pRT

This comment has been minimized.

Copy link
Collaborator Author

@p5pRT p5pRT commented Dec 1, 2014

From @bulk88

On Sun Nov 30 21​:57​:51 2014, sprout wrote​:

Does this fork test fail the same way without my patch?

Your patch only affects SAVEt_SV, my rejected patch in https://rt-archive.perl.org/perl5/Ticket/Display.html?id=40565#txn-1180396 was for types SAVEt_GVSV and SAVEt_SV (and SAVEt_ITEM but IDK what SAVEt_ITEM is) and the fork.t test 6 crash is with type SAVEt_GVSV, not SAVEt_SV.

  perl521.dll!Perl_save_pushptrptr(interpreter * my_perl=0x00365d74, void * const ptr1=0x00368d14, void * const ptr2=0x0090d7c4, const int type=29) Line 209 C
  perl521.dll!Perl_pp_enteriter(interpreter * my_perl=0x00365d74) Line 2118 + 0x1e C
  perl521.dll!Perl_runops_debug(interpreter * my_perl=0x00365d74) Line 2215 + 0xd C
  perl521.dll!S_run_body(interpreter * my_perl=0x00365d74, long oldscope=1) Line 2420 + 0xd C
  perl521.dll!perl_run(interpreter * my_perl=0x00365d74) Line 2346 C
  perl521.dll!RunPerl(int argc=2, char * * argv=0x00362478, char * * env=0x00362a38) Line 258 + 0x9 C++
  perl.exe!mainCRTStartup() Line 398 + 0xe C
  kernel32.dll!_BaseProcessStart@​4() + 0x23

pp_enteriter line is http​://perl5.git.perl.org/perl.git/blob/30c67ec60146a2650dd27e865da8a2e7b216b925​:/pp_ctl.c#l2118

curcop is at


$| = 1;
@​a = (1..3);
for (@​a) {<<<<<<<<<<<<<<<<<<<<<<<<<<<<
  if (fork) {
  print "parent $_\n";
  $_ = "[$_]";
  }
  else {
  print "child $_\n";
  $_ = "-$_-";
  }
}
print "@​a\n";


  case SAVEt_ITEM​: /* normal string */
  case SAVEt_GVSV​: /* scalar slot in GV */
  sv = (const SV *)POPPTR(ss,ix);
  {
  SV * newsv = sv_dup_inc(sv, param);
  TOPPTR(nss,ix) = newsv;
  }
  if (type == SAVEt_SV)
  break;
  /* FALLTHROUGH */


in the pp_enteriter savestack entry, what goes into sv_dup_inc has refcount 2, newsv (thats my code) comes out with refcnt 1 but that doesn't seem to be the reason for the crash. The GP struct was freed at some point per the attached pic.

I will need to do more debugging on why the GP struct was freed. I am hesitant to revert before your patch due to compiling time, so I'll go after the GP struct problem.

--
bulk88 ~ bulk88 at hotmail.com

@p5pRT

This comment has been minimized.

Copy link
Collaborator Author

@p5pRT p5pRT commented Dec 1, 2014

From @bulk88

On Sun Nov 30 23​:17​:37 2014, bulk88 wrote​:

The GP struct was freed
at some point per the attached pic.

Forgot pic.

--
bulk88 ~ bulk88 at hotmail.com

@p5pRT

This comment has been minimized.

Copy link
Collaborator Author

@p5pRT p5pRT commented Dec 1, 2014

From @bulk88

[fork test 6 segv gv struct.PNG](https://rt-archive.perl.org/perl5/Ticket/Attachment/1320853/703638/fork test 6 segv gv struct.PNG)

@p5pRT

This comment has been minimized.

Copy link
Collaborator Author

@p5pRT p5pRT commented Dec 1, 2014

From @bulk88

On Sun Nov 30 23​:17​:37 2014, bulk88 wrote​:

I will need to do more debugging on why the GP struct was freed. I am
hesitant to revert before your patch due to compiling time, so I'll go
after the GP struct problem.

The GP was freed by a SAVEt_GP_ALIASED_SV.

  perl521.dll!Perl_save_aliased_sv(interpreter * my_perl=0x00365d74, gv * gv=0x00368d14) Line 729 C
  perl521.dll!Perl_pp_enteriter(interpreter * my_perl=0x00365d74) Line 2121 + 0xd C
  perl521.dll!Perl_runops_debug(interpreter * my_perl=0x00365d74) Line 2215 + 0xd C
  perl521.dll!S_run_body(interpreter * my_perl=0x00365d74, long oldscope=0x00000001) Line 2420 + 0xd C
  perl521.dll!perl_run(interpreter * my_perl=0x00365d74) Line 2346 C
  perl521.dll!RunPerl(int argc=0x00000002, char * * argv=0x00362478, char * * env=0x00362a38) Line 258 + 0x9 C++
  perl.exe!mainCRTStartup() Line 398 + 0xe C
  kernel32.dll!_BaseProcessStart@​4() + 0x23

pp_enteriter is at http​://perl5.git.perl.org/perl.git/blob/30c67ec60146a2650dd27e865da8a2e7b216b925​:/pp_ctl.c#l2121

but I noticed something strange.

"Skip no-common-vars optimisation for aliases" http​://perl5.git.perl.org/perl.git/commitdiff/ff2a62e0c8bedade55bf86a22861a2fe06bb0a16 which is an FC commit

@​@​ -13896,6 +13912,11 @​@​ Perl_ss_dup(pTHX_ PerlInterpreter *proto_perl, CLONE_PARAMS* param)
  ptr = POPPTR(ss,ix);
  TOPPTR(nss,ix) = parser_dup((const yy_parser*)ptr, param);
  break;
+ case SAVEt_GP_ALIASED_SV​:
+ ptr = POPPTR(ss,ix);
+ TOPPTR(nss,ix) = gp_dup((GP *)ptr, param);
+ ((GP *)ptr)->gp_refcnt++;<<<<<<<<<<<IS THIS SANE? why is it on parent GP and not child GP? Why is this direct++ and not GpREFCNT_inc or gp_ref()? <<<<<<<<<<<<<<
+ break;
  default​:
  Perl_croak(aTHX_
  "panic​: ss_dup inconsistency (%"IVdf")", (IV) type);


/* hopefully this is only called on local symbol table entries */

GP*
Perl_gp_ref(pTHX_ GP *gp)
{
  if (!gp)
  return NULL;
  gp->gp_refcnt++;
  if (gp->gp_cv) {
  if (gp->gp_cvgen) {
  /* If the GP they asked for a reference to contains
  a method cache entry, clear it first, so that we
  don't infect them with our cached entry */
  SvREFCNT_dec_NN(gp->gp_cv);
  gp->gp_cv = NULL;
  gp->gp_cvgen = 0;
  }
  }
  return gp;
}


void
Perl_save_aliased_sv(pTHX_ GV *gv)
{
  dSS_ADD;
  PERL_ARGS_ASSERT_SAVE_ALIASED_SV;
  SS_ADD_PTR(gp_ref(GvGP(gv)));
  SS_ADD_UV(SAVEt_GP_ALIASED_SV | cBOOL(GvALIASED_SV(gv)) << 8);
  SS_ADD_END(2);
}


What is the purpose of GpREFCNT_inc then? (GpREFCNT_inc blamed to http​://perl5.git.perl.org/perl.git/commitdiff/1d7c184104c076988718a01b77c8706aae05b092#patch2 comment "/* XXX Remove this so it doesn't have to go thru the macro and return for nothing */" to http​://perl5.git.perl.org/perl.git/commitdiff/d4c19fe8d8a6e04364af0548bf783e83ab5987d2 with no background offered)

"Make list assignment respect foreach aliasing" http​://perl5.git.perl.org/perl.git/commitdiff/c997e36218768fb357b1f3d160131f259311e3a3

--
bulk88 ~ bulk88 at hotmail.com

@p5pRT

This comment has been minimized.

Copy link
Collaborator Author

@p5pRT p5pRT commented Dec 2, 2014

From @cpansprout

On Mon Dec 01 00​:08​:03 2014, bulk88 wrote​:

but I noticed something strange.

"Skip no-common-vars optimisation for aliases"
http​://perl5.git.perl.org/perl.git/commitdiff/ff2a62e0c8bedade55bf86a22861a2fe06bb0a16
which is an FC commit
...
What is the purpose of GpREFCNT_inc then? (GpREFCNT_inc blamed to
http​://perl5.git.perl.org/perl.git/commitdiff/1d7c184104c076988718a01b77c8706aae05b092#patch2
comment "/* XXX Remove this so it doesn't have to go thru the macro
and return for nothing */" to
http​://perl5.git.perl.org/perl.git/commitdiff/d4c19fe8d8a6e04364af0548bf783e83ab5987d2
with no background offered)

I was not aware of GpREFCNT_inc (didn’t notice it). It this particular case, it would add a redundant null check. The gp is always non-null for SAVEt_GP_ALIASED_SV. I don‘t know about the cases that use GpREFCNT_inc.

Now that your patch from #123339 is applied, does my patch work?

--

Father Chrysostomos

@p5pRT

This comment has been minimized.

Copy link
Collaborator Author

@p5pRT p5pRT commented Dec 3, 2014

From @bulk88

On Mon Dec 01 21​:42​:11 2014, sprout wrote​:

I was not aware of GpREFCNT_inc (didn’t notice it). It this
particular case, it would add a redundant null check. The gp is
always non-null for SAVEt_GP_ALIASED_SV. I don‘t know about the cases
that use GpREFCNT_inc.

Now that your patch from #123339 is applied, does my patch work?

Yes please apply and backport to 5.20 and 5.18. Im not sure what wording you are planning for the perldelta.
"
= item *

On Win32 Unwinding [or Restoring?] in a child psudo-process a variable that was C<local()>ed in a parent psudo-process before the C<fork> happened [executed?], caused memory corruption and a crash in the child psudo-process (and therefore OS process).
"

Fixing this means the only 2 major bugs left in psuedo-fork are you can't fork() in a BEGIN (I think) and no IO calls on Win32 from CLONE method. This local() bug is years overdue from being fixed and pretty bad bug, since local() is a basic part of Perl 5 lang.

--
bulk88 ~ bulk88 at hotmail.com

@p5pRT

This comment has been minimized.

Copy link
Collaborator Author

@p5pRT p5pRT commented Dec 3, 2014

From @cpansprout

On Tue Dec 02 18​:53​:41 2014, bulk88 wrote​:

On Mon Dec 01 21​:42​:11 2014, sprout wrote​:

I was not aware of GpREFCNT_inc (didn’t notice it). It this
particular case, it would add a redundant null check. The gp is
always non-null for SAVEt_GP_ALIASED_SV. I don‘t know about the
cases
that use GpREFCNT_inc.

Now that your patch from #123339 is applied, does my patch work?

Yes please apply and backport to 5.20 and 5.18. Im not sure what
wording you are planning for the perldelta.
"
= item *

On Win32 Unwinding [or Restoring?] in a child psudo-process a variable
that was C<local()>ed in a parent psudo-process before the C<fork>
happened [executed?], caused memory corruption and a crash in the
child psudo-process (and therefore OS process).
"

Fixing this means the only 2 major bugs left in psuedo-fork are you
can't fork() in a BEGIN (I think) and no IO calls on Win32 from CLONE
method. This local() bug is years overdue from being fixed and pretty
bad bug, since local() is a basic part of Perl 5 lang.

Thank you. I have applied it as 83a9455. I do think this should be backported.

--

Father Chrysostomos

@p5pRT

This comment has been minimized.

Copy link
Collaborator Author

@p5pRT p5pRT commented Dec 6, 2014

@steve-m-hay - Status changed from 'open' to 'pending release'

@p5pRT

This comment has been minimized.

Copy link
Collaborator Author

@p5pRT p5pRT commented Dec 11, 2014

From @exodist

Is this fix something that can possibly be wrapped in an XS module for even
older perl versions? I mainly ask because this effects Test-Simple, because
of this bug tests that fork have major issues on windows in some common
situations.

I am not super familiar with XS or patching, so I will accept "That is not
possible" without question should that be the answer :-)

-Chad

On Wed, Dec 3, 2014 at 12​:43 PM, Father Chrysostomos via RT <
perlbug-followup@​perl.org> wrote​:

On Tue Dec 02 18​:53​:41 2014, bulk88 wrote​:

On Mon Dec 01 21​:42​:11 2014, sprout wrote​:

I was not aware of GpREFCNT_inc (didn’t notice it). It this
particular case, it would add a redundant null check. The gp is
always non-null for SAVEt_GP_ALIASED_SV. I don‘t know about the
cases
that use GpREFCNT_inc.

Now that your patch from #123339 is applied, does my patch work?

Yes please apply and backport to 5.20 and 5.18. Im not sure what
wording you are planning for the perldelta.
"
= item *

On Win32 Unwinding [or Restoring?] in a child psudo-process a variable
that was C<local()>ed in a parent psudo-process before the C<fork>
happened [executed?], caused memory corruption and a crash in the
child psudo-process (and therefore OS process).
"

Fixing this means the only 2 major bugs left in psuedo-fork are you
can't fork() in a BEGIN (I think) and no IO calls on Win32 from CLONE
method. This local() bug is years overdue from being fixed and pretty
bad bug, since local() is a basic part of Perl 5 lang.

Thank you. I have applied it as 83a9455. I do think this should be
backported.

--

Father Chrysostomos

---
via perlbug​: queue​: perl5 status​: open
https://rt-archive.perl.org/perl5/Ticket/Display.html?id=40565

@p5pRT

This comment has been minimized.

Copy link
Collaborator Author

@p5pRT p5pRT commented Dec 11, 2014

From @cpansprout

On Thu Dec 11 08​:10​:45 2014, exodist7@​gmail.com wrote​:

Is this fix something that can possibly be wrapped in an XS module for even
older perl versions? I mainly ask because this effects Test-Simple, because
of this bug tests that fork have major issues on windows in some common
situations.

I am not super familiar with XS or patching, so I will accept "That is not
possible" without question should that be the answer :-)

That is nearly impossible. :-) I think you would have to copy and paste most of the thread-cloning code into the XS module, and then you would have to maintain multiple versions of it.

--

Father Chrysostomos

@p5pRT

This comment has been minimized.

Copy link
Collaborator Author

@p5pRT p5pRT commented Dec 11, 2014

From @bulk88

On Thu Dec 11 09​:11​:57 2014, sprout wrote​:

That is nearly impossible. :-) I think you would have to copy and
paste most of the thread-cloning code into the XS module, and then you
would have to maintain multiple versions of it.

Yes you will have to copy-paste ss_dup. You will have to maintain different versions of it (the save stack types change over time). Patch it isn't the hardest thing to do on Win32 from XS. Look in export table(GetProcAddress) of perl5**.dll for Perl_ss_dup (Why on earth its exported who knows? its probably a bad decision in the 1st release of embed.fnc, or a very smart decision), make the page "rw-", put in a jump x86 op to the new function in the XS DLL, make page "r-x", release control back to perl from your BEGIN block.

How badly do you want it?

--
bulk88 ~ bulk88 at hotmail.com

@p5pRT

This comment has been minimized.

Copy link
Collaborator Author

@p5pRT p5pRT commented Dec 11, 2014

From @bulk88

On Thu Dec 11 10​:56​:50 2014, bulk88 wrote​:

On Thu Dec 11 09​:11​:57 2014, sprout wrote​:

That is nearly impossible. :-) I think you would have to copy and
paste most of the thread-cloning code into the XS module, and then
you
would have to maintain multiple versions of it.

Yes you will have to copy-paste ss_dup. You will have to maintain
different versions of it (the save stack types change over time).
Patch it isn't the hardest thing to do on Win32 from XS. Look in
export table(GetProcAddress) of perl5**.dll for Perl_ss_dup (Why on
earth its exported who knows? its probably a bad decision in the 1st
release of embed.fnc, or a very smart decision), make the page "rw-",
put in a jump x86 op to the new function in the XS DLL, make page "r-
x", release control back to perl from your BEGIN block.

How badly do you want it?

The other semi-PP idea is before you local the value, save the old SV * with "push(@​array, (\$value)+0);", on entry b4 the local statement, after the fork go through all of @​array with Devel​::FindRef​::ptr2ref, and do something like

my $ref = Devel​::FindRef​::ptr2ref(pop(@​array));
my $old = Internals​::SvREFCNT(${ref});
$old++;
Internals​::SvREFCNT(${ref}, $old);

in a loop. Above code is untested.

--
bulk88 ~ bulk88 at hotmail.com

@p5pRT

This comment has been minimized.

Copy link
Collaborator Author

@p5pRT p5pRT commented Dec 11, 2014

From @bulk88

On Thu Dec 11 10​:58​:35 2014, exodist7@​gmail.com wrote​:

Not bad enough to own it.

I could try to write such a thing, I just need to know there will be a serious user base for the module since I'll never be writing that "use Win32​::FixMyForkCrash;" line for any of my private code since I dont use Win32 psuedofork and never ran into the bug myself.

--
bulk88 ~ bulk88 at hotmail.com

@p5pRT

This comment has been minimized.

Copy link
Collaborator Author

@p5pRT p5pRT commented Dec 11, 2014

From @exodist

https://github.com/Test-More/test-more/blob/master/lib/Test/Stream/Util.pm

Mainly I am looking for something I can do with the 3 functions that use
local in the above file. The functions are thankfully small and contained.
If I could make them work in windows on older perls that would be awesome!

On Thu, Dec 11, 2014 at 11​:06 AM, bulk88 via RT <perlbug-followup@​perl.org>
wrote​:

On Thu Dec 11 10​:56​:50 2014, bulk88 wrote​:

On Thu Dec 11 09​:11​:57 2014, sprout wrote​:

That is nearly impossible. :-) I think you would have to copy and
paste most of the thread-cloning code into the XS module, and then
you
would have to maintain multiple versions of it.

Yes you will have to copy-paste ss_dup. You will have to maintain
different versions of it (the save stack types change over time).
Patch it isn't the hardest thing to do on Win32 from XS. Look in
export table(GetProcAddress) of perl5**.dll for Perl_ss_dup (Why on
earth its exported who knows? its probably a bad decision in the 1st
release of embed.fnc, or a very smart decision), make the page "rw-",
put in a jump x86 op to the new function in the XS DLL, make page "r-
x", release control back to perl from your BEGIN block.

How badly do you want it?

The other semi-PP idea is before you local the value, save the old SV *
with "push(@​array, (\$value)+0);", on entry b4 the local statement, after
the fork go through all of @​array with Devel​::FindRef​::ptr2ref, and do
something like

my $ref = Devel​::FindRef​::ptr2ref(pop(@​array));
my $old = Internals​::SvREFCNT(${ref});
$old++;
Internals​::SvREFCNT(${ref}, $old);

in a loop. Above code is untested.

--
bulk88 ~ bulk88 at hotmail.com

---
via perlbug​: queue​: perl5 status​: pending release
https://rt-archive.perl.org/perl5/Ticket/Display.html?id=40565

@p5pRT

This comment has been minimized.

Copy link
Collaborator Author

@p5pRT p5pRT commented Dec 11, 2014

From @exodist

I could try to write such a thing, I just need to know there will be a
serious user base for the module since I'll never be writing that "use
Win32​::FixMyForkCrash;" line for any of my private code since I dont use
Win32 psuedofork and never ran into the bug myself.

Pretty much anyone who uses Test-Simple on windows would be a user of this.
Right now I have several tests simply skip on windows. Anyone who writes
tests that fork (a lot more likely with the recently added fork support
code) would have issues on windows unless we get something like this.

-Chad

@p5pRT

This comment has been minimized.

Copy link
Collaborator Author

@p5pRT p5pRT commented Dec 11, 2014

From @exodist

I could try to write such a thing, I just need to know there will be a
serious user base for the module since I'll never be writing that "use
Win32​::FixMyForkCrash;" line for any of my private code since I dont use
Win32 psuedofork and never ran into the bug myself.

Pretty much anyone who uses Test-Simple on windows would be a user of
this. Right now I have several tests simply skip on windows. Anyone who
writes tests that fork (a lot more likely with the recently added fork
support code) would have issues on windows unless we get something like
this.

@p5pRT

This comment has been minimized.

Copy link
Collaborator Author

@p5pRT p5pRT commented Dec 11, 2014

From @exodist

The most ideal solution would be something that uses only core modules I
can put into
https://github.com/Test-More/test-more/blob/master/lib/Test/Stream/Util.pm
to make those locals safe.

@p5pRT

This comment has been minimized.

Copy link
Collaborator Author

@p5pRT p5pRT commented Dec 11, 2014

From @bulk88

On Thu Dec 11 11​:16​:00 2014, exodist7@​gmail.com wrote​:

https://github.com/Test-More/test-more/blob/master/lib/Test/Stream/Util.pm

Mainly I am looking for something I can do with the 3 functions that use
local in the above file. The functions are thankfully small and contained.
If I could make them work in windows on older perls that would be awesome!

Why doesn't

my $dolocal;
if($^O eq 'MSWin32' && $] < 5.020002) { #rework so they use constant subs for folding
  my $oldEVAL_ERROR = $@​;
  my $oldERRNO = $!;
} else {
  $dolocal = 1;
}
local ($@​, $!) if $dolocal;

work ?

On Thu Dec 11 11​:17​:36 2014, exodist7@​gmail.com wrote​:

Pretty much anyone who uses Test-Simple on windows would be a user of this.
Right now I have several tests simply skip on windows. Anyone who writes
tests that fork (a lot more likely with the recently added fork support
code) would have issues on windows unless we get something like this.

-Chad

My worry is, the rest of CPAN authors put in "skip if Win32" from "5.8.0 2002-Jul-18" to Dec 2014, 12 years [1], if not counting from the bug report filing date which was 8 years ago. Half the code that put in "skip if Win32" is dead/abandoned/minimally maintained, and *nobody* except you will revisit any "skip if Win32" statements or add "use Win32​::FixMyForkCrash;" unless I (bulk88) personally submit patches. Chicken and the egg.

[1] the real time is longer than 12 years, probably 13 years, since until 5.22.0 and 5.21.2 are released, this bug is "open" and fork is "broken".

--
bulk88 ~ bulk88 at hotmail.com

@p5pRT

This comment has been minimized.

Copy link
Collaborator Author

@p5pRT p5pRT commented Dec 11, 2014

From @exodist

I could give something like that a try.

On Thu, Dec 11, 2014 at 11​:40 AM, bulk88 via RT <perlbug-followup@​perl.org>
wrote​:

On Thu Dec 11 11​:16​:00 2014, exodist7@​gmail.com wrote​:

https://github.com/Test-More/test-more/blob/master/lib/Test/Stream/Util.pm

Mainly I am looking for something I can do with the 3 functions that use
local in the above file. The functions are thankfully small and
contained.
If I could make them work in windows on older perls that would be
awesome!

Why doesn't

my $dolocal;
if($^O eq 'MSWin32' && $] < 5.020002) { #rework so they use constant subs
for folding
my $oldEVAL_ERROR = $@​;
my $oldERRNO = $!;
} else {
$dolocal = 1;
}
local ($@​, $!) if $dolocal;

work ?

On Thu Dec 11 11​:17​:36 2014, exodist7@​gmail.com wrote​:

Pretty much anyone who uses Test-Simple on windows would be a user of
this.
Right now I have several tests simply skip on windows. Anyone who writes
tests that fork (a lot more likely with the recently added fork support
code) would have issues on windows unless we get something like this.

-Chad

My worry is, the rest of CPAN authors put in "skip if Win32" from "5.8.0
2002-Jul-18" to Dec 2014, 12 years [1], if not counting from the bug report
filing date which was 8 years ago. Half the code that put in "skip if
Win32" is dead/abandoned/minimally maintained, and *nobody* except you will
revisit any "skip if Win32" statements or add "use Win32​::FixMyForkCrash;"
unless I (bulk88) personally submit patches. Chicken and the egg.

[1] the real time is longer than 12 years, probably 13 years, since until
5.22.0 and 5.21.2 are released, this bug is "open" and fork is "broken".

--
bulk88 ~ bulk88 at hotmail.com

---
via perlbug​: queue​: perl5 status​: pending release
https://rt-archive.perl.org/perl5/Ticket/Display.html?id=40565

@p5pRT

This comment has been minimized.

Copy link
Collaborator Author

@p5pRT p5pRT commented Dec 11, 2014

From @exodist

Is the bug significant enough to release a new 5.8, 5.10, 5.12, 5.14, 5.16,
5.18 versions as well?

On Thu, Dec 11, 2014 at 11​:43 AM, Chad Granum <exodist7@​gmail.com> wrote​:

I could give something like that a try.

On Thu, Dec 11, 2014 at 11​:40 AM, bulk88 via RT <perlbug-followup@​perl.org

wrote​:

On Thu Dec 11 11​:16​:00 2014, exodist7@​gmail.com wrote​:

https://github.com/Test-More/test-more/blob/master/lib/Test/Stream/Util.pm

Mainly I am looking for something I can do with the 3 functions that use
local in the above file. The functions are thankfully small and
contained.
If I could make them work in windows on older perls that would be
awesome!

Why doesn't

my $dolocal;
if($^O eq 'MSWin32' && $] < 5.020002) { #rework so they use constant subs
for folding
my $oldEVAL_ERROR = $@​;
my $oldERRNO = $!;
} else {
$dolocal = 1;
}
local ($@​, $!) if $dolocal;

work ?

On Thu Dec 11 11​:17​:36 2014, exodist7@​gmail.com wrote​:

Pretty much anyone who uses Test-Simple on windows would be a user of
this.
Right now I have several tests simply skip on windows. Anyone who writes
tests that fork (a lot more likely with the recently added fork support
code) would have issues on windows unless we get something like this.

-Chad

My worry is, the rest of CPAN authors put in "skip if Win32" from "5.8.0
2002-Jul-18" to Dec 2014, 12 years [1], if not counting from the bug report
filing date which was 8 years ago. Half the code that put in "skip if
Win32" is dead/abandoned/minimally maintained, and *nobody* except you will
revisit any "skip if Win32" statements or add "use Win32​::FixMyForkCrash;"
unless I (bulk88) personally submit patches. Chicken and the egg.

[1] the real time is longer than 12 years, probably 13 years, since until
5.22.0 and 5.21.2 are released, this bug is "open" and fork is "broken".

--
bulk88 ~ bulk88 at hotmail.com

---
via perlbug​: queue​: perl5 status​: pending release
https://rt-archive.perl.org/perl5/Ticket/Display.html?id=40565

@p5pRT

This comment has been minimized.

Copy link
Collaborator Author

@p5pRT p5pRT commented Dec 11, 2014

From @exodist

Ok, code similar to what bulk88 suggested seems to fix a majority of my
windows woes (I got a vm spun up to test).

On Thu, Dec 11, 2014 at 11​:59 AM, Chad Granum <exodist7@​gmail.com> wrote​:

Is the bug significant enough to release a new 5.8, 5.10, 5.12, 5.14,
5.16, 5.18 versions as well?

On Thu, Dec 11, 2014 at 11​:43 AM, Chad Granum <exodist7@​gmail.com> wrote​:

I could give something like that a try.

On Thu, Dec 11, 2014 at 11​:40 AM, bulk88 via RT <
perlbug-followup@​perl.org> wrote​:

On Thu Dec 11 11​:16​:00 2014, exodist7@​gmail.com wrote​:

https://github.com/Test-More/test-more/blob/master/lib/Test/Stream/Util.pm

Mainly I am looking for something I can do with the 3 functions that
use
local in the above file. The functions are thankfully small and
contained.
If I could make them work in windows on older perls that would be
awesome!

Why doesn't

my $dolocal;
if($^O eq 'MSWin32' && $] < 5.020002) { #rework so they use constant
subs for folding
my $oldEVAL_ERROR = $@​;
my $oldERRNO = $!;
} else {
$dolocal = 1;
}
local ($@​, $!) if $dolocal;

work ?

On Thu Dec 11 11​:17​:36 2014, exodist7@​gmail.com wrote​:

Pretty much anyone who uses Test-Simple on windows would be a user of
this.
Right now I have several tests simply skip on windows. Anyone who
writes
tests that fork (a lot more likely with the recently added fork support
code) would have issues on windows unless we get something like this.

-Chad

My worry is, the rest of CPAN authors put in "skip if Win32" from "5.8.0
2002-Jul-18" to Dec 2014, 12 years [1], if not counting from the bug report
filing date which was 8 years ago. Half the code that put in "skip if
Win32" is dead/abandoned/minimally maintained, and *nobody* except you will
revisit any "skip if Win32" statements or add "use Win32​::FixMyForkCrash;"
unless I (bulk88) personally submit patches. Chicken and the egg.

[1] the real time is longer than 12 years, probably 13 years, since
until 5.22.0 and 5.21.2 are released, this bug is "open" and fork is
"broken".

--
bulk88 ~ bulk88 at hotmail.com

---
via perlbug​: queue​: perl5 status​: pending release
https://rt-archive.perl.org/perl5/Ticket/Display.html?id=40565

@p5pRT

This comment has been minimized.

Copy link
Collaborator Author

@p5pRT p5pRT commented Dec 11, 2014

From @cpansprout

On Thu Dec 11 11​:59​:44 2014, exodist7@​gmail.com wrote​:

Is the bug significant enough to release a new 5.8, 5.10, 5.12, 5.14,
5.16,
5.18 versions as well?

5.18.5, probably yes. The others, probably no. The policy (which is mostly a guideline) is that we only release security fixes for earlier versions. It’s mainly because that’s a lot of work and you’ll have trouble finding enough people to volunteer for it.

--

Father Chrysostomos

@p5pRT

This comment has been minimized.

Copy link
Collaborator Author

@p5pRT p5pRT commented Dec 11, 2014

From @cpansprout

On Thu Dec 11 12​:45​:55 2014, exodist7@​gmail.com wrote​:

Ok, code similar to what bulk88 suggested seems to fix a majority of
my
windows woes (I got a vm spun up to test).

BTW, if you need the manual localisation unwound for every type of scope exit (e.g., goto, next), then a destructor-calling-a-closure may also work, as in End.pm and B​::Hooks​::EndOfScope (which are so trivial you could inline them with just 2-3 lines of code).

--

Father Chrysostomos

@p5pRT

This comment has been minimized.

Copy link
Collaborator Author

@p5pRT p5pRT commented Dec 12, 2014

From @exodist

Ah, yeah, I have done that before (in fact there is a similar one in
Test​::More already). I will consider it!

On Thu, Dec 11, 2014 at 2​:46 PM, Father Chrysostomos via RT <
perlbug-followup@​perl.org> wrote​:

On Thu Dec 11 12​:45​:55 2014, exodist7@​gmail.com wrote​:

Ok, code similar to what bulk88 suggested seems to fix a majority of
my
windows woes (I got a vm spun up to test).

BTW, if you need the manual localisation unwound for every type of scope
exit (e.g., goto, next), then a destructor-calling-a-closure may also work,
as in End.pm and B​::Hooks​::EndOfScope (which are so trivial you could
inline them with just 2-3 lines of code).

--

Father Chrysostomos

---
via perlbug​: queue​: perl5 status​: pending release
https://rt-archive.perl.org/perl5/Ticket/Display.html?id=40565

@p5pRT

This comment has been minimized.

Copy link
Collaborator Author

@p5pRT p5pRT commented Dec 12, 2014

From @exodist

On that note someone mentioned to me that all it takes is someone with a
commit bit to be willing to act as release manager for a special release of
older versions to make it happen. I do not have a commit bit, but if I were
willing to act as a release manager for a special maint release of 5.8-5.16
would that be workable? Note I am just asking at this point, not sure I
would be able to commit the time to it yet.

Even then though, chances of everyone upgrading to a new 5.8 are pretty
slim, so I am not sure it would be worth it. I still have to support the
versions with the broken behavior regardless.

-Chad

On Fri, Dec 12, 2014 at 10​:51 AM, Chad Granum <exodist7@​gmail.com> wrote​:

Ah, yeah, I have done that before (in fact there is a similar one in
Test​::More already). I will consider it!

On Thu, Dec 11, 2014 at 2​:46 PM, Father Chrysostomos via RT <
perlbug-followup@​perl.org> wrote​:

On Thu Dec 11 12​:45​:55 2014, exodist7@​gmail.com wrote​:

Ok, code similar to what bulk88 suggested seems to fix a majority of
my
windows woes (I got a vm spun up to test).

BTW, if you need the manual localisation unwound for every type of scope
exit (e.g., goto, next), then a destructor-calling-a-closure may also work,
as in End.pm and B​::Hooks​::EndOfScope (which are so trivial you could
inline them with just 2-3 lines of code).

--

Father Chrysostomos

---
via perlbug​: queue​: perl5 status​: pending release
https://rt-archive.perl.org/perl5/Ticket/Display.html?id=40565

@p5pRT

This comment has been minimized.

Copy link
Collaborator Author

@p5pRT p5pRT commented Dec 13, 2014

From @rjbs

* Chad Granum <exodist7@​gmail.com> [2014-12-12T13​:54​:13]

On that note someone mentioned to me that all it takes is someone with a
commit bit to be willing to act as release manager for a special release of
older versions to make it happen. I do not have a commit bit, but if I were
willing to act as a release manager for a special maint release of 5.8-5.16
would that be workable? Note I am just asking at this point, not sure I
would be able to commit the time to it yet.

We can put the a patch in the repository on a maint-5.8 branch, perhaps, but
we're not going to cut a new release of 5.8. Even the fairly recent hash
security issues did not trigger a new release of 5.8.

--
rjbs

@p5pRT

This comment has been minimized.

Copy link
Collaborator Author

@p5pRT p5pRT commented Feb 6, 2015

From editor.buzzfeed@yahoo.com

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,
Lissa Coffey ( Online )

@p5pRT

This comment has been minimized.

Copy link
Collaborator Author

@p5pRT p5pRT commented Feb 6, 2015

From [Unknown Contact. See original ticket]

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,
Lissa Coffey (Online)

@p5pRT

This comment has been minimized.

Copy link
Collaborator Author

@p5pRT p5pRT commented Apr 8, 2015

From arisadam74@gmail.com

I think the issue is not so much Perl_save_scalar incrementing the ref count of the scalar , 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().

Thanks !
Kalegley
<a href="http​://www.acalculator.com"> Website </a>

@p5pRT

This comment has been minimized.

Copy link
Collaborator Author

@p5pRT p5pRT commented May 3, 2015

From johnashley1066@gmail.com

On Wed Apr 08 04​:55​:58 2015, arisadam74@​gmail.com wrote​:

I think the issue is not so much Perl_save_scalar incrementing the ref
count of the scalar , 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().

Thanks !
Kalegley
[http​://www.acalculator.com Website]

@p5pRT

This comment has been minimized.

Copy link
Collaborator Author

@p5pRT p5pRT commented May 3, 2015

From [Unknown Contact. See original ticket]

On Wed Apr 08 04​:55​:58 2015, arisadam74@​gmail.com wrote​:

I think the issue is not so much Perl_save_scalar incrementing the ref
count of the scalar , 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().

Thanks !
Kalegley
[http​://www.acalculator.com Website]

@p5pRT

This comment has been minimized.

Copy link
Collaborator Author

@p5pRT p5pRT commented Jun 2, 2015

From @khwilliamson

Thanks for submitting this ticket

The issue should be resolved with the release today of Perl v5.22. If you find that the problem persists, feel free to reopen this ticket

--
Karl Williamson for the Perl 5 porters team

@p5pRT

This comment has been minimized.

Copy link
Collaborator Author

@p5pRT p5pRT commented Jun 2, 2015

@khwilliamson - Status changed from 'pending release' to 'resolved'

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Projects
None yet
1 participant
You can’t perform that action at this time.