This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
In Perl_magic_setdbline, replace the use of atoi() with sv_2iv().
[perl5.git] / mg.c
diff --git a/mg.c b/mg.c
index b4c0692..f70a5e9 100644 (file)
--- a/mg.c
+++ b/mg.c
@@ -116,7 +116,7 @@ S_save_magic_flags(pTHX_ I32 mgs_ix, SV *sv, U32 flags)
     mgs = SSPTR(mgs_ix, MGS*);
     mgs->mgs_sv = sv;
     mgs->mgs_magical = SvMAGICAL(sv);
-    mgs->mgs_readonly = SvREADONLY(sv);
+    mgs->mgs_readonly = SvREADONLY(sv) != 0;
     mgs->mgs_ss_ix = PL_savestack_ix;   /* points after the saved destructor */
     mgs->mgs_bumped = bumped;
 
@@ -661,21 +661,21 @@ Perl_magic_regdatum_get(pTHX_ SV *sv, MAGIC *mg)
        const REGEXP * const rx = PM_GETRE(PL_curpm);
        if (rx) {
            const I32 paren = mg->mg_len;
-           I32 s;
-           I32 t;
+           SSize_t s;
+           SSize_t t;
            if (paren < 0)
                return 0;
            if (paren <= (I32)RX_NPARENS(rx) &&
                (s = RX_OFFS(rx)[paren].start) != -1 &&
                (t = RX_OFFS(rx)[paren].end) != -1)
                {
-                   I32 i;
+                   SSize_t i;
                    if (mg->mg_obj)             /* @+ */
                        i = t;
                    else                        /* @- */
                        i = s;
 
-                   if (i > 0 && RX_MATCH_UTF8(rx)) {
+                   if (RX_MATCH_UTF8(rx)) {
                        const char * const b = RX_SUBBEG(rx);
                        if (b)
                            i = RX_SUBCOFFSET(rx) +
@@ -683,10 +683,12 @@ Perl_magic_regdatum_get(pTHX_ SV *sv, MAGIC *mg)
                                         (U8*)(b-RX_SUBOFFSET(rx)+i));
                    }
 
-                   sv_setiv(sv, i);
+                   sv_setuv(sv, i);
+                   return 0;
                }
        }
     }
+    sv_setsv(sv, NULL);
     return 0;
 }
 
@@ -1983,13 +1985,20 @@ int
 Perl_magic_setdbline(pTHX_ SV *sv, MAGIC *mg)
 {
     dVAR;
-    GV * const gv = PL_DBline;
-    const I32 i = SvTRUE(sv);
-    SV ** const svp = av_fetch(GvAV(gv),
-                    atoi(MgPV_nolen_const(mg)), FALSE);
+    SV **svp;
 
     PERL_ARGS_ASSERT_MAGIC_SETDBLINE;
 
+    /* The magic ptr/len for the debugger's hash should always be an SV.  */
+    if (UNLIKELY(mg->mg_len != HEf_SVKEY)) {
+        Perl_croak(aTHX_ "panic: magic_setdbline len=%"IVdf", ptr='%s'",
+                   mg->mg_len, mg->mg_ptr);
+    }
+
+    /* Use sv_2iv instead of SvIV() as the former generates smaller code, and
+       setting/clearing debugger breakpoints is not a hot path.  */
+    svp = av_fetch(GvAV(PL_DBline), sv_2iv(MUTABLE_SV((mg)->mg_ptr)), FALSE);
+
     if (svp && SvIOKp(*svp)) {
        OP * const o = INT2PTR(OP*,SvIVX(*svp));
        if (o) {
@@ -1997,7 +2006,7 @@ Perl_magic_setdbline(pTHX_ SV *sv, MAGIC *mg)
            Slab_to_rw(OpSLAB(o));
 #endif
            /* set or clear breakpoint in the relevant control op */
-           if (i)
+           if (SvTRUE(sv))
                o->op_flags |= OPf_SPECIAL;
            else
                o->op_flags &= ~OPf_SPECIAL;
@@ -2020,7 +2029,7 @@ Perl_magic_getarylen(pTHX_ SV *sv, const MAGIC *mg)
     if (obj) {
        sv_setiv(sv, AvFILL(obj));
     } else {
-       SvOK_off(sv);
+       sv_setsv(sv, NULL);
     }
     return 0;
 }
@@ -2098,12 +2107,12 @@ Perl_magic_getpos(pTHX_ SV *sv, MAGIC *mg)
 
     if (found && found->mg_len != -1) {
            STRLEN i = found->mg_len;
-           if (DO_UTF8(lsv))
+           if (found->mg_flags & MGf_BYTES && DO_UTF8(lsv))
                i = sv_pos_b2u_flags(lsv, i, SV_GMAGIC|SV_CONST_RETURN);
            sv_setuv(sv, i);
            return 0;
     }
-    SvOK_off(sv);
+    sv_setsv(sv,NULL);
     return 0;
 }
 
@@ -2149,12 +2158,8 @@ Perl_magic_setpos(pTHX_ SV *sv, MAGIC *mg)
     else if (pos > (SSize_t)len)
        pos = len;
 
-    if (ulen) {
-       pos = sv_or_pv_pos_u2b(lsv, s, pos, 0);
-    }
-
     found->mg_len = pos;
-    found->mg_flags &= ~MGf_MINMATCH;
+    found->mg_flags &= ~(MGf_MINMATCH|MGf_BYTES);
 
     return 0;
 }
