From @nwc10

Created by @nwc10

%+ and %- are implemented as tied hashes, using XS code in universal.c

STORE attempts to cope with localisation. For example​:

XS(XS_Tie_Hash_NamedCapture_STORE)
{
  dVAR;
  dXSARGS;
  REGEXP * rx;
  U32 flags;

  if (items != 3)
  croak_xs_usage(cv, "$key, $value, $flags");

  rx = PL_curpm ? PM_GETRE(PL_curpm) : NULL;

  if (!rx || !SvROK(ST(0))) {
  if (!PL_localizing)
  Perl_croak_no_modify(aTHX);
  else
  XSRETURN_UNDEF;
  }

  SP -= items;

  flags = (U32)SvUV(SvRV(MUTABLE_SV(ST(0))));
  CALLREG_NAMED_BUFF_STORE(rx,ST(1), ST(2), flags);
}

However, this doesn't work​:

$ ./perl -Ilib -le 'local $-{pie}; warn "Get here"'
Get here at -e line 1.
Modification of a read-only value attempted.
$ ./perl -Ilib -le 'local $-{pie} = "good"; warn "Get here"'
Modification of a read-only value attempted at -e line 1.
Modification of a read-only value attempted at -e line 1.

Note that the first one gets past the warn statement, then fails in scope
cleanup (trying to call XS_Tie_Hash_NamedCapture_DELETE)

The second one is particularly spectacular, with double error messages.
The stack trace for the second croak is:

(gdb) where
#0 Perl_croak (pat=0x74cd97 "%s") at util.c:1634
#1 0x000000000051253f in Perl_croak_no_modify () at util.c:1653
#2 0x00000000006da5b4 in XS_Tie_Hash_NamedCapture_DELETE (cv=0x9fa010)
at universal.c:1416
#3 0x0000000000564299 in Perl_pp_entersub () at pp_hot.c:2928
#4 0x000000000050acf4 in Perl_runops_debug () at dump.c:2119
#5 0x000000000044f1b9 in Perl_call_sv (sv=0x9fad60, flags=130) at perl.c:2597
#6 0x000000000044ed65 in Perl_call_method (methname=0x758eb5 "DELETE",
flags=2) at perl.c:2523
#7 0x0000000000525bd5 in Perl_magic_methcall (sv=0x9fa640, mg=0xa07080,
meth=0x758eb5 "DELETE", flags=0, argc=0) at mg.c:1703
#8 0x00000000005261c4 in S_magic_methcall1 (sv=0x9fa640, mg=0xa07080,
meth=0x758eb5 "DELETE", flags=0, n=1, val=0x0) at mg.c:1737
#9 0x0000000000526264 in S_magic_methpack (sv=0x9fa640, mg=0xa07080,
meth=0x758eb5 "DELETE") at mg.c:1748
#10 0x0000000000526463 in Perl_magic_clearpack (sv=0x9fa640, mg=0xa07080)
at mg.c:1802
#11 0x000000000051e467 in Perl_mg_clear (sv=0x9fa640) at mg.c:411
#12 0x000000000053911c in S_hv_delete_common (hv=0x9fadf0, keysv=0x0,
key=0xa06ea0 "pie", klen=3, k_flags=0, d_flags=68, hash=0) at hv.c:924
#13 0x000000000053794a in Perl_hv_common (hv=0x9fadf0, keysv=0x0,
key=0xa06ea0 "pie", klen=3, flags=0, action=68, val=0x0, hash=0)
at hv.c:388
#14 0x00000000005374d0 in Perl_hv_common_key_len (hv=0x9fadf0,
key=0xa06ea0 "pie", klen_i32=3, action=68, val=0x0, hash=0) at hv.c:325
#15 0x000000000060b599 in Perl_leave_scope (base=0) at scope.c:945
#16 0x000000000045befa in S_my_exit_jump () at perl.c:4785
#17 0x000000000045bac3 in Perl_my_failure_exit () at perl.c:4770
#18 0x000000000061e77e in Perl_die_unwind (msv=0x9fa628) at pp_ctl.c:1660
#19 0x000000000051244b in Perl_vcroak (pat=0x74cd97 "%s", args=0x7fff488a70b0)
at util.c:1590
#20 0x0000000000512527 in Perl_croak (pat=0x74cd97 "%s") at util.c:1635
#21 0x000000000051253f in Perl_croak_no_modify () at util.c:1653
#22 0x00000000006d9cf4 in XS_Tie_Hash_NamedCapture_STORE (cv=0x9f9fc8)
at universal.c:1394
#23 0x0000000000564299 in Perl_pp_entersub () at pp_hot.c:2928
#24 0x000000000050acf4 in Perl_runops_debug () at dump.c:2119
#25 0x000000000044f1b9 in Perl_call_sv (sv=0x9fa610, flags=134) at perl.c:2597
#26 0x000000000044ed65 in Perl_call_method (methname=0x758e93 "STORE", flags=6)
at perl.c:2523
#27 0x0000000000525bc2 in Perl_magic_methcall (sv=0x9fa5b0, mg=0x9fe1b0,
meth=0x758e93 "STORE", flags=4, argc=0) at mg.c:1700
#28 0x00000000005261c4 in S_magic_methcall1 (sv=0x9fa5b0, mg=0x9fe1b0,
meth=0x758e93 "STORE", flags=4, n=2, val=0x9fa5b0) at mg.c:1737
#29 0x00000000005263fa in Perl_magic_setpack (sv=0x9fa5b0, mg=0x9fe1b0)
at mg.c:1793
#30 0x000000000051ded7 in Perl_mg_set (sv=0x9fa5b0) at mg.c:305
#31 0x00000000005482b3 in Perl_pp_sassign () at pp_hot.c:207
#32 0x000000000050acf4 in Perl_runops_debug () at dump.c:2119
#33 0x000000000044e068 in S_run_body (oldscope=1) at perl.c:2315
#34 0x000000000044d4ab in perl_run (my_perl=0x9e5010) at perl.c:2239
#35 0x0000000000420d0d in main (argc=4, argv=0x7fff488a7f58,
env=0x7fff488a7f80) at perlmain.c:117

