Perl / perl5

🐪 The Perl programming language
https://dev.perl.org/perl5/
Other
1.9k stars 542 forks source link

local $SIG{FOO} = sub {...}; sets signal handler to SIG_DFL #9556

Closed p5pRT closed 15 years ago

p5pRT commented 15 years ago

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

Searchable as RT60360$

p5pRT commented 15 years ago

From @ig3

Please see attached report from perlbug.

p5pRT commented 15 years ago

From @ig3

To​: perlbug@​perl.org Subject​: local $SIG{FOO} = sub {} sets signal handler to SIG_DFL Reply-To​: Ian.Goodacre@​xtra.co.nz Message-Id​: \5\.8\.8\_8374\_1225923929@​alula\.local

This is a bug report for perl from Ian.Goodacre@​xtra.co.nz\, generated with the help of perlbug 1.35 running under perl v5.8.8.

----------------------------------------------------------------- When setting a localized signal handler\, the system signal handler is set to SIG_DFL then back to perl's signal handler. This briefly exposes SIG_DFL when switching between alternate non-default signal handlers.

The following test program demonstrates the problem​:

#!/opt/perl/bin/perl use strict; use warnings;

print "set handler 1\n"; $SIG{ALRM} = sub { print "handler 1\n"; }; print "set handler 2\n"; $SIG{ALRM} = sub { print "handler 2\n"; }; print "set handler 3 (local)\n"; {   local $SIG{ALRM} = sub { print "handler 3\n"; }; }

And the following output from strace shows SIG_DFL being set briefly when the local $SIG{ALRM} is set.

write(1\, "set handler 1\n"\, 14set handler 1 ) = 14 rt_sigprocmask(SIG_BLOCK\, [ALRM]\, []\, 8) = 0 rt_sigaction(SIGALRM\, {0x80a3330\, []\, 0}\, {SIG_DFL}\, 8) = 0 rt_sigprocmask(SIG_SETMASK\, []\, NULL\, 8) = 0 write(1\, "set handler 2\n"\, 14set handler 2 ) = 14 rt_sigprocmask(SIG_BLOCK\, [ALRM]\, []\, 8) = 0 rt_sigaction(SIGALRM\, {0x80a3330\, []\, 0}\, {0x80a3330\, []\, 0}\, 8) = 0 rt_sigprocmask(SIG_SETMASK\, []\, NULL\, 8) = 0 write(1\, "set handler 3 (local)\n"\, 22set handler 3 (local) ) = 22 rt_sigprocmask(SIG_BLOCK\, [ALRM]\, []\, 8) = 0 rt_sigaction(SIGALRM\, {SIG_DFL}\, {0x80a3330\, []\, 0}\, 8) = 0 rt_sigprocmask(SIG_SETMASK\, []\, NULL\, 8) = 0 rt_sigprocmask(SIG_BLOCK\, [ALRM]\, []\, 8) = 0 rt_sigaction(SIGALRM\, {0x80a3330\, []\, 0}\, {SIG_DFL}\, 8) = 0 rt_sigprocmask(SIG_SETMASK\, []\, NULL\, 8) = 0 rt_sigprocmask(SIG_BLOCK\, [ALRM]\, []\, 8) = 0 rt_sigaction(SIGALRM\, {0x80a3330\, []\, 0}\, {0x80a3330\, []\, 0}\, 8) = 0 rt_sigprocmask(SIG_SETMASK\, []\, NULL\, 8) = 0 exit_group(0) = ?

----------------------------------------------------------------- --- Flags​:   category=core   severity=medium --- This perlbug was built using Perl v5.8.8 in the Red Hat build system. It is being executed now by Perl v5.8.8 - Thu Nov 8 06​:48​:20 EST 2007.

Site configuration information for perl v5.8.8​:

Configured by Red Hat\, Inc. at Thu Nov 8 06​:48​:20 EST 2007.

Summary of my perl5 (revision 5 version 8 subversion 8) configuration​:   Platform​:   osname=linux\, osvers=2.6.9-42.0.3.elsmp\, archname=i386-linux-thread-multi   uname='linux builder6.centos.org 2.6.9-42.0.3.elsmp #1 smp fri oct 6 06​:28​:26 cdt 2006 i686 athlon i386 gnulinux '   config_args='-des -Doptimize=-O2 -g -pipe -Wall -Wp\,-D_FORTIFY_SOURCE=2 -fexceptions -fstack-protector --param=ssp-buffer-size=4 -m32 -march=i386 -mtune=generic -fasynchronous-unwind-tables -Dversion=5.8.8 -Dmyhostname=localhost -Dperladmin=root@​localhost -Dcc=gcc -Dcf_by=Red Hat\, Inc. -Dinstallprefix=/usr -Dprefix=/usr -Darchname=i386-linux -Dvendorprefix=/usr -Dsiteprefix=/usr -Duseshrplib -Dusethreads -Duseithreads -Duselargefiles -Dd_dosuid -Dd_semctl_semun -Di_db -Ui_ndbm -Di_gdbm -Di_shadow -Di_syslog -Dman3ext=3pm -Duseperlio -Dinstallusrbinperl=n -Ubincompat5005 -Uversiononly -Dpager=/usr/bin/less -isr -Dd_gethostent_r_proto -Ud_endhostent_r_proto -Ud_sethostent_r_proto -Ud_endprotoent_r_proto -Ud_setprotoent_r_proto -Ud_endservent_r_proto -Ud_setservent_r_proto -Dinc_version_list=5.8.7 5.8.6 5.8.5 -Dscriptdir=/usr/bin'   hint=recommended\, useposix=true\, d_sigaction=define   usethreads=define use5005threads=undef useithreads=define usemultiplicity=define   useperlio=define d_sfio=undef uselargefiles=define usesocks=undef   use64bitint=undef use64bitall=undef uselongdouble=undef   usemymalloc=n\, bincompat5005=undef   Compiler​:   cc='gcc'\, ccflags ='-D_REENTRANT -D_GNU_SOURCE -fno-strict-aliasing -pipe -Wdeclaration-after-statement -I/usr/local/include -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64 -I/usr/include/gdbm'\,   optimize='-O2 -g -pipe -Wall -Wp\,-D_FORTIFY_SOURCE=2 -fexceptions -fstack-protector --param=ssp-buffer-size=4 -m32 -march=i386 -mtune=generic -fasynchronous-unwind-tables'\,   cppflags='-D_REENTRANT -D_GNU_SOURCE -fno-strict-aliasing -pipe -Wdeclaration-after-statement -I/usr/local/include -I/usr/include/gdbm'   ccversion=''\, gccversion='4.1.1 20070105 (Red Hat 4.1.1-52)'\, gccosandvers=''   intsize=4\, longsize=4\, ptrsize=4\, doublesize=8\, byteorder=1234   d_longlong=define\, longlongsize=8\, d_longdbl=define\, longdblsize=12   ivtype='long'\, ivsize=4\, nvtype='double'\, nvsize=8\, Off_t='off_t'\, lseeksize=8   alignbytes=4\, prototype=define   Linker and Libraries​:   ld='gcc'\, ldflags =' -L/usr/local/lib'   libpth=/usr/local/lib /lib /usr/lib   libs=-lresolv -lnsl -lgdbm -ldb -ldl -lm -lcrypt -lutil -lpthread -lc   perllibs=-lresolv -lnsl -ldl -lm -lcrypt -lutil -lpthread -lc   libc=/lib/libc-2.5.so\, so=so\, useshrplib=true\, libperl=libperl.so   gnulibc_version='2.5'   Dynamic Linking​:   dlsrc=dl_dlopen.xs\, dlext=so\, d_dlsymun=undef\, ccdlflags='-Wl\,-E -Wl\,-rpath\,/usr/lib/perl5/5.8.8/i386-linux-thread-multi/CORE'   cccdlflags='-fPIC'\, lddlflags='-shared -O2 -g -pipe -Wall -Wp\,-D_FORTIFY_SOURCE=2 -fexceptions -fstack-protector --param=ssp-buffer-size=4 -m32 -march=i386 -mtune=generic -fasynchronous-unwind-tables -L/usr/local/lib'

Locally applied patches​:  

--- @​INC for perl v5.8.8​:   /usr/lib/perl5/site_perl/5.8.8/i386-linux-thread-multi   /usr/lib/perl5/site_perl/5.8.7/i386-linux-thread-multi   /usr/lib/perl5/site_perl/5.8.6/i386-linux-thread-multi   /usr/lib/perl5/site_perl/5.8.5/i386-linux-thread-multi   /usr/lib/perl5/site_perl/5.8.8   /usr/lib/perl5/site_perl/5.8.7   /usr/lib/perl5/site_perl/5.8.6   /usr/lib/perl5/site_perl/5.8.5   /usr/lib/perl5/site_perl   /usr/lib/perl5/vendor_perl/5.8.8/i386-linux-thread-multi   /usr/lib/perl5/vendor_perl/5.8.7/i386-linux-thread-multi   /usr/lib/perl5/vendor_perl/5.8.6/i386-linux-thread-multi   /usr/lib/perl5/vendor_perl/5.8.5/i386-linux-thread-multi   /usr/lib/perl5/vendor_perl/5.8.8   /usr/lib/perl5/vendor_perl/5.8.7   /usr/lib/perl5/vendor_perl/5.8.6   /usr/lib/perl5/vendor_perl/5.8.5   /usr/lib/perl5/vendor_perl   /usr/lib/perl5/5.8.8/i386-linux-thread-multi   /usr/lib/perl5/5.8.8   .

