diff options
| -rw-r--r-- | dist/Storable/t/tied_items.t | 4 | ||||
| -rw-r--r-- | mg.c | 2 | ||||
| -rw-r--r-- | mg.h | 2 | ||||
| -rw-r--r-- | pp_hot.c | 26 | ||||
| -rw-r--r-- | t/op/magic.t | 11 | ||||
| -rw-r--r-- | t/op/taint.t | 22 |
6 files changed, 44 insertions, 23 deletions
diff --git a/dist/Storable/t/tied_items.t b/dist/Storable/t/tied_items.t index bd15e5cc4f..03e6cfe9ff 100644 --- a/dist/Storable/t/tied_items.t +++ b/dist/Storable/t/tied_items.t @@ -55,5 +55,5 @@ $ref2 = dclone $ref; ok 5, $a_fetches == 0; ok 6, $$ref2 eq $$ref; ok 7, $$ref2 == 8; -# I don't understand why it's 3 and not 2 -ok 8, $a_fetches == 3; +# a bug in 5.12 and earlier caused an extra FETCH +ok 8, $a_fetches == 2 || $a_fetches == 3 ; @@ -1691,7 +1691,7 @@ Perl_magic_getpack(pTHX_ SV *sv, MAGIC *mg) { PERL_ARGS_ASSERT_MAGIC_GETPACK; - if (mg->mg_ptr) + if (mg->mg_type == PERL_MAGIC_tiedelem) mg->mg_flags |= MGf_GSKIP; magic_methpack(sv,mg,"FETCH"); return 0; @@ -38,7 +38,7 @@ struct magic { #define MGf_TAINTEDDIR 1 /* PERL_MAGIC_envelem only */ #define MGf_MINMATCH 1 /* PERL_MAGIC_regex_global only */ #define MGf_REFCOUNTED 2 -#define MGf_GSKIP 4 +#define MGf_GSKIP 4 /* skip further GETs until after next SET */ #define MGf_COPY 8 /* has an svt_copy MGVTBL entry */ #define MGf_DUP 0x10 /* has an svt_dup MGVTBL entry */ #define MGf_LOCAL 0x20 /* has an svt_local MGVTBL entry */ @@ -658,7 +658,7 @@ PP(pp_aelemfast) SV *sv = (svp ? *svp : &PL_sv_undef); EXTEND(SP, 1); if (!lval && SvGMAGICAL(sv)) /* see note in pp_helem() */ - sv = sv_mortalcopy(sv); + mg_get(sv); PUSHs(sv); RETURN; } @@ -893,7 +893,7 @@ PP(pp_rv2av) SV ** const svp = av_fetch(av, i, FALSE); /* See note in pp_helem, and bug id #27839 */ SP[i+1] = svp - ? SvGMAGICAL(*svp) ? sv_mortalcopy(*svp) : *svp + ? SvGMAGICAL(*svp) ? (mg_get(*svp), *svp) : *svp : &PL_sv_undef; } } @@ -1840,14 +1840,20 @@ PP(pp_helem) vivify_ref(*svp, PL_op->op_private & OPpDEREF); } sv = (svp ? *svp : &PL_sv_undef); - /* This makes C<local $tied{foo} = $tied{foo}> possible. - * Pushing the magical RHS on to the stack is useless, since - * that magic is soon destined to be misled by the local(), - * and thus the later pp_sassign() will fail to mg_get() the - * old value. This should also cure problems with delayed - * mg_get()s. GSAR 98-07-03 */ + /* Originally this did a conditional C<sv = sv_mortalcopy(sv)>; this + * was to make C<local $tied{foo} = $tied{foo}> possible. + * However, it seems no longer to be needed for that purpose, and + * introduced a new bug: stuff like C<while ($hash{taintedval} =~ /.../g> + * would loop endlessly since the pos magic is getting set on the + * mortal copy and lost. However, the copy has the effect of + * triggering the get magic, and losing it altogether made things like + * c<$tied{foo};> in void context no longer do get magic, which some + * code relied on. Also, delayed triggering of magic on @+ and friends + * meant the original regex may be out of scope by now. So as a + * compromise, do the get magic here. (The MGf_GSKIP flag will stop it + * being called too many times). */ if (!lval && SvGMAGICAL(sv)) - sv = sv_mortalcopy(sv); + mg_get(sv); PUSHs(sv); RETURN; } @@ -2983,7 +2989,7 @@ PP(pp_aelem) } sv = (svp ? *svp : &PL_sv_undef); if (!lval && SvGMAGICAL(sv)) /* see note in pp_helem() */ - sv = sv_mortalcopy(sv); + mg_get(sv); PUSHs(sv); RETURN; } diff --git a/t/op/magic.t b/t/op/magic.t index 3df3e4bab0..5a2733fd3a 100644 --- a/t/op/magic.t +++ b/t/op/magic.t @@ -12,7 +12,7 @@ BEGIN { use warnings; use Config; -plan (tests => 80); +plan (tests => 81); $Is_MSWin32 = $^O eq 'MSWin32'; $Is_NetWare = $^O eq 'NetWare'; @@ -443,6 +443,15 @@ is "@+", "10 1 6 10"; }; my @y = f(); is $x, "@y", "return a magic array ($x) vs (@y)"; + + sub f2 { + "abc" =~ /(?<foo>.)./; + my @h = %+; + $x = "@h"; + return %+; + }; + @y = f(); + is $x, "@y", "return a magic hash ($x) vs (@y)"; } # Test for bug [perl #36434] diff --git a/t/op/taint.t b/t/op/taint.t index b4c8bfea53..f601552e28 100644 --- a/t/op/taint.t +++ b/t/op/taint.t @@ -17,7 +17,7 @@ use Config; use File::Spec::Functions; BEGIN { require './test.pl'; } -plan tests => 319; +plan tests => 321; $| = 1; @@ -1128,13 +1128,19 @@ TERNARY_CONDITIONALS: { { my @a; - local $::TODO = 1; - $a[0] = $^X; - my $i = 0; - while($a[0]=~ m/(.)/g ) { - last if $i++ > 10000; - } - cmp_ok $i, '<', 10000, "infinite m//g"; + $a[0] = $^X . '-'; + $a[0]=~ m/(.)/g; + cmp_ok pos($a[0]), '>', 0, "infinite m//g on arrays (aelemfast)"; + + my $i = 1; + $a[$i] = $^X . '-'; + $a[$i]=~ m/(.)/g; + cmp_ok pos($a[$i]), '>', 0, "infinite m//g on arrays (aelem)"; + + my %h; + $h{a} = $^X . '-'; + $h{a}=~ m/(.)/g; + cmp_ok pos($h{a}), '>', 0, "infinite m//g on hashes (helem)"; } SKIP: |