Does it even make sense to support localising %+ and %-?

Nicholas Clark

Flags:
    category=core
    severity=low

Site configuration information for perl 5.13.4:

Configured by nick at Wed Sep  1 13:42:39 BST 2010.

Summary of my perl5 (revision 5 version 13 subversion 4) configuration:
  Derived from: 7b1903740d907382fa6f406bd7ab1262921746c8
  Platform:
    osname=linux, osvers=2.6.18.8-xenu, archname=x86_64-linux
    uname='linux eris 2.6.18.8-xenu #1 smp sat oct 3 10:27:42 bst 2009 x86_64 gnulinux '
    config_args='-Dusedevel=y -Dcc=ccache gcc -Dld=gcc -Ubincompat5005 -Uinstallusrbinperl -Dcf_email=nick@ccl4.org -Dperladmin=nick@ccl4.org -Dinc_version_list=  -Dinc_version_list_init=0 -Doptimize=-g -Uusethreads -Uuselongdouble -Uuse64bitall -Uusemymalloc -Duseperlio -Dprefix=~/Sandpit/snap5.9.x-v5.13.4-92-g7b19037 -Uusevendorprefix -Uvendorprefix=~/Sandpit/snap5.9.x-v5.13.4-92-g7b19037 -Dinstallman1dir=none -Dinstallman3dir=none -Uuserelocatableinc -Umad -Accccflags=-DPERL_GLOBAL_STRUCT -de'
    hint=recommended, useposix=true, d_sigaction=define
    useithreads=undef, usemultiplicity=undef
    useperlio=define, d_sfio=undef, uselargefiles=define, usesocks=undef
    use64bitint=define, use64bitall=undef, uselongdouble=undef
    usemymalloc=n, bincompat5005=undef
  Compiler:
    cc='ccache gcc', ccflags ='-DDEBUGGING -fno-strict-aliasing -pipe -fstack-protector -I/usr/local/include -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64',
    optimize='-g',
    cppflags='-DDEBUGGING -fno-strict-aliasing -pipe -fstack-protector -I/usr/local/include'
    ccversion='', gccversion='4.3.2', gccosandvers=''
    intsize=4, longsize=8, ptrsize=8, doublesize=8, byteorder=12345678
    d_longlong=define, longlongsize=8, d_longdbl=define, longdblsize=16
    ivtype='long', ivsize=8, nvtype='double', nvsize=8, Off_t='off_t', lseeksize=8
    alignbytes=8, prototype=define
  Linker and Libraries:
    ld='gcc', ldflags =' -fstack-protector -L/usr/local/lib'
    libpth=/usr/local/lib /lib /usr/lib /lib64 /usr/lib64
    libs=-lnsl -ldb -ldl -lm -lcrypt -lutil -lc
    perllibs=-lnsl -ldl -lm -lcrypt -lutil -lc
    libc=/lib/libc-2.7.so, so=so, useshrplib=false, libperl=libperl.a
    gnulibc_version='2.7'
  Dynamic Linking:
    dlsrc=dl_dlopen.xs, dlext=so, d_dlsymun=undef, ccdlflags='-Wl,-E'
    cccdlflags='-fPIC', lddlflags='-shared -g -L/usr/local/lib -fstack-protector'