--- Environment for perl v5.8.8​:   HOME=/home/ian   LANG=en_US.UTF-8   LANGUAGE (unset)   LD_LIBRARY_PATH (unset)   LOGDIR (unset)   PATH=/usr/kerberos/bin​:/usr/local/bin​:/usr/bin​:/bin​:/usr/X11R6/bin​:/home/ian/bin​:/sbin   PERL_BADLANG (unset)   SHELL=/bin/bash

p5pRT commented 15 years ago

From @chipdude

patch sent to p5p

p5pRT commented 15 years ago

From @chipdude

On Wed\, Nov 05\, 2008 at 02​:46​:58PM -0800\, ian.goodacre@​xtra.co.nz (via RT) wrote​:

When setting a localized signal handler\, the system signal handler is set to SIG_DFL then back to perl's signal handler. This briefly exposes SIG_DFL when switching between alternate non-default signal handlers.

The below patch fixes this bug. In the process it also partially fixes a magic bug of long standing (probably since 5.000).

When localizing a magical scalar for assignment\, Perl has until now done an extra store of undef before storing the actual desired value. To illustrate\, given this source code​:

  { package Foo;   sub TIEHASH { bless {}\, 'Foo' }   sub FETCH { print "Fetch $_[1]\n"; $_[0]->{$_[1]} }   sub STORE { print "Store $_[1] = $_[2]\n"; $_[0]->{$_[1]} = $_[2] }   }

  tie %x\, 'Foo';   $x{plugh} = "dick";   { local $x{plugh} = "jane" }

Released perls and blead do this​:

  $ perl foo
  Store plugh = dick   Fetch plugh   Store plugh =   Store plugh = jane   Store plugh = dick

Whereas blead with the below patch does this​:

  $ ./perl foo   Store plugh = dick   Fetch plugh   Store plugh = jane   Store plugh = dick

The below patch fixes this problem for hash elements and slices. However\, due to the OPf_SPECIAL flag not meaning the same thing in the AELEM opcodes\, let alone all the opcodes that can extract scalar values\, this fix is not entirely applicable to those cases; that will require deeper hacking. At least this patch fixes hashes\, which are the most common case.

PS​: Hi\, guys. Been a while. How you been?

embed.fnc | 6 +++--- embed.h | 6 +++--- mg.c | 20 +++++++++++++------- op.h | 3 +++ perlapi.c | 4 +++- pp.c | 2 +- pp_hot.c | 2 +- proto.h | 6 +++--- scope.c | 18 +++++++++--------- 9 files changed\, 39 insertions(+)\, 28 deletions(-)

Inline Patch ```diff diff --git a/embed.fnc b/embed.fnc index c3835b3..67fd70f 100644 --- a/embed.fnc +++ b/embed.fnc @@ -518,7 +518,7 @@ Apd |void |sortsv_flags |NULLOK SV** array|size_t num_elts|NN SVCOMPARE_t cmp|U3 Apd |int |mg_clear |NN SV* sv Apd |int |mg_copy |NN SV *sv|NN SV *nsv|NULLOK const char *key \ |I32 klen -pd |void |mg_localize |NN SV* sv|NN SV* nsv +pd |void |mg_localize |NN SV* sv|NN SV* nsv|I32 empty ApdR |MAGIC* |mg_find |NULLOK const SV* sv|int type Apd |int |mg_free |NN SV* sv Apd |int |mg_get |NN SV* sv @@ -790,7 +790,7 @@ Ap |void |save_generic_pvref|NN char** str Ap |void |save_shared_pvref|NN char** str Ap |void |save_gp |NN GV* gv|I32 empty Ap |HV* |save_hash |NN GV* gv -Ap |void |save_helem |NN HV *hv|NN SV *key|NN SV **sptr +Ap |void |save_helem |NN HV *hv|NN SV *key|NN SV **sptr|I32 empty Ap |void |save_hptr |NN HV** hptr Ap |void |save_I16 |NN I16* intp Ap |void |save_I32 |NN I32* intp @@ -1550,7 +1550,7 @@ s |SV* |pm_description |NN const PMOP *pm #endif #if defined(PERL_IN_SCOPE_C) || defined(PERL_DECL_PROT) -s |SV* |save_scalar_at |NN SV **sptr +s |SV* |save_scalar_at |NN SV **sptr|I32 empty #endif #if defined(PERL_IN_GV_C) || defined(PERL_IN_SV_C) || defined(PERL_IN_PAD_C) || defined(PERL_DECL_PROT) diff --git a/embed.h b/embed.h index ace2037..b7b3dbd 100644 --- a/embed.h +++ b/embed.h @@ -2795,7 +2795,7 @@ #define mg_clear(a) Perl_mg_clear(aTHX_ a) #define mg_copy(a,b,c,d) Perl_mg_copy(aTHX_ a,b,c,d) #ifdef PERL_CORE -#define mg_localize(a,b) Perl_mg_localize(aTHX_ a,b) +#define mg_localize(a,b,c) Perl_mg_localize(aTHX_ a,b,c) #endif #define mg_find(a,b) Perl_mg_find(aTHX_ a,b) #define mg_free(a) Perl_mg_free(aTHX_ a) @@ -3086,7 +3086,7 @@ #define save_shared_pvref(a) Perl_save_shared_pvref(aTHX_ a) #define save_gp(a,b) Perl_save_gp(aTHX_ a,b) #define save_hash(a) Perl_save_hash(aTHX_ a) -#define save_helem(a,b,c) Perl_save_helem(aTHX_ a,b,c) +#define save_helem(a,b,c,d) Perl_save_helem(aTHX_ a,b,c,d) #define save_hptr(a) Perl_save_hptr(aTHX_ a) #define save_I16(a) Perl_save_I16(aTHX_ a) #define save_I32(a) Perl_save_I32(aTHX_ a) @@ -3790,7 +3790,7 @@ #endif #if defined(PERL_IN_SCOPE_C) || defined(PERL_DECL_PROT) #ifdef PERL_CORE -#define save_scalar_at(a) S_save_scalar_at(aTHX_ a) +#define save_scalar_at(a,b) S_save_scalar_at(aTHX_ a,b) #endif #endif #if defined(PERL_IN_GV_C) || defined(PERL_IN_SV_C) || defined(PERL_IN_PAD_C) || defined(PERL_DECL_PROT) diff --git a/mg.c b/mg.c index 28eb9d2..22f8c99 100644 --- a/mg.c +++ b/mg.c @@ -463,15 +463,19 @@ Perl_mg_copy(pTHX_ SV *sv, SV *nsv, const char *key, I32 klen) /* =for apidoc mg_localize -Copy some of the magic from an existing SV to new localized version of -that SV. Container magic (eg %ENV, $1, tie) gets copied, value magic -doesn't (eg taint, pos). +Copy some of the magic from an existing SV to new localized version of that +SV. Container magic (eg %ENV, $1, tie) gets copied, value magic doesn't (eg +taint, pos). + +If empty is false then no set magic will be called on the new (empty) SV. +This typically means that assignment will soon follow (e.g. 'local $x = $y'), +and that will handle the magic. =cut */ void -Perl_mg_localize(pTHX_ SV *sv, SV *nsv) +Perl_mg_localize(pTHX_ SV *sv, SV *nsv, I32 empty) { dVAR; MAGIC *mg; @@ -495,9 +499,11 @@ Perl_mg_localize(pTHX_ SV *sv, SV *nsv) if (SvTYPE(nsv) >= SVt_PVMG && SvMAGIC(nsv)) { SvFLAGS(nsv) |= SvMAGICAL(sv); - PL_localizing = 1; - SvSETMAGIC(nsv); - PL_localizing = 0; + if (empty) { + PL_localizing = 1; + SvSETMAGIC(nsv); + PL_localizing = 0; + } } } diff --git a/op.h b/op.h index c1120f7..6729f6e 100644 --- a/op.h +++ b/op.h @@ -137,6 +137,9 @@ Deprecated. Use C instead. /* On OP_SMARTMATCH, an implicit smartmatch */ /* On OP_ANONHASH and OP_ANONLIST, create a reference to the new anon hash or array */ + /* On OP_HELEM and OP_HSLICE, localization will be followed + by assignment, so do not wipe the target if it is special + (e.g. a glob or a magic SV) */ /* old names; don't use in new code, but don't break them, either */ #define OPf_LIST OPf_WANT_LIST diff --git a/perlapi.c b/perlapi.c index d15afec..19b1b3e 100644 --- a/perlapi.c +++ b/perlapi.c @@ -18,7 +18,9 @@ * * Up to the threshold of the door there mounted a flight of twenty-seven * broad stairs, hewn by some unknown art of the same black stone. This - * was the only entrance to the tower. + * was the only entrance to the tower; ... + * + * [p.577 of _The Lord of the Rings_, III/x: "The Voice of Saruman"] * */ diff --git a/pp.c b/pp.c index 7fe6c8a..304e42d 100644 --- a/pp.c +++ b/pp.c @@ -4185,7 +4185,7 @@ PP(pp_hslice) save_gp(MUTABLE_GV(*svp), !(PL_op->op_flags & OPf_SPECIAL)); else { if (preeminent) - save_helem(hv, keysv, svp); + save_helem(hv, keysv, svp, !(PL_op->op_flags & OPf_SPECIAL)); else { STRLEN keylen; const char * const key = SvPV_const(keysv, keylen); diff --git a/pp_hot.c b/pp_hot.c index eeedc5b..0f6243f 100644 --- a/pp_hot.c +++ b/pp_hot.c @@ -1828,7 +1828,7 @@ PP(pp_helem) SAVEDELETE(hv, savepvn(key,keylen), SvUTF8(keysv) ? -(I32)keylen : (I32)keylen); } else - save_helem(hv, keysv, svp); + save_helem(hv, keysv, svp, !(PL_op->op_flags & OPf_SPECIAL)); } } else if (PL_op->op_private & OPpDEREF) diff --git a/proto.h b/proto.h index c466fba..f1f8dce 100644 --- a/proto.h +++ b/proto.h @@ -1848,7 +1848,7 @@ PERL_CALLCONV int Perl_mg_copy(pTHX_ SV *sv, SV *nsv, const char *key, I32 klen) #define PERL_ARGS_ASSERT_MG_COPY \ assert(sv); assert(nsv) -PERL_CALLCONV void Perl_mg_localize(pTHX_ SV* sv, SV* nsv) +PERL_CALLCONV void Perl_mg_localize(pTHX_ SV* sv, SV* nsv, I32 empty) __attribute__nonnull__(pTHX_1) __attribute__nonnull__(pTHX_2); #define PERL_ARGS_ASSERT_MG_LOCALIZE \ @@ -2830,7 +2830,7 @@ PERL_CALLCONV HV* Perl_save_hash(pTHX_ GV* gv) #define PERL_ARGS_ASSERT_SAVE_HASH \ assert(gv) -PERL_CALLCONV void Perl_save_helem(pTHX_ HV *hv, SV *key, SV **sptr) +PERL_CALLCONV void Perl_save_helem(pTHX_ HV *hv, SV *key, SV **sptr, I32 empty) __attribute__nonnull__(pTHX_1) __attribute__nonnull__(pTHX_2) __attribute__nonnull__(pTHX_3); @@ -5498,7 +5498,7 @@ STATIC SV* S_pm_description(pTHX_ const PMOP *pm) #endif #if defined(PERL_IN_SCOPE_C) || defined(PERL_DECL_PROT) -STATIC SV* S_save_scalar_at(pTHX_ SV **sptr) +STATIC SV* S_save_scalar_at(pTHX_ SV **sptr, I32 empty) __attribute__nonnull__(pTHX_1); #define PERL_ARGS_ASSERT_SAVE_SCALAR_AT \ assert(sptr) diff --git a/scope.c b/scope.c index d9dcd4a..83e8a7b 100644 --- a/scope.c +++ b/scope.c @@ -164,7 +164,7 @@ Perl_free_tmps(pTHX) } STATIC SV * -S_save_scalar_at(pTHX_ SV **sptr) +S_save_scalar_at(pTHX_ SV **sptr, I32 empty) { dVAR; SV * const osv = *sptr; @@ -179,7 +179,7 @@ S_save_scalar_at(pTHX_ SV **sptr) (SVp_IOK|SVp_NOK|SVp_POK)) >> PRIVSHIFT; PL_tainted = oldtainted; } - mg_localize(osv, sv); + mg_localize(osv, sv, empty); } return sv; } @@ -199,7 +199,7 @@ Perl_save_scalar(pTHX_ GV *gv) SSPUSHPTR(SvREFCNT_inc_simple(gv)); SSPUSHPTR(SvREFCNT_inc(*sptr)); SSPUSHINT(SAVEt_SV); - return save_scalar_at(sptr); + return save_scalar_at(sptr, TRUE); /* XXX - FIXME - see #60360 */ } /* Like save_sptr(), but also SvREFCNT_dec()s the new value. Can be used to @@ -321,7 +321,7 @@ Perl_save_ary(pTHX_ GV *gv) GvAV(gv) = NULL; av = GvAVn(gv); if (SvMAGIC(oav)) - mg_localize(MUTABLE_SV(oav), MUTABLE_SV(av)); + mg_localize(MUTABLE_SV(oav), MUTABLE_SV(av), TRUE); return av; } @@ -341,7 +341,7 @@ Perl_save_hash(pTHX_ GV *gv) GvHV(gv) = NULL; hv = GvHVn(gv); if (SvMAGIC(ohv)) - mg_localize(MUTABLE_SV(ohv), MUTABLE_SV(hv)); + mg_localize(MUTABLE_SV(ohv), MUTABLE_SV(hv), TRUE); return hv; } @@ -611,7 +611,7 @@ Perl_save_aelem(pTHX_ AV *av, I32 idx, SV **sptr) /* if it gets reified later, the restore will have the wrong refcnt */ if (!AvREAL(av) && AvREIFY(av)) SvREFCNT_inc_void(*sptr); - save_scalar_at(sptr); + save_scalar_at(sptr, TRUE); /* XXX - FIXME - see #60360 */ sv = *sptr; /* If we're localizing a tied array element, this new sv * won't actually be stored in the array - so it won't get @@ -622,7 +622,7 @@ Perl_save_aelem(pTHX_ AV *av, I32 idx, SV **sptr) } void -Perl_save_helem(pTHX_ HV *hv, SV *key, SV **sptr) +Perl_save_helem(pTHX_ HV *hv, SV *key, SV **sptr, I32 empty) { dVAR; SV *sv; @@ -635,7 +635,7 @@ Perl_save_helem(pTHX_ HV *hv, SV *key, SV **sptr) SSPUSHPTR(newSVsv(key)); SSPUSHPTR(SvREFCNT_inc(*sptr)); SSPUSHINT(SAVEt_HELEM); - save_scalar_at(sptr); + save_scalar_at(sptr, empty); sv = *sptr; /* If we're localizing a tied hash element, this new sv * won't actually be stored in the hash - so it won't get @@ -657,7 +657,7 @@ Perl_save_svref(pTHX_ SV **sptr) SSPUSHPTR(sptr); SSPUSHPTR(SvREFCNT_inc(*sptr)); SSPUSHINT(SAVEt_SVREF); - return save_scalar_at(sptr); + return save_scalar_at(sptr, TRUE); /* XXX - FIXME - see #60360 */ } void -- ```

