This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
$ perl5.6.2 -MData::Dumper -le' Data::Dumper->Dumpxs([*{*STDERR{IO}}])'
[perl5.git] / doop.c
diff --git a/doop.c b/doop.c
index 3a5967d..35efba6 100644 (file)
--- a/doop.c
+++ b/doop.c
@@ -33,7 +33,7 @@ S_do_trans_simple(pTHX_ SV * const sv)
     dVAR;
     I32 matches = 0;
     STRLEN len;
-    U8 *s = (U8*)SvPV(sv,len);
+    U8 *s = (U8*)SvPV_nomg(sv,len);
     U8 * const send = s+len;
     const short * const tbl = (short*)cPVOP->op_pv;
 
@@ -101,7 +101,7 @@ S_do_trans_count(pTHX_ SV * const sv)
 {
     dVAR;
     STRLEN len;
-    const U8 *s = (const U8*)SvPV_const(sv, len);
+    const U8 *s = (const U8*)SvPV_nomg_const(sv, len);
     const U8 * const send = s + len;
     I32 matches = 0;
     const short * const tbl = (short*)cPVOP->op_pv;
@@ -139,7 +139,7 @@ S_do_trans_complex(pTHX_ SV * const sv)
 {
     dVAR;
     STRLEN len;
-    U8 *s = (U8*)SvPV(sv, len);
+    U8 *s = (U8*)SvPV_nomg(sv, len);
     U8 * const send = s+len;
     I32 matches = 0;
     const short * const tbl = (short*)cPVOP->op_pv;
@@ -325,7 +325,7 @@ S_do_trans_simple_utf8(pTHX_ SV * const sv)
 
     PERL_ARGS_ASSERT_DO_TRANS_SIMPLE_UTF8;
 
-    s = (U8*)SvPV(sv, len);
+    s = (U8*)SvPV_nomg(sv, len);
     if (!SvUTF8(sv)) {
        const U8 *t = s;
        const U8 * const e = s + len;
@@ -426,7 +426,7 @@ S_do_trans_count_utf8(pTHX_ SV * const sv)
 
     PERL_ARGS_ASSERT_DO_TRANS_COUNT_UTF8;
 
-    s = (const U8*)SvPV_const(sv, len);
+    s = (const U8*)SvPV_nomg_const(sv, len);
     if (!SvUTF8(sv)) {
        const U8 *t = s;
        const U8 * const e = s + len;
@@ -478,7 +478,7 @@ S_do_trans_complex_utf8(pTHX_ SV * const sv)
     STRLEN len;
     U8 *dstart, *dend;
     U8 hibit = 0;
-    U8 *s = (U8*)SvPV(sv, len);
+    U8 *s = (U8*)SvPV_nomg(sv, len);
 
     PERL_ARGS_ASSERT_DO_TRANS_COMPLEX_UTF8;
 
@@ -635,7 +635,7 @@ Perl_do_trans(pTHX_ SV *sv)
         if (SvIsCOW(sv))
             sv_force_normal_flags(sv, 0);
         if (SvREADONLY(sv))
-            Perl_croak(aTHX_ "%s", PL_no_modify);
+            Perl_croak_no_modify(aTHX);
     }
     (void)SvPV_const(sv, len);
     if (!len)
@@ -1017,7 +1017,7 @@ Perl_do_chop(pTHX_ register SV *astr, register SV *sv)
            sv_force_normal_flags(sv, 0);
         }
         if (SvREADONLY(sv))
-            Perl_croak(aTHX_ "%s", PL_no_modify);
+            Perl_croak_no_modify(aTHX);
     }
 
     if (PL_encoding && !SvUTF8(sv)) {
@@ -1103,7 +1103,7 @@ Perl_do_chomp(pTHX_ register SV *sv)
            sv_force_normal_flags(sv, 0);
         }
         if (SvREADONLY(sv))
-            Perl_croak(aTHX_ "%s", PL_no_modify);
+            Perl_croak_no_modify(aTHX);
     }
 
     if (PL_encoding) {
@@ -1191,8 +1191,7 @@ Perl_do_chomp(pTHX_ register SV *sv)
     }
   nope:
 
-    if (svrecode)
-        SvREFCNT_dec(svrecode);
+    SvREFCNT_dec(svrecode);
 
     Safefree(temp_buffer);
     return count;
@@ -1457,32 +1456,26 @@ Perl_do_kv(pTHX)
        RETURN;
 
     if (gimme == G_SCALAR) {
-       IV i;
-       dTARGET;
-
        if (PL_op->op_flags & OPf_MOD || LVRET) {       /* lvalue */
-           if (SvTYPE(TARG) < SVt_PVLV) {
-               sv_upgrade(TARG, SVt_PVLV);
-               sv_magic(TARG, NULL, PERL_MAGIC_nkeys, NULL, 0);
-           }
-           LvTYPE(TARG) = 'k';
-           if (LvTARG(TARG) != (const SV *)keys) {
-               SvREFCNT_dec(LvTARG(TARG));
-               LvTARG(TARG) = SvREFCNT_inc_simple(keys);
-           }
-           PUSHs(TARG);
-           RETURN;
-       }
-
-       if (! SvTIED_mg((const SV *)keys, PERL_MAGIC_tied) )
-       {
-           i = HvKEYS(keys);
+           SV * const ret = sv_2mortal(newSV_type(SVt_PVLV));  /* Not TARG RT#67838 */
+           sv_magic(ret, NULL, PERL_MAGIC_nkeys, NULL, 0);
+           LvTYPE(ret) = 'k';
+           LvTARG(ret) = SvREFCNT_inc_simple(keys);
+           PUSHs(ret);
        }
        else {
-           i = 0;
-           while (hv_iternext(keys)) i++;
+           IV i;
+           dTARGET;
+
+           if (! SvTIED_mg((const SV *)keys, PERL_MAGIC_tied) ) {
+               i = HvKEYS(keys);
+           }
+           else {
+               i = 0;
+               while (hv_iternext(keys)) i++;
+           }
+           PUSHi( i );
        }
-       PUSHi( i );
        RETURN;
     }