Locally applied patches:
    


@INC for perl 5.13.4:
    lib
    /home/nick/Sandpit/snap5.9.x-v5.13.4-92-g7b19037/lib/perl5/site_perl/5.13.4/x86_64-linux
    /home/nick/Sandpit/snap5.9.x-v5.13.4-92-g7b19037/lib/perl5/site_perl/5.13.4
    /home/nick/Sandpit/snap5.9.x-v5.13.4-92-g7b19037/lib/perl5/5.13.4/x86_64-linux
    /home/nick/Sandpit/snap5.9.x-v5.13.4-92-g7b19037/lib/perl5/5.13.4
    .


Environment for perl 5.13.4:
    HOME=/home/nick
    LANG (unset)
    LANGUAGE (unset)
    LD_LIBRARY_PATH (unset)
    LOGDIR (unset)
    PATH=/home/nick/bin:/usr/local/bin:/usr/bin:/bin:/usr/games:/usr/local/sbin:/sbin:/usr/sbin
    PERL_BADLANG (unset)
    SHELL=/bin/bash

From @nwc10

On Wed Sep 01 07​:06​:55 2010, nicholas wrote​:

%+ and %- are implemented as tied hashes, using XS code in universal.c

STORE attempts to cope with localisation. For example​:

XS(XS_Tie_Hash_NamedCapture_STORE)
{
dVAR;
dXSARGS;
REGEXP * rx;
U32 flags;

if \(items \!= 3\)
croak\_xs\_usage\(cv\, "$key\, $value\, $flags"\);

rx = PL\_curpm ? PM\_GETRE\(PL\_curpm\) : NULL;

if \(\!rx || \!SvROK\(ST\(0\)\)\) \{
    if \(\!PL\_localizing\)
        Perl\_croak\_no\_modify\(aTHX\);
    else
        XSRETURN\_UNDEF;
\}

SP \-= items;

flags = \(U32\)SvUV\(SvRV\(MUTABLE\_SV\(ST\(0\)\)\)\);
CALLREG\_NAMED\_BUFF\_STORE\(rx\,ST\(1\)\, ST\(2\)\, flags\);

}

All tests still pass with this change​:

diff --git a/universal.c b/universal.c
index 6593501..8d627c2 100644
--- a/universal.c
+++ b/universal.c
@@ -1388,10 +1388,7 @@ XS(XS_Tie_Hash_NamedCapture_STORE)
     rx = PL_curpm ? PM_GETRE(PL_curpm) : NULL;

     if (!rx || !SvROK(ST(0))) {
-        if (!PL_localizing)
-            Perl_croak_no_modify(aTHX);
-        else
-            XSRETURN_UNDEF;
+        Perl_croak_no_modify(aTHX);
     }

     SP -= items;

It strikes me that the return values from STORE, DELETE and CLEAR are
wrong, and possibly even the stack handling. As the core code croaks for
all 3, this isn't noticed.

Nicholas Clark

@nwc10 - Status changed from 'new' to 'open'

From @avar

On Wed, Sep 1, 2010 at 14​:33, Nicholas Clark via RT
<perlbug-followup@​perl.org> wrote​:

On Wed Sep 01 07​:06​:55 2010, nicholas wrote​:

%+ and %- are implemented as tied hashes, using XS code in universal.c

STORE attempts to cope with localisation. For example​:

XS(XS_Tie_Hash_NamedCapture_STORE)
{
    dVAR;
    dXSARGS;
    REGEXP * rx;
    U32 flags;

    if (items != 3)
      croak_xs_usage(cv, "$key, $value, $flags");

    rx = PL_curpm ? PM_GETRE(PL_curpm) : NULL;

    if (!rx || !SvROK(ST(0))) {
        if (!PL_localizing)
            Perl_croak_no_modify(aTHX);
        else
            XSRETURN_UNDEF;
    }

    SP -= items;

    flags = (U32)SvUV(SvRV(MUTABLE_SV(ST(0))));
    CALLREG_NAMED_BUFF_STORE(rx,ST(1), ST(2), flags);
}