Chip Salzenberg \chip@​pobox\.com

p5pRT commented 15 years ago

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

p5pRT commented 15 years ago

From @rgs

2008/11/11 Chip Salzenberg \chip@​pobox\.com​:

On Wed\, Nov 05\, 2008 at 02​:46​:58PM -0800\, ian.goodacre@​xtra.co.nz (via RT) wrote​:

When setting a localized signal handler\, the system signal handler is set to SIG_DFL then back to perl's signal handler. This briefly exposes SIG_DFL when switching between alternate non-default signal handlers.

The below patch fixes this bug. In the process it also partially fixes a magic bug of long standing (probably since 5.000).

When localizing a magical scalar for assignment\, Perl has until now done an extra store of undef before storing the actual desired value. To illustrate\, given this source code​:

\{ package Foo;
  sub TIEHASH \{ bless \{\}\, 'Foo' \}
  sub FETCH \{ print "Fetch $\_\[1\]\\n"; $\_\[0\]\->\{$\_\[1\]\} \}
  sub STORE \{ print "Store $\_\[1\] = $\_\[2\]\\n"; $\_\[0\]\->\{$\_\[1\]\} = $\_\[2\] \}
\}

tie %x\, 'Foo';
$x\{plugh\} = "dick";
\{ local $x\{plugh\} = "jane" \}

Released perls and blead do this​:

$ perl foo Store plugh = dick Fetch plugh Store plugh = Store plugh = jane Store plugh = dick

Whereas blead with the below patch does this​:

$ ./perl foo Store plugh = dick Fetch plugh Store plugh = jane Store plugh = dick

The below patch fixes this problem for hash elements and slices. However\, due to the OPf_SPECIAL flag not meaning the same thing in the AELEM opcodes\, let alone all the opcodes that can extract scalar values\, this fix is not entirely applicable to those cases; that will require deeper hacking. At least this patch fixes hashes\, which are the most common case.

Great fix! Thanks\, applied as #34819\, except the perlapi.c part\, which strips off a Tolkien quote. I'll fix that separately.

PS​: Hi\, guys. Been a while. How you been?

Hi! busy.

p5pRT commented 15 years ago

@rgs - Status changed from 'open' to 'resolved'

p5pRT commented 15 years ago

From @nwc10

On Mon\, Nov 10\, 2008 at 04​:00​:40PM -0800\, Chip Salzenberg wrote​:

+pd |void |mg_localize |NN SV* sv|NN SV* nsv|I32 empty

+Ap |void |save_helem |NN HV *hv|NN SV *key|NN SV **sptr|I32 empty

You've been doing this longer than me\, so I suspect that there is a good reason I can't spot - why do you choose to use I32 as your flag value\, rather than something else?

Nicholas Clark

p5pRT commented 15 years ago

From @doughera88

On Mon\, 10 Nov 2008\, Chip Salzenberg wrote​:

On Wed\, Nov 05\, 2008 at 02​:46​:58PM -0800\, ian.goodacre@​xtra.co.nz (via RT) wrote​:

When setting a localized signal handler\, the system signal handler is set to SIG_DFL then back to perl's signal handler. This briefly exposes SIG_DFL when switching between alternate non-default signal handlers.

The below patch fixes this bug. In the process it also partially fixes a magic bug of long standing (probably since 5.000).

PS​: Hi\, guys. Been a while. How you been?