@@ -2284,10 +2289,7 @@ Perl_magic_getvec(pTHX_ SV *sv, MAGIC *mg)
     PERL_ARGS_ASSERT_MAGIC_GETVEC;
     PERL_UNUSED_ARG(mg);
 
-    if (lsv)
-       sv_setuv(sv, do_vecget(lsv, LvTARGOFF(sv), LvTARGLEN(sv)));
-    else
-       SvOK_off(sv);
+    sv_setuv(sv, do_vecget(lsv, LvTARGOFF(sv), LvTARGLEN(sv)));
 
     return 0;
 }
@@ -2316,10 +2318,10 @@ Perl_defelem_target(pTHX_ SV *sv, MAGIC *mg)
             if (he)
                 targ = HeVAL(he);
        }
-       else {
+       else if (LvSTARGOFF(sv) >= 0) {
            AV *const av = MUTABLE_AV(LvTARG(sv));
-           if ((I32)LvTARGOFF(sv) <= AvFILL(av))
-               targ = AvARRAY(av)[LvTARGOFF(sv)];
+           if (LvSTARGOFF(sv) <= AvFILL(av))
+               targ = AvARRAY(av)[LvSTARGOFF(sv)];
        }
        if (targ && (targ != &PL_sv_undef)) {
            /* somebody else defined it for us */
@@ -2378,14 +2380,16 @@ Perl_vivify_defelem(pTHX_ SV *sv)
        if (!value || value == &PL_sv_undef)
            Perl_croak(aTHX_ PL_no_helem_sv, SVfARG(mg->mg_obj));
     }
+    else if (LvSTARGOFF(sv) < 0)
+       Perl_croak(aTHX_ PL_no_aelem, LvSTARGOFF(sv));
     else {
        AV *const av = MUTABLE_AV(LvTARG(sv));
-       if ((I32)LvTARGLEN(sv) < 0 && (I32)LvTARGOFF(sv) > AvFILL(av))
+       if ((I32)LvTARGLEN(sv) < 0 && LvSTARGOFF(sv) > AvFILL(av))
            LvTARG(sv) = NULL;  /* array can't be extended */
        else {
-           SV* const * const svp = av_fetch(av, LvTARGOFF(sv), TRUE);
-           if (!svp || (value = *svp) == &PL_sv_undef)
-               Perl_croak(aTHX_ PL_no_aelem, (I32)LvTARGOFF(sv));
+           SV* const * const svp = av_fetch(av, LvSTARGOFF(sv), TRUE);
+           if (!svp || !(value = *svp))
+               Perl_croak(aTHX_ PL_no_aelem, LvSTARGOFF(sv));
        }
     }
     SvREFCNT_inc_simple_void(value);
@@ -2590,7 +2594,6 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
        break;
     case '\010':       /* ^H */
        PL_hints = SvIV(sv);
-       CopHINTS_set(&PL_compiling, PL_hints);
        break;
     case '\011':       /* ^I */ /* NOT \t in EBCDIC */
        Safefree(PL_inplace);