All tests still pass with this change​:

diff --git a/universal.c b/universal.c
index 6593501..8d627c2 100644
--- a/universal.c
+++ b/universal.c
@​@​ -1388,10 +1388,7 @​@​ XS(XS_Tie_Hash_NamedCapture_STORE)
    rx = PL_curpm ? PM_GETRE(PL_curpm) : NULL;

    if (!rx || !SvROK(ST(0))) {
-        if (!PL_localizing)
-            Perl_croak_no_modify(aTHX);
-        else
-            XSRETURN_UNDEF;
+        Perl_croak_no_modify(aTHX);
    }

    SP -= items;

Should this be applied?

Probably yes.

It strikes me that the return values from STORE, DELETE and CLEAR are
wrong, and possibly even the stack handling. As the core code croaks for
all 3, this isn't noticed.

I didn't really know what I was doing back when I wrote that, I was
just trying to make it die like $1="foo" does.

So your way is probably better.

From @cpansprout

On Thu Sep 02 04​:16​:13 2010, avarab@​gmail.com wrote​:

On Wed, Sep 1, 2010 at 14​:33, Nicholas Clark via RT

Should this be applied?

Probably yes.

If it is applied, do we need tests, too? The reason I ask is that I’m
not sure what we should be testing for.

From @nwc10

On Sun, Sep 26, 2010 at 06​:38​:11PM -0700, Father Chrysostomos via RT wrote​:

On Thu Sep 02 04​:16​:13 2010, avarab@​gmail.com wrote​:

On Wed, Sep 1, 2010 at 14​:33, Nicholas Clark via RT

Should this be applied?

Probably yes.

If it is applied, do we need tests, too? The reason I ask is that I???m
not sure what we should be testing for.

I don't think that it can be tested, as I believe the code to be unreachable.
I applied my the patch as f84ff04, appended.

Nicholas Clark

commit f84ff04
Author​: Nicholas Clark <nick@​ccl4.org>
Date​: Tue Oct 12 18​:03​:45 2010 +0100

  XS_Tie_Hash_NamedCapture_STORE should always croak on invalid parameters.
 
  Previously, it would return undef instead of calling Perl_croak_no_modify() if
  PL_localizing was true. However, that case can never be reached. PL_localizing
  is set non-zero for
 
  1​: Perl_mg_localize and PL_save_scalar, for the duration of executing the local
  2​: Perl_leave_scope for the duration of unwinding the local
 
  However, XS_Tie_Hash_NamedCapture_STORE can't be reached in either case, with
  PL_curpm NULL (or otherwise invalid) || !SvROK(ST(0)).
 
  Case 1 would be the call to save_helem_flags() in pp_helem. However, this is
  only reached if preeminent is TRUE, which will only hold if hv_exists_ent()
  has already returned TRUE, which will only be possible if PL_curpm and ST(0)
  are valid.
 
  Case 2 would be the case SAVEt_HELEM in Perl_leave_scope(). However, this
  case is only reached as part of the unwinding from Case 1 above, so again
  PL_curpm and ST(0) will be valid, for this dynamic scope.
 
  This commit is the patch proposed in RT ##77610. It does not resolve all issues
  in that ticket.
 
  Currently C<local $1> is legal - it's a runtime no-op, which neither errors
  *nor* resets $1 to undef. Clearly C&lt;local $+{k}> is inconsistent with this,
  (as it errors at scope exit for all cases, and additionally errors at local
  time if $+{k} exists) but I consider it not worth fixing until we decide
  whether C<local $1>'s current behaviour is a "bug" or a "feature".

diff --git a/universal.c b/universal.c
index e3e91cf..5442f87 100644
--- a/universal.c
+++ b/universal.c
@@ -1307,10 +1307,7 @@ XS(XS_Tie_Hash_NamedCapture_STORE)
     rx = PL_curpm ? PM_GETRE(PL_curpm) : NULL;
 
     if (!rx || !SvROK(ST(0))) {
-        if (!PL_localizing)
-            Perl_croak_no_modify(aTHX);
-        else
-            XSRETURN_UNDEF;
+	Perl_croak_no_modify(aTHX);
     }
 
     SP -= items;

This appears to have been in perl since v5.13.10