[. . . magic patch . . . ]

Hey -- great to hear from you again! . . . and diving right into the deep end as well!

--   Andy Dougherty doughera@​lafayette.edu

p5pRT commented 15 years ago

From @mhx

On 2008-11-10\, at 16​:00​:40 -0800\, Chip Salzenberg wrote​:

On Wed\, Nov 05\, 2008 at 02​:46​:58PM -0800\, ian.goodacre@​xtra.co.nz (via RT) wrote​:

When setting a localized signal handler\, the system signal handler is set to SIG_DFL then back to perl's signal handler. This briefly exposes SIG_DFL when switching between alternate non-default signal handlers.

The below patch fixes this bug. In the process it also partially fixes a magic bug of long standing (probably since 5.000).

When localizing a magical scalar for assignment\, Perl has until now done an extra store of undef before storing the actual desired value. To illustrate\, given this source code​:

 \{ package Foo;
   sub TIEHASH \{ bless \{\}\, 'Foo' \}
   sub FETCH \{ print "Fetch $\_\[1\]\\n"; $\_\[0\]\->\{$\_\[1\]\} \}
   sub STORE \{ print "Store $\_\[1\] = $\_\[2\]\\n"; $\_\[0\]\->\{$\_\[1\]\} = $\_\[2\] \}
 \}

 tie %x\, 'Foo';
 $x\{plugh\} = "dick";
 \{ local $x\{plugh\} = "jane" \}

Released perls and blead do this​:

$ perl foo
Store plugh = dick Fetch plugh Store plugh = Store plugh = jane Store plugh = dick

Whereas blead with the below patch does this​:

$ ./perl foo Store plugh = dick Fetch plugh Store plugh = jane Store plugh = dick

The below patch fixes this problem for hash elements and slices. However\, due to the OPf_SPECIAL flag not meaning the same thing in the AELEM opcodes\, let alone all the opcodes that can extract scalar values\, this fix is not entirely applicable to those cases; that will require deeper hacking. At least this patch fixes hashes\, which are the most common case.

Nice patch\, indeed.

My only concern is that it changes the signature of a public API call (i.e. save_helem). I'd feel a bit more comfortable if it would rather move the functionality to save_helem_flags() and implement a compatible save_helem() in terms of it. Also\, I'd rather use a bitfield as the new parameter to allow for further additions and use a "speaking" name for the flag like MG_LOCALIZE_EMPTY_ASSIGNMENT (I haven't thought very much about that name) instead of just TRUE or FALSE.

Marcus

PS​: Hi\, guys. Been a while. How you been?

embed.fnc | 6 +++--- embed.h | 6 +++--- mg.c | 20 +++++++++++++------- op.h | 3 +++ perlapi.c | 4 +++- pp.c | 2 +- pp_hot.c | 2 +- proto.h | 6 +++--- scope.c | 18 +++++++++--------- 9 files changed\, 39 insertions(+)\, 28 deletions(-)

diff --git a/embed.fnc b/embed.fnc index c3835b3..67fd70f 100644 --- a/embed.fnc +++ b/embed.fnc @​@​ -518\,7 +518\,7 @​@​ Apd |void |sortsv_flags |NULLOK SV** array|size_t num_elts|NN SVCOMPARE_t cmp|U3 Apd |int |mg_clear |NN SV* sv Apd |int |mg_copy |NN SV *sv|NN SV *nsv|NULLOK const char *key \ |I32 klen -pd |void |mg_localize |NN SV* sv|NN SV* nsv +pd |void |mg_localize |NN SV* sv|NN SV* nsv|I32 empty ApdR |MAGIC* |mg_find |NULLOK const SV* sv|int type Apd |int |mg_free |NN SV* sv Apd |int |mg_get |NN SV* sv @​@​ -790\,7 +790\,7 @​@​ Ap |void |save_generic_pvref|NN char** str Ap |void |save_shared_pvref|NN char** str Ap |void |save_gp |NN GV* gv|I32 empty Ap |HV* |save_hash |NN GV* gv -Ap |void |save_helem |NN HV *hv|NN SV *key|NN SV **sptr +Ap |void |save_helem |NN HV *hv|NN SV *key|NN SV **sptr|I32 empty Ap |void |save_hptr |NN HV** hptr Ap |void |save_I16 |NN I16* intp Ap |void |save_I32 |NN I32* intp @​@​ -1550\,7 +1550\,7 @​@​ s |SV* |pm_description |NN const PMOP *pm #endif

#if defined(PERL_IN_SCOPE_C) || defined(PERL_DECL_PROT) -s |SV* |save_scalar_at |NN SV **sptr +s |SV* |save_scalar_at |NN SV **sptr|I32 empty #endif

#if defined(PERL_IN_GV_C) || defined(PERL_IN_SV_C) || defined(PERL_IN_PAD_C) || defined(PERL_DECL_PROT) diff --git a/embed.h b/embed.h index ace2037..b7b3dbd 100644 --- a/embed.h +++ b/embed.h @​@​ -2795\,7 +2795\,7 @​@​ #define mg_clear(a) Perl_mg_clear(aTHX_ a) #define mg_copy(a\,b\,c\,d) Perl_mg_copy(aTHX_ a\,b\,c\,d) #ifdef PERL_CORE -#define mg_localize(a\,b) Perl_mg_localize(aTHX_ a\,b) +#define mg_localize(a\,b\,c) Perl_mg_localize(aTHX_ a\,b\,c) #endif #define mg_find(a\,b) Perl_mg_find(aTHX_ a\,b) #define mg_free(a) Perl_mg_free(aTHX_ a) @​@​ -3086\,7 +3086\,7 @​@​ #define save_shared_pvref(a) Perl_save_shared_pvref(aTHX_ a) #define save_gp(a\,b) Perl_save_gp(aTHX_ a\,b) #define save_hash(a) Perl_save_hash(aTHX_ a) -#define save_helem(a\,b\,c) Perl_save_helem(aTHX_ a\,b\,c) +#define save_helem(a\,b\,c\,d) Perl_save_helem(aTHX_ a\,b\,c\,d) #define save_hptr(a) Perl_save_hptr(aTHX_ a) #define save_I16(a) Perl_save_I16(aTHX_ a) #define save_I32(a) Perl_save_I32(aTHX_ a) @​@​ -3790\,7 +3790\,7 @​@​ #endif #if defined(PERL_IN_SCOPE_C) || defined(PERL_DECL_PROT) #ifdef PERL_CORE -#define save_scalar_at(a) S_save_scalar_at(aTHX_ a) +#define save_scalar_at(a\,b) S_save_scalar_at(aTHX_ a\,b) #endif #endif #if defined(PERL_IN_GV_C) || defined(PERL_IN_SV_C) || defined(PERL_IN_PAD_C) || defined(PERL_DECL_PROT) diff --git a/mg.c b/mg.c index 28eb9d2..22f8c99 100644 --- a/mg.c +++ b/mg.c @​@​ -463\,15 +463\,19 @​@​ Perl_mg_copy(pTHX_ SV *sv\, SV *nsv\, const char *key\, I32 klen) /* =for apidoc mg_localize

-Copy some of the magic from an existing SV to new localized version of -that SV. Container magic (eg %ENV\, $1\, tie) gets copied\, value magic -doesn't (eg taint\, pos). +Copy some of the magic from an existing SV to new localized version of that +SV. Container magic (eg %ENV\, $1\, tie) gets copied\, value magic doesn't (eg +taint\, pos). + +If empty is false then no set magic will be called on the new (empty) SV. +This typically means that assignment will soon follow (e.g. 'local $x = $y')\, +and that will handle the magic.

=cut */

void -Perl_mg_localize(pTHX_ SV *sv\, SV *nsv) +Perl_mg_localize(pTHX_ SV *sv\, SV *nsv\, I32 empty) { dVAR; MAGIC *mg; @​@​ -495\,9 +499\,11 @​@​ Perl_mg_localize(pTHX_ SV *sv\, SV *nsv)

 if \(SvTYPE\(nsv\) >= SVt\_PVMG && SvMAGIC\(nsv\)\) \{
 SvFLAGS\(nsv\) |= SvMAGICAL\(sv\);

- PL_localizing = 1; - SvSETMAGIC(nsv); - PL_localizing = 0; + if (empty) { + PL_localizing = 1; + SvSETMAGIC(nsv); + PL_localizing = 0; + } }
}

diff --git a/op.h b/op.h index c1120f7..6729f6e 100644 --- a/op.h +++ b/op.h @​@​ -137\,6 +137\,9 @​@​ Deprecated. Use C\<GIMME_V> instead. /* On OP_SMARTMATCH\, an implicit smartmatch */ /* On OP_ANONHASH and OP_ANONLIST\, create a reference to the new anon hash or array */ + /* On OP_HELEM and OP_HSLICE\, localization will be followed + by assignment\, so do not wipe the target if it is special + (e.g. a glob or a magic SV) */

/* old names; don't use in new code\, but don't break them\, either */ #define OPf_LIST OPf_WANT_LIST diff --git a/perlapi.c b/perlapi.c index d15afec..19b1b3e 100644 --- a/perlapi.c +++ b/perlapi.c @​@​ -18\,7 +18\,9 @​@​ * * Up to the threshold of the door there mounted a flight of twenty-seven * broad stairs\, hewn by some unknown art of the same black stone. This - * was the only entrance to the tower. + * was the only entrance to the tower; ... + * + * [p.577 of _The Lord of the Rings_\, III/x​: "The Voice of Saruman"] * */

diff --git a/pp.c b/pp.c index 7fe6c8a..304e42d 100644 --- a/pp.c +++ b/pp.c @​@​ -4185\,7 +4185\,7 @​@​ PP(pp_hslice) save_gp(MUTABLE_GV(*svp)\, !(PL_op->op_flags & OPf_SPECIAL)); else { if (preeminent) - save_helem(hv\, keysv\, svp); + save_helem(hv\, keysv\, svp\, !(PL_op->op_flags & OPf_SPECIAL)); else { STRLEN keylen; const char * const key = SvPV_const(keysv\, keylen); diff --git a/pp_hot.c b/pp_hot.c index eeedc5b..0f6243f 100644 --- a/pp_hot.c +++ b/pp_hot.c @​@​ -1828\,7 +1828\,7 @​@​ PP(pp_helem) SAVEDELETE(hv\, savepvn(key\,keylen)\, SvUTF8(keysv) ? -(I32)keylen : (I32)keylen); } else - save_helem(hv\, keysv\, svp); + save_helem(hv\, keysv\, svp\, !(PL_op->op_flags & OPf_SPECIAL)); } } else if (PL_op->op_private & OPpDEREF) diff --git a/proto.h b/proto.h index c466fba..f1f8dce 100644 --- a/proto.h +++ b/proto.h @​@​ -1848\,7 +1848\,7 @​@​ PERL_CALLCONV int Perl_mg_copy(pTHX_ SV *sv\, SV *nsv\, const char *key\, I32 klen) #define PERL_ARGS_ASSERT_MG_COPY \ assert(sv); assert(nsv)

