briefly document DB::lsub

[perl5.git] / pp_hot.c

diff --git a/pp_hot.c b/pp_hot.c
index 6068d21..1155328 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -1326,7 +1326,7 @@ PP(pp_match)
     PMOP *dynpm = pm;
     const char *s;
     const char *strend;
-    I32 curpos = 0; /* initial pos() or current $+[0] */
+    SSize_t curpos = 0; /* initial pos() or current $+[0] */
     I32 global;
     U8 r_flags = 0;
     const char *truebase;                      /* Start of string  */
@@ -1383,8 +1383,10 @@ PP(pp_match)
        rx = PM_GETRE(pm);
     }
 
-    if (RX_MINLEN(rx) > (I32)len) {
-        DEBUG_r(PerlIO_printf(Perl_debug_log, "String shorter than min possible regex match\n"));
+    if (RX_MINLEN(rx) >= 0 && (STRLEN)RX_MINLEN(rx) > len) {
+        DEBUG_r(PerlIO_printf(Perl_debug_log, "String shorter than min possible regex match (%"
+                                              UVuf" < %"IVdf")\n",
+                                              (UV)len, (IV)RX_MINLEN(rx)));
        goto nope;
     }
 
@@ -1392,7 +1394,7 @@ PP(pp_match)
     if (global) {
         mg = mg_find_mglob(TARG);
         if (mg && mg->mg_len >= 0) {
-            curpos = mg->mg_len;
+            curpos = MgBYTEPOS(mg, TARG, truebase, len);
             /* last time pos() was set, it was zero-length match */
             if (mg->mg_flags & MGf_MINMATCH)
                 had_zerolen = 1;
@@ -1448,7 +1450,7 @@ PP(pp_match)
     if (global && (gimme != G_ARRAY || (dynpm->op_pmflags & PMf_CONTINUE))) {
         if (!mg)
             mg = sv_magicext_mglob(TARG);
-        mg->mg_len = RX_OFFS(rx)[0].end;
+        MgBYTEPOS_set(mg, TARG, truebase, RX_OFFS(rx)[0].end);
         if (RX_ZERO_LEN(rx))
             mg->mg_flags |= MGf_MINMATCH;
         else
@@ -1567,14 +1569,10 @@ Perl_do_readline(pTHX)
     }
     if (!fp) {
        if ((!io || !(IoFLAGS(io) & IOf_START))
-           && ckWARN2(WARN_GLOB, WARN_CLOSED))
+           && ckWARN(WARN_CLOSED)
+            && type != OP_GLOB)
        {
-           if (type == OP_GLOB)
-               Perl_ck_warner_d(aTHX_ packWARN(WARN_GLOB),
-                           "glob failed (can't start child: %s)",
-                           Strerror(errno));
-           else
-               report_evil_fh(PL_last_in_gv);
+           report_evil_fh(PL_last_in_gv);
        }
        if (gimme == G_SCALAR) {
            /* undef TARG, and push that undefined value */
@@ -1916,19 +1914,12 @@ PP(pp_iter)
                 SvREFCNT_inc_simple_void_NN(sv);
             }
         }
+        else if (!av_is_stack) {
+            sv = newSVavdefelem(av, ix, 0);
+        }
         else
             sv = &PL_sv_undef;
 
-        if (!av_is_stack && sv == &PL_sv_undef) {
-            SV *lv = newSV_type(SVt_PVLV);
-            LvTYPE(lv) = 'y';
-            sv_magic(lv, NULL, PERL_MAGIC_defelem, NULL, 0);
-            LvTARG(lv) = SvREFCNT_inc_simple(av);
-            LvTARGOFF(lv) = ix;
-            LvTARGLEN(lv) = (STRLEN)UV_MAX;
-            sv = lv;
-        }
-
         oldsv = *itersvp;
         *itersvp = sv;
         SvREFCNT_dec(oldsv);
@@ -2508,8 +2499,8 @@ PP(pp_leavesub)
     PUTBACK;
 
     LEAVE;
-    cxstack_ix--;
     POPSUB(cx,sv);     /* Stack values are safe: release CV and @_ ... */
+    cxstack_ix--;
     PL_curpm = newpm;  /* ... and pop $1 et al */
 
     LEAVESUB(sv);
@@ -2645,7 +2636,7 @@ try_autoload:
     if (!(CvISXSUB(cv))) {
        /* This path taken at least 75% of the time   */
        dMARK;
-       I32 items = SP - MARK;
+       SSize_t items = SP - MARK;
        PADLIST * const padlist = CvPADLIST(cv);
        PUSHBLOCK(cx, CXt_SUB, MARK);
        PUSHSUB(cx);
@@ -2708,7 +2699,7 @@ try_autoload:
        RETURNOP(CvSTART(cv));
     }
     else {
-       I32 markix = TOPMARK;
+       SSize_t markix = TOPMARK;
 
        SAVETMPS;
        PUTBACK;
@@ -2719,24 +2710,38 @@ try_autoload:
            !CvLVALUE(cv))
            DIE(aTHX_ "Can't modify non-lvalue subroutine call");
 
-       if (!hasargs) {
+       if (!hasargs && GvAV(PL_defgv)) {
            /* Need to copy @_ to stack. Alternative may be to
             * switch stack to @_, and copy return values
             * back. This would allow popping @_ in XSUB, e.g.. XXXX */
            AV * const av = GvAV(PL_defgv);
-           const I32 items = AvFILLp(av) + 1;   /* @_ is not tieable */
+           const SSize_t items = AvFILL(av) + 1;
 
            if (items) {
+               SSize_t i = 0;
+               const bool m = cBOOL(SvRMAGICAL(av));
                /* Mark is at the end of the stack. */
                EXTEND(SP, items);
-               Copy(AvARRAY(av), SP + 1, items, SV*);
+               for (; i < items; ++i)
+               {
+                   SV *sv;
+                   if (m) {
+                       SV ** const svp = av_fetch(av, i, 0);
+                       sv = svp ? *svp : NULL;
+                   }
+                   else sv = AvARRAY(av)[i];
+                   if (sv) SP[i+1] = sv;
+                   else {
+                       SP[i+1] = newSVavdefelem(av, i, 1);
+                   }
+               }
                SP += items;
                PUTBACK ;               
            }
        }
        else {
            SV **mark = PL_stack_base + markix;
-           I32 items = SP - mark;
+           SSize_t items = SP - mark;
            while (items--) {
                mark++;
                if (*mark && SvPADTMP(*mark) && !IS_PADGV(*mark))
@@ -2838,23 +2843,16 @@ PP(pp_aelem)
         }
 #endif
        if (!svp || !*svp) {
-           SV* lv;
            IV len;
            if (!defer)
                DIE(aTHX_ PL_no_aelem, elem);
            len = av_len(av);
-           lv = sv_newmortal();
-           sv_upgrade(lv, SVt_PVLV);
-           LvTYPE(lv) = 'y';
-           sv_magic(lv, NULL, PERL_MAGIC_defelem, NULL, 0);
-           LvTARG(lv) = SvREFCNT_inc_simple(av);
+           mPUSHs(newSVavdefelem(av,
            /* Resolve a negative index now, unless it points before the
               beginning of the array, in which case record it for error
               reporting in magic_setdefelem. */
-           LvSTARGOFF(lv) =
-               elem < 0 && len + elem >= 0 ? len + elem : elem;
-           LvTARGLEN(lv) = 1;
-           PUSHs(lv);
+               elem < 0 && len + elem >= 0 ? len + elem : elem,
+               1));
            RETURN;
        }
        if (localizing) {