-PERL_CALLCONV void Perl_mg_localize(pTHX_ SV* sv\, SV* nsv) +PERL_CALLCONV void Perl_mg_localize(pTHX_ SV* sv\, SV* nsv\, I32 empty) __attribute__nonnull__(pTHX_1) __attribute__nonnull__(pTHX_2); #define PERL_ARGS_ASSERT_MG_LOCALIZE \ @​@​ -2830\,7 +2830\,7 @​@​ PERL_CALLCONV HV* Perl_save_hash(pTHX_ GV* gv) #define PERL_ARGS_ASSERT_SAVE_HASH \ assert(gv)

-PERL_CALLCONV void Perl_save_helem(pTHX_ HV *hv\, SV *key\, SV **sptr) +PERL_CALLCONV void Perl_save_helem(pTHX_ HV *hv\, SV *key\, SV **sptr\, I32 empty) __attribute__nonnull__(pTHX_1) __attribute__nonnull__(pTHX_2) __attribute__nonnull__(pTHX_3); @​@​ -5498\,7 +5498\,7 @​@​ STATIC SV* S_pm_description(pTHX_ const PMOP *pm) #endif

#if defined(PERL_IN_SCOPE_C) || defined(PERL_DECL_PROT) -STATIC SV* S_save_scalar_at(pTHX_ SV **sptr) +STATIC SV* S_save_scalar_at(pTHX_ SV **sptr\, I32 empty) __attribute__nonnull__(pTHX_1); #define PERL_ARGS_ASSERT_SAVE_SCALAR_AT \ assert(sptr) diff --git a/scope.c b/scope.c index d9dcd4a..83e8a7b 100644 --- a/scope.c +++ b/scope.c @​@​ -164\,7 +164\,7 @​@​ Perl_free_tmps(pTHX) }

STATIC SV * -S_save_scalar_at(pTHX_ SV **sptr) +S_save_scalar_at(pTHX_ SV **sptr\, I32 empty) { dVAR; SV * const osv = *sptr; @​@​ -179\,7 +179\,7 @​@​ S_save_scalar_at(pTHX_ SV **sptr) (SVp_IOK|SVp_NOK|SVp_POK)) >> PRIVSHIFT; PL_tainted = oldtainted; } - mg_localize(osv\, sv); + mg_localize(osv\, sv\, empty); } return sv; } @​@​ -199\,7 +199\,7 @​@​ Perl_save_scalar(pTHX_ GV *gv) SSPUSHPTR(SvREFCNT_inc_simple(gv)); SSPUSHPTR(SvREFCNT_inc(*sptr)); SSPUSHINT(SAVEt_SV); - return save_scalar_at(sptr); + return save_scalar_at(sptr\, TRUE); /* XXX - FIXME - see #60360 */ }

/* Like save_sptr()\, but also SvREFCNT_dec()s the new value. Can be used to @​@​ -321\,7 +321\,7 @​@​ Perl_save_ary(pTHX_ GV *gv) GvAV(gv) = NULL; av = GvAVn(gv); if (SvMAGIC(oav)) - mg_localize(MUTABLE_SV(oav)\, MUTABLE_SV(av)); + mg_localize(MUTABLE_SV(oav)\, MUTABLE_SV(av)\, TRUE); return av; }

@​@​ -341\,7 +341\,7 @​@​ Perl_save_hash(pTHX_ GV *gv) GvHV(gv) = NULL; hv = GvHVn(gv); if (SvMAGIC(ohv)) - mg_localize(MUTABLE_SV(ohv)\, MUTABLE_SV(hv)); + mg_localize(MUTABLE_SV(ohv)\, MUTABLE_SV(hv)\, TRUE); return hv; }

@​@​ -611\,7 +611\,7 @​@​ Perl_save_aelem(pTHX_ AV *av\, I32 idx\, SV **sptr) /* if it gets reified later\, the restore will have the wrong refcnt */ if (!AvREAL(av) && AvREIFY(av)) SvREFCNT_inc_void(*sptr); - save_scalar_at(sptr); + save_scalar_at(sptr\, TRUE); /* XXX - FIXME - see #60360 */ sv = *sptr; /* If we're localizing a tied array element\, this new sv * won't actually be stored in the array - so it won't get @​@​ -622\,7 +622\,7 @​@​ Perl_save_aelem(pTHX_ AV *av\, I32 idx\, SV **sptr) }

void -Perl_save_helem(pTHX_ HV *hv\, SV *key\, SV **sptr) +Perl_save_helem(pTHX_ HV *hv\, SV *key\, SV **sptr\, I32 empty) { dVAR; SV *sv; @​@​ -635\,7 +635\,7 @​@​ Perl_save_helem(pTHX_ HV *hv\, SV *key\, SV **sptr) SSPUSHPTR(newSVsv(key)); SSPUSHPTR(SvREFCNT_inc(*sptr)); SSPUSHINT(SAVEt_HELEM); - save_scalar_at(sptr); + save_scalar_at(sptr\, empty); sv = *sptr; /* If we're localizing a tied hash element\, this new sv * won't actually be stored in the hash - so it won't get @​@​ -657\,7 +657\,7 @​@​ Perl_save_svref(pTHX_ SV **sptr) SSPUSHPTR(sptr); SSPUSHPTR(SvREFCNT_inc(*sptr)); SSPUSHINT(SAVEt_SVREF); - return save_scalar_at(sptr); + return save_scalar_at(sptr\, TRUE); /* XXX - FIXME - see #60360 */ }

void

-- Chip Salzenberg \chip@&#8203;pobox\.com

-- Torque is cheap.

p5pRT commented 15 years ago

From @chipdude

On Wed\, Nov 12\, 2008 at 11​:02​:00AM +0000\, Nicholas Clark wrote​:

On Mon\, Nov 10\, 2008 at 04​:00​:40PM -0800\, Chip Salzenberg wrote​:

+pd |void |mg_localize |NN SV* sv|NN SV* nsv|I32 empty +Ap |void |save_helem |NN HV *hv|NN SV *key|NN SV **sptr|I32 empty

You've been doing this longer than me\, so I suspect that there is a good reason I can't spot - why do you choose to use I32 as your flag value\, rather than something else?

I have been doing this longer\, but some of the newer remodeling is strange to me. \

At first\, I was >\< _this_ close to using 'bool'. But then I noticed that save_gp() uses I32 for its empty flag\, so I thought I'd change that to bool also\, for consistency; but then I realized that could break any existinc allers to save_gp() and I imagined that would be bad. So I went with I32 all around.

On the other hand\, that was silly. If bincompat were an issue\, I would not be allowed to change the prototypes of mg_localize() and save_helem() either. So I could send a patch to change all the empty flags to bool\, and all should be fine\, right?

But then\, on the gripping hand​: I see supposedly-internal functions like save_gp() and mg_localize() and save_helem() named in files in ext/Devel/PPPort/parts\, and I wonder\, what's up with that? What is safe to change these days without breaking binary compatibility for XS modules? -- Chip Salzenberg \chip@&#8203;pobox\.com

p5pRT commented 15 years ago

From @chipdude

On Wed\, Nov 12\, 2008 at 07​:51​:39AM -0500\, Andy Dougherty wrote​:

On Mon\, 10 Nov 2008\, Chip Salzenberg wrote​:

PS​: Hi\, guys. Been a while. How you been?

[. . . magic patch . . . ]

Hey -- great to hear from you again! . . . and diving right into the deep end as well!

It's lovely to be back. Perl is\, apparently\, my calling. I just wish it wouldn't drunk-call me.... -- Chip Salzenberg \chip@&#8203;pobox\.com

p5pRT commented 15 years ago

From @chipdude

On Wed\, Nov 12\, 2008 at 06​:00​:52PM +0100\, Marcus Holland-Moritz wrote​:

My only concern is that it changes the signature of a public API call (i.e. save_helem). I'd feel a bit more comfortable if it would rather move the functionality to save_helem_flags() and implement a compatible save_helem() in terms of it.

That's a very reasonable idea for maintaining compatibility of public API calls. I'd like to understand the current policy on what's "public" before I go further\, though. What is the definition of "public"\, and are we (not?) interested in binary compat between 5.10 and 5.12? -- Chip Salzenberg \chip@&#8203;pobox\.com

p5pRT commented 15 years ago

From @obra

On Wed\, Nov 12\, 2008 at 11​:52​:47AM -0800\, Chip Salzenberg wrote​:

On Wed\, Nov 12\, 2008 at 07​:51​:39AM -0500\, Andy Dougherty wrote​:

PS​: Hi\, guys. Been a while. How you been?

It's lovely to be back. Perl is\, apparently\, my calling. I just wish it wouldn't drunk-call me....

Shhh. Perl's not legal for another 5 weeks or so. (1.000 was 12-18-1987)

p5pRT commented 15 years ago

From @mhx

Hello Chip\,

On 2008-11-12\, at 11​:55​:24 -0800\, Chip Salzenberg wrote​:

On Wed\, Nov 12\, 2008 at 06​:00​:52PM +0100\, Marcus Holland-Moritz wrote​:

My only concern is that it changes the signature of a public API call (i.e. save_helem). I'd feel a bit more comfortable if it would rather move the functionality to save_helem_flags() and implement a compatible save_helem() in terms of it.

That's a very reasonable idea for maintaining compatibility of public API calls. I'd like to understand the current policy on what's "public" before I go further\, though.

See embed.fnc​:

  : flags are single letters with following meanings​:   : A member of public API   [...]   Ap |void |save_helem |NN HV *hv|NN SV *key|NN SV **sptr   ^

What is the definition of "public"\, and are we (not?) interested in binary compat between 5.10 and 5.12?

It's not *binary* compat I'm concerned about\, it's *source* compat\, which is even worse. Binary compat issues can be "fixed" by recompiling against the new interface.

Marcus

-- The moon is a planet just like the Earth\, only it is even deader.

p5pRT commented 15 years ago

From @chipdude

On Wed\, Nov 12\, 2008 at 09​:28​:53PM +0100\, Marcus Holland-Moritz wrote​:

See embed.fnc​: : flags are single letters with following meanings​: : A member of public API [...] Ap |void |save_helem |NN HV *hv|NN SV *key|NN SV **sptr ^

Ah\, there it is indeed.

What is the definition of "public"\, and are we (not?) interested in binary compat between 5.10 and 5.12?

It's not *binary* compat I'm concerned about\, it's *source* compat [...]

Indeed. But I also am trying to understand the bincompat status. -- Chip Salzenberg \chip@&#8203;pobox\.com

p5pRT commented 15 years ago

From @nwc10

On Wed\, Nov 12\, 2008 at 01​:21​:19PM -0800\, Chip Salzenberg wrote​:

On Wed\, Nov 12\, 2008 at 09​:28​:53PM +0100\, Marcus Holland-Moritz wrote​:

It's not *binary* compat I'm concerned about\, it's *source* compat [...]

Indeed. But I also am trying to understand the bincompat status.

Jarkko gave up trying to bincompat between major versions some point before 5.8.0 was released. 5.10.0 isn't bincompat with 5.8.x\, and 5.12.0 won't be with 5.10.x

I've not noticed any complaints about it not being possible\, and not having to worry about it certainly frees us up to make some useful space optimisations.

The only thing I do remember is a comment by someone senior at the BBC about investigating trying to get 5.8.something to be bincompat with 5.6.what-they-were-running\, and I thought​:

1​: I don't think that you're going to manage this 2​: If this was important to the BBC\, how come it didn't make it known at the   time that Jarkko dropped it? 3​: How do we convince organisations such as the BBC to contribute more back to   Perl development?

[specifically on point 3\, they seem to realise that they can budget staff time to fix things in retrospect\, but it's all going to be local fixes and none of it feeds back outwards to the benefit of anyone else.

Note\, I'm not suggesting that "due to the unique way it is funded" the BBC should use its Tithe on Television to give us kickbacks. I am suggesting that it's in the mutual self interest of multiple Perl-using organisations to act in a co-operative fashion to benefit their own internal infrastructures. For all I know\, there is a secret cabal of Perl using companies that have a private bug-fixed miniCPAN. But probably not. We can hope. Although it seems that there isn't a secret Python cabal either​:

http​://mail.python.org/pipermail/python-dev/2008-October/083190.html

]

Nicholas Clark

p5pRT commented 15 years ago

From @mhx

On 2008-11-12\, at 13​:21​:19 -0800\, Chip Salzenberg wrote​:

On Wed\, Nov 12\, 2008 at 09​:28​:53PM +0100\, Marcus Holland-Moritz wrote​:

See embed.fnc​: : flags are single letters with following meanings​: : A member of public API [...] Ap |void |save_helem |NN HV *hv|NN SV *key|NN SV **sptr ^

Ah\, there it is indeed.

What is the definition of "public"\, and are we (not?) interested in binary compat between 5.10 and 5.12?

It's not *binary* compat I'm concerned about\, it's *source* compat [...]

Indeed. But I also am trying to understand the bincompat status.

Ok\, no problem! :)

Binary compat is only important within a release series\, i.e. 5.8.x or 5.10.x. There's no need to retain binary compatibility between 5.x and 5.y.

Marcus

-- Denver\, n.​:   A smallish city located just below the `O' in Colorado.

p5pRT commented 15 years ago

From @chipdude

On Wed\, Nov 12\, 2008 at 09​:44​:41PM +0000\, Nicholas Clark wrote​:

Jarkko gave up trying to bincompat between major versions some point before 5.8.0 was released. 5.10.0 isn't bincompat with 5.8.x\, and 5.12.0 won't be with 5.10.x

I think that works for me. Good to know the policy in any case.

I think there's a PPPort bug\, though​: I tried to change save_helem() from a function to a macro wrapper around save_helem_flags()\, which entailed changing the embed.fnc line for save_helem from "Ap" to "Amp"\, and PPPort just failed. Fell right over during the build\, and didn't even print a message. So my next patch will have save_helem() as a function wrapper\, rather than a macro wrapper.

As for the BBC asking for 5.6->5.8 bincompat​:

3​: How do we convince organisations such as the BBC to contribute more back to Perl development?

Linux (the obvious example of big $$ in free software) has no real competitors in its field​: GPL'd[1] enterprise-quality kernels\, with robust and sane management\, that could compete with Windows. IBM et al know if they don't help develop Linux they'll be helpless against Microsoft. So they do.

If people with money perceive that Perl development is a good investment\, they'll invest. For that\, they have to be getting something from us that they can't get (for equal or lower cost) elsewhere. We do have some of the tragedy of the commons going on. And to some extent\, businesses don't understand what we could bring to the table. But in most cases they believe that their business will not get an adequate return on investment.

Although it seems that there isn't a secret Python cabal either​: http​://mail.python.org/pipermail/python-dev/2008-October/083190.html

That's comforting. >​:)

[1] A non-GPL'd free kernel could be coopted by Microsoft\, so IBM et al are   not interested in investing in e.g. the BSDs. -- Chip Salzenberg \chip@&#8203;pobox\.com

p5pRT commented 15 years ago

From @chipdude

On Wed\, Nov 12\, 2008 at 02​:57​:43PM -0500\, Jesse wrote​:

On Wed\, Nov 12\, 2008 at 11​:52​:47AM -0800\, Chip Salzenberg wrote​:

On Wed\, Nov 12\, 2008 at 07​:51​:39AM -0500\, Andy Dougherty wrote​:

PS​: Hi\, guys. Been a while. How you been?

It's lovely to be back. Perl is\, apparently\, my calling. I just wish it wouldn't drunk-call me....

Shhh. Perl's not legal for another 5 weeks or so. (1.000 was 12-18-1987)

Sounds like an excuse for a party. -- Chip Salzenberg \chip@&#8203;pobox\.com

p5pRT commented 15 years ago

From @chipdude

On Wed\, Nov 12\, 2008 at 02​:31​:35PM -0800\, Chip Salzenberg wrote​:

I think there's a PPPort bug ... False alarm on that; it was a bug in my patch\, since fixed.

Here is an update to my previous patch\, taking into account Marcus's observations. Since the previous patch was already applied in p4\, I'm providing a delta from that. Improvements​:

  1. Source compatibility of the public API is restored.

  2. The new boolean parameter to mg_localize() is now\, in fact\, a 'bool'.

  3. A flags argument is passed through several save-ish functions; the only   current flag is the new SAVEf_SETMAGIC\, but more can be added. I'm only   slightly uncomfortable that the normal behavior requires a nonzero flag\,   but flags that say "don't do X" always rub me the wrong way.

Share & Enjoy!

Inline Patch ```diff diff --git a/embed.fnc b/embed.fnc index 67fd70f..7d0f681 100644 --- a/embed.fnc +++ b/embed.fnc @@ -518,7 +518,7 @@ Apd |void |sortsv_flags |NULLOK SV** array|size_t num_elts|NN SVCOMPARE_t cmp|U3 Apd |int |mg_clear |NN SV* sv Apd |int |mg_copy |NN SV *sv|NN SV *nsv|NULLOK const char *key \ |I32 klen -pd |void |mg_localize |NN SV* sv|NN SV* nsv|I32 empty +pd |void |mg_localize |NN SV* sv|NN SV* nsv|bool setmagic ApdR |MAGIC* |mg_find |NULLOK const SV* sv|int type Apd |int |mg_free |NN SV* sv Apd |int |mg_get |NN SV* sv @@ -790,7 +790,8 @@ Ap |void |save_generic_pvref|NN char** str Ap |void |save_shared_pvref|NN char** str Ap |void |save_gp |NN GV* gv|I32 empty Ap |HV* |save_hash |NN GV* gv -Ap |void |save_helem |NN HV *hv|NN SV *key|NN SV **sptr|I32 empty +Amp |void |save_helem |NN HV *hv|NN SV *key|NN SV **sptr +Ap |void |save_helem_flags|NN HV *hv|NN SV *key|NN SV **sptr|const U32 flags Ap |void |save_hptr |NN HV** hptr Ap |void |save_I16 |NN I16* intp Ap |void |save_I32 |NN I32* intp @@ -1550,7 +1551,7 @@ s |SV* |pm_description |NN const PMOP *pm #endif #if defined(PERL_IN_SCOPE_C) || defined(PERL_DECL_PROT) -s |SV* |save_scalar_at |NN SV **sptr|I32 empty +s |SV* |save_scalar_at |NN SV **sptr|const U32 flags #endif #if defined(PERL_IN_GV_C) || defined(PERL_IN_SV_C) || defined(PERL_IN_PAD_C) || defined(PERL_DECL_PROT) diff --git a/embed.h b/embed.h index b7b3dbd..d246290 100644 --- a/embed.h +++ b/embed.h @@ -770,7 +770,7 @@ #define save_shared_pvref Perl_save_shared_pvref #define save_gp Perl_save_gp #define save_hash Perl_save_hash -#define save_helem Perl_save_helem +#define save_helem_flags Perl_save_helem_flags #define save_hptr Perl_save_hptr #define save_I16 Perl_save_I16 #define save_I32 Perl_save_I32 @@ -3086,7 +3086,7 @@ #define save_shared_pvref(a) Perl_save_shared_pvref(aTHX_ a) #define save_gp(a,b) Perl_save_gp(aTHX_ a,b) #define save_hash(a) Perl_save_hash(aTHX_ a) -#define save_helem(a,b,c,d) Perl_save_helem(aTHX_ a,b,c,d) +#define save_helem_flags(a,b,c,d) Perl_save_helem_flags(aTHX_ a,b,c,d) #define save_hptr(a) Perl_save_hptr(aTHX_ a) #define save_I16(a) Perl_save_I16(aTHX_ a) #define save_I32(a) Perl_save_I32(aTHX_ a) diff --git a/global.sym b/global.sym index 5e18194..90f9102 100644 --- a/global.sym +++ b/global.sym @@ -450,7 +450,7 @@ Perl_save_generic_pvref Perl_save_shared_pvref Perl_save_gp Perl_save_hash -Perl_save_helem +Perl_save_helem_flags Perl_save_hptr Perl_save_I16 Perl_save_I32 diff --git a/mg.c b/mg.c index 22f8c99..a9cffbf 100644 --- a/mg.c +++ b/mg.c @@ -467,7 +467,7 @@ Copy some of the magic from an existing SV to new localized version of that SV. Container magic (eg %ENV, $1, tie) gets copied, value magic doesn't (eg taint, pos). -If empty is false then no set magic will be called on the new (empty) SV. +If setmagic is false then no set magic will be called on the new (empty) SV. This typically means that assignment will soon follow (e.g. 'local $x = $y'), and that will handle the magic. @@ -475,7 +475,7 @@ and that will handle the magic. */ void -Perl_mg_localize(pTHX_ SV *sv, SV *nsv, I32 empty) +Perl_mg_localize(pTHX_ SV *sv, SV *nsv, bool setmagic) { dVAR; MAGIC *mg; @@ -499,7 +499,7 @@ Perl_mg_localize(pTHX_ SV *sv, SV *nsv, I32 empty) if (SvTYPE(nsv) >= SVt_PVMG && SvMAGIC(nsv)) { SvFLAGS(nsv) |= SvMAGICAL(sv); - if (empty) { + if (setmagic) { PL_localizing = 1; SvSETMAGIC(nsv); PL_localizing = 0; diff --git a/pp.c b/pp.c index 304e42d..739a457 100644 --- a/pp.c +++ b/pp.c @@ -4185,7 +4185,8 @@ PP(pp_hslice) save_gp(MUTABLE_GV(*svp), !(PL_op->op_flags & OPf_SPECIAL)); else { if (preeminent) - save_helem(hv, keysv, svp, !(PL_op->op_flags & OPf_SPECIAL)); + save_helem_flags(hv, keysv, svp, + (PL_op->op_flags & OPf_SPECIAL) ? 0 : SAVEf_SETMAGIC); else { STRLEN keylen; const char * const key = SvPV_const(keysv, keylen); diff --git a/pp_hot.c b/pp_hot.c index 0f6243f..9615c46 100644 --- a/pp_hot.c +++ b/pp_hot.c @@ -1828,7 +1828,8 @@ PP(pp_helem) SAVEDELETE(hv, savepvn(key,keylen), SvUTF8(keysv) ? -(I32)keylen : (I32)keylen); } else - save_helem(hv, keysv, svp, !(PL_op->op_flags & OPf_SPECIAL)); + save_helem_flags(hv, keysv, svp, + (PL_op->op_flags & OPf_SPECIAL) ? 0 : SAVEf_SETMAGIC); } } else if (PL_op->op_private & OPpDEREF) diff --git a/proto.h b/proto.h index f1f8dce..c8e7f6f 100644 --- a/proto.h +++ b/proto.h @@ -1848,7 +1848,7 @@ PERL_CALLCONV int Perl_mg_copy(pTHX_ SV *sv, SV *nsv, const char *key, I32 klen) #define PERL_ARGS_ASSERT_MG_COPY \ assert(sv); assert(nsv) -PERL_CALLCONV void Perl_mg_localize(pTHX_ SV* sv, SV* nsv, I32 empty) +PERL_CALLCONV void Perl_mg_localize(pTHX_ SV* sv, SV* nsv, bool setmagic) __attribute__nonnull__(pTHX_1) __attribute__nonnull__(pTHX_2); #define PERL_ARGS_ASSERT_MG_LOCALIZE \ @@ -2830,13 +2830,20 @@ PERL_CALLCONV HV* Perl_save_hash(pTHX_ GV* gv) #define PERL_ARGS_ASSERT_SAVE_HASH \ assert(gv) -PERL_CALLCONV void Perl_save_helem(pTHX_ HV *hv, SV *key, SV **sptr, I32 empty) +/* PERL_CALLCONV void Perl_save_helem(pTHX_ HV *hv, SV *key, SV **sptr) __attribute__nonnull__(pTHX_1) __attribute__nonnull__(pTHX_2) - __attribute__nonnull__(pTHX_3); + __attribute__nonnull__(pTHX_3); */ #define PERL_ARGS_ASSERT_SAVE_HELEM \ assert(hv); assert(key); assert(sptr) +PERL_CALLCONV void Perl_save_helem_flags(pTHX_ HV *hv, SV *key, SV **sptr, const U32 flags) + __attribute__nonnull__(pTHX_1) + __attribute__nonnull__(pTHX_2) + __attribute__nonnull__(pTHX_3); +#define PERL_ARGS_ASSERT_SAVE_HELEM_FLAGS \ + assert(hv); assert(key); assert(sptr) + PERL_CALLCONV void Perl_save_hptr(pTHX_ HV** hptr) __attribute__nonnull__(pTHX_1); #define PERL_ARGS_ASSERT_SAVE_HPTR \ @@ -5498,7 +5505,7 @@ STATIC SV* S_pm_description(pTHX_ const PMOP *pm) #endif #if defined(PERL_IN_SCOPE_C) || defined(PERL_DECL_PROT) -STATIC SV* S_save_scalar_at(pTHX_ SV **sptr, I32 empty) +STATIC SV* S_save_scalar_at(pTHX_ SV **sptr, const U32 flags) __attribute__nonnull__(pTHX_1); #define PERL_ARGS_ASSERT_SAVE_SCALAR_AT \ assert(sptr) diff --git a/scope.c b/scope.c index 83e8a7b..20cf6fc 100644 --- a/scope.c +++ b/scope.c @@ -164,7 +164,7 @@ Perl_free_tmps(pTHX) } STATIC SV * -S_save_scalar_at(pTHX_ SV **sptr, I32 empty) +S_save_scalar_at(pTHX_ SV **sptr, const U32 flags) { dVAR; SV * const osv = *sptr; @@ -179,7 +179,7 @@ S_save_scalar_at(pTHX_ SV **sptr, I32 empty) (SVp_IOK|SVp_NOK|SVp_POK)) >> PRIVSHIFT; PL_tainted = oldtainted; } - mg_localize(osv, sv, empty); + mg_localize(osv, sv, (flags & SAVEf_SETMAGIC) != 0); } return sv; } @@ -199,7 +199,7 @@ Perl_save_scalar(pTHX_ GV *gv) SSPUSHPTR(SvREFCNT_inc_simple(gv)); SSPUSHPTR(SvREFCNT_inc(*sptr)); SSPUSHINT(SAVEt_SV); - return save_scalar_at(sptr, TRUE); /* XXX - FIXME - see #60360 */ + return save_scalar_at(sptr, SAVEf_SETMAGIC); /* XXX - FIXME - see #60360 */ } /* Like save_sptr(), but also SvREFCNT_dec()s the new value. Can be used to @@ -611,7 +611,7 @@ Perl_save_aelem(pTHX_ AV *av, I32 idx, SV **sptr) /* if it gets reified later, the restore will have the wrong refcnt */ if (!AvREAL(av) && AvREIFY(av)) SvREFCNT_inc_void(*sptr); - save_scalar_at(sptr, TRUE); /* XXX - FIXME - see #60360 */ + save_scalar_at(sptr, SAVEf_SETMAGIC); /* XXX - FIXME - see #60360 */ sv = *sptr; /* If we're localizing a tied array element, this new sv * won't actually be stored in the array - so it won't get @@ -622,7 +622,7 @@ Perl_save_aelem(pTHX_ AV *av, I32 idx, SV **sptr) } void -Perl_save_helem(pTHX_ HV *hv, SV *key, SV **sptr, I32 empty) +Perl_save_helem_flags(pTHX_ HV *hv, SV *key, SV **sptr, const U32 flags) { dVAR; SV *sv; @@ -635,7 +635,7 @@ Perl_save_helem(pTHX_ HV *hv, SV *key, SV **sptr, I32 empty) SSPUSHPTR(newSVsv(key)); SSPUSHPTR(SvREFCNT_inc(*sptr)); SSPUSHINT(SAVEt_HELEM); - save_scalar_at(sptr, empty); + save_scalar_at(sptr, flags); sv = *sptr; /* If we're localizing a tied hash element, this new sv * won't actually be stored in the hash - so it won't get @@ -657,7 +657,7 @@ Perl_save_svref(pTHX_ SV **sptr) SSPUSHPTR(sptr); SSPUSHPTR(SvREFCNT_inc(*sptr)); SSPUSHINT(SAVEt_SVREF); - return save_scalar_at(sptr, TRUE); /* XXX - FIXME - see #60360 */ + return save_scalar_at(sptr, SAVEf_SETMAGIC); /* XXX - FIXME - see #60360 */ } void diff --git a/scope.h b/scope.h index 25ccbf6..c1fa4f9 100644 --- a/scope.h +++ b/scope.h @@ -55,6 +55,10 @@ #define SAVEt_STACK_CXPOS 44 #define SAVEt_PARSER 45 +#define SAVEf_SETMAGIC 1 + +#define save_helem(hv,key,sptr) save_helem_flags(hv,key,sptr,SAVEf_SETMAGIC) + #ifndef SCOPE_SAVES_SIGNAL_MASK #define SCOPE_SAVES_SIGNAL_MASK 0 #endif -- Chip Salzenberg ```
p5pRT commented 15 years ago

From @mhx

On 2008-11-12\, at 14​:31​:35 -0800\, Chip Salzenberg wrote​:

On Wed\, Nov 12\, 2008 at 09​:44​:41PM +0000\, Nicholas Clark wrote​:

Jarkko gave up trying to bincompat between major versions some point before 5.8.0 was released. 5.10.0 isn't bincompat with 5.8.x\, and 5.12.0 won't be with 5.10.x

I think that works for me. Good to know the policy in any case.

I think there's a PPPort bug\, though​: I tried to change save_helem() from a function to a macro wrapper around save_helem_flags()\, which entailed changing the embed.fnc line for save_helem from "Ap" to "Amp"\, and PPPort just failed. Fell right over during the build\, and didn't even print a message.

Mmmh. Precise description of the problem... ;)

Do you have a patch with the changes you made that caused it to "fall over"? Did you only change the master embed.fnc\, or did you patch D​::PPP's parts/embed.fnc as well (which is not a good idea\, btw)?

I see no reason for this not to work (in any case)\, so if it indeed doesn't work\, yes\, you've found a bug and I'll be happy to fix it.

However​:

1) I can't think of a way to make D​::PPP fail by such a change   to embed.fnc.

2) It works fine for me with the changes below and of course a   make regen afterwards.

3) I don't think "Amp" is a valid combination of flags\, as   "p" means "function has a Perl_ prefix"\, which doesn't   make much sense for a macro. There's "Apmb" in embed.fnc\,   but the "b" appears to be what makes the "p" valid here.   In any case\, D​::PPP won't (or rather shouldn't) care.

So my next patch will have save_helem() as a function wrapper\, rather than a macro wrapper.

No need to! I think using a macro wrapper is just fine. If you've uncovered a D​::PPP bug\, I'll try to fix it asap. Don't work around my bugs\, please. :)

Marcus

Inline Patch ```diff diff -ruN perl-current-orig/embed.fnc perl-current/embed.fnc --- perl-current-orig/embed.fnc 2008-11-12 11:38:53.000000000 +0100 +++ perl-current/embed.fnc 2008-11-13 05:58:36.000000000 +0100 @@ -790,7 +790,8 @@ Ap |void |save_shared_pvref|NN char** str Ap |void |save_gp |NN GV* gv|I32 empty Ap |HV* |save_hash |NN GV* gv -Ap |void |save_helem |NN HV *hv|NN SV *key|NN SV **sptr|I32 empty +Ap |void |save_helem_flags |NN HV *hv|NN SV *key|NN SV **sptr|I32 empty +Amp |void |save_helem |NN HV *hv|NN SV *key|NN SV **sptr Ap |void |save_hptr |NN HV** hptr Ap |void |save_I16 |NN I16* intp Ap |void |save_I32 |NN I32* intp --- perl-current-orig/pp.c 2008-11-12 11:38:53.000000000 +0100 +++ perl-current/pp.c 2008-11-13 05:59:49.000000000 +0100 @@ -4185,7 +4185,7 @@ save_gp(MUTABLE_GV(*svp), !(PL_op->op_flags & OPf_SPECIAL)); else { if (preeminent) - save_helem(hv, keysv, svp, !(PL_op->op_flags & OPf_SPECIAL)); + save_helem_flags(hv, keysv, svp, !(PL_op->op_flags & OPf_SPECIAL)); else { STRLEN keylen; const char * const key = SvPV_const(keysv, keylen); diff -ruN perl-current-orig/pp_hot.c perl-current/pp_hot.c --- perl-current-orig/pp_hot.c 2008-11-12 11:38:53.000000000 +0100 +++ perl-current/pp_hot.c 2008-11-13 05:59:42.000000000 +0100 @@ -1828,7 +1828,7 @@ SAVEDELETE(hv, savepvn(key,keylen), SvUTF8(keysv) ? -(I32)keylen : (I32)keylen); } else - save_helem(hv, keysv, svp, !(PL_op->op_flags & OPf_SPECIAL)); + save_helem_flags(hv, keysv, svp, !(PL_op->op_flags & OPf_SPECIAL)); } } else if (PL_op->op_private & OPpDEREF) --- perl-current-orig/scope.c 2008-11-12 11:38:53.000000000 +0100 +++ perl-current/scope.c 2008-11-13 05:59:03.000000000 +0100 @@ -622,12 +622,12 @@ } void -Perl_save_helem(pTHX_ HV *hv, SV *key, SV **sptr, I32 empty) +Perl_save_helem_flags(pTHX_ HV *hv, SV *key, SV **sptr, I32 empty) { dVAR; SV *sv; - PERL_ARGS_ASSERT_SAVE_HELEM; + PERL_ARGS_ASSERT_SAVE_HELEM_FLAGS; SvGETMAGIC(*sptr); SSCHECK(4); diff -ruN perl-current-orig/scope.h perl-current/scope.h --- perl-current-orig/scope.h 2008-10-28 19:35:27.000000000 +0100 +++ perl-current/scope.h 2008-11-13 06:00:38.000000000 +0100 @@ -256,6 +256,8 @@ #define SSPTR(off,type) ((type) ((char*)PL_savestack + off)) #define SSPTRt(off,type) ((type*) ((char*)PL_savestack + off)) +#define save_helem(a, b, c) Perl_save_helem_flags(aTHX_ a, b, c, FALSE) + /* * Local variables: * c-indentation-style: bsd ```
p5pRT commented 15 years ago

From @mhx

On 2008-11-12\, at 15​:45​:04 -0800\, Chip Salzenberg wrote​:

On Wed\, Nov 12\, 2008 at 02​:31​:35PM -0800\, Chip Salzenberg wrote​:

I think there's a PPPort bug ... False alarm on that; it was a bug in my patch\, since fixed.

When do I learn to read *all* email first before starting to reply? ;) Sorry\, but this mail somehow didn't make it to my inbox\, but only straight to the p5p folder. No idea why...

Here is an update to my previous patch\, taking into account Marcus's observations. Since the previous patch was already applied in p4\, I'm providing a delta from that. Improvements​:

1. Source compatibility of the public API is restored.

2. The new boolean parameter to mg_localize() is now\, in fact\, a 'bool'.

3. A flags argument is passed through several save-ish functions; the only current flag is the new SAVEf_SETMAGIC\, but more can be added. I'm only slightly uncomfortable that the normal behavior requires a nonzero flag\, but flags that say "don't do X" always rub me the wrong way.

Share & Enjoy!

Great\, thanks! Applied as #34829 with a minor tweak (fixing Perl_save_helem_flags() to use PERL_ARGS_ASSERT_SAVE_HELEM_FLAGS instead of the old PERL_ARGS_ASSERT_SAVE_HELEM).

Marcus

-- You had mail. Paul read it\, so ask him what it said.