This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
use New() et al., rather than safemalloc() et al.
[perl5.git] / pp_hot.c
index 733b6b0..b1bf270 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -322,6 +322,7 @@ PP(pp_print)
     IO *io;
     register PerlIO *fp;
     MAGIC *mg;
+    STRLEN n_a;
 
     if (PL_op->op_flags & OPf_STACKED)
        gv = (GV*)*++MARK;
@@ -353,7 +354,7 @@ PP(pp_print)
        if (ckWARN(WARN_UNOPENED)) {
            SV* sv = sv_newmortal();
             gv_fullname3(sv, gv, Nullch);
-            warner(WARN_UNOPENED, "Filehandle %s never opened", SvPV(sv,PL_na));
+            warner(WARN_UNOPENED, "Filehandle %s never opened", SvPV(sv,n_a));
         }
 
        SETERRNO(EBADF,RMS$_IFI);
@@ -365,10 +366,10 @@ PP(pp_print)
             gv_fullname3(sv, gv, Nullch);
            if (IoIFP(io))
                warner(WARN_IO, "Filehandle %s opened only for input", 
-                               SvPV(sv,PL_na));
+                               SvPV(sv,n_a));
            else if (ckWARN(WARN_CLOSED))
                warner(WARN_CLOSED, "print on closed filehandle %s", 
-                               SvPV(sv,PL_na));
+                               SvPV(sv,n_a));
        }
        SETERRNO(EBADF,IoIFP(io)?RMS$_FAC:RMS$_IFI);
        goto just_say_no;
@@ -447,6 +448,7 @@ PP(pp_rv2av)
            
            if (SvTYPE(sv) != SVt_PVGV) {
                char *sym;
+               STRLEN n_a;
 
                if (SvGMAGICAL(sv)) {
                    mg_get(sv);
@@ -460,16 +462,26 @@ PP(pp_rv2av)
                    if (ckWARN(WARN_UNINITIALIZED))
                        warner(WARN_UNINITIALIZED, PL_warn_uninit);
                    if (GIMME == G_ARRAY) {
-                       POPs;
+                       (void)POPs;
                        RETURN;
                    }
                    RETSETUNDEF;
                }
-               sym = SvPV(sv,PL_na);
-               if (PL_op->op_private & HINT_STRICT_REFS)
-                   DIE(PL_no_symref, sym, "an ARRAY");
-               gv = (GV*)gv_fetchpv(sym, TRUE, SVt_PVAV);
-           } else {
+               sym = SvPV(sv,n_a);
+               if ((PL_op->op_flags & OPf_SPECIAL) &&
+                   !(PL_op->op_flags & OPf_MOD))
+               {
+                   gv = (GV*)gv_fetchpv(sym, FALSE, SVt_PVAV);
+                   if (!gv)
+                       RETSETUNDEF;
+               }
+               else {
+                   if (PL_op->op_private & HINT_STRICT_REFS)
+                       DIE(PL_no_symref, sym, "an ARRAY");
+                   gv = (GV*)gv_fetchpv(sym, TRUE, SVt_PVAV);
+               }
+           }
+           else {
                gv = (GV*)sv;
            }
            av = GvAVn(gv);
@@ -484,7 +496,7 @@ PP(pp_rv2av)
 
     if (GIMME == G_ARRAY) {
        I32 maxarg = AvFILL(av) + 1;
-       POPs;                           /* XXXX May be optimized away? */
+       (void)POPs;                     /* XXXX May be optimized away? */
        EXTEND(SP, maxarg);          
        if (SvRMAGICAL(av)) {
            U32 i; 
@@ -536,6 +548,7 @@ PP(pp_rv2hv)
            
            if (SvTYPE(sv) != SVt_PVGV) {
                char *sym;
+               STRLEN n_a;
 
                if (SvGMAGICAL(sv)) {
                    mg_get(sv);
@@ -554,11 +567,21 @@ PP(pp_rv2hv)
                    }
                    RETSETUNDEF;
                }
-               sym = SvPV(sv,PL_na);
-               if (PL_op->op_private & HINT_STRICT_REFS)
-                   DIE(PL_no_symref, sym, "a HASH");
-               gv = (GV*)gv_fetchpv(sym, TRUE, SVt_PVHV);
-           } else {
+               sym = SvPV(sv,n_a);
+               if ((PL_op->op_flags & OPf_SPECIAL) &&
+                   !(PL_op->op_flags & OPf_MOD))
+               {
+                   gv = (GV*)gv_fetchpv(sym, FALSE, SVt_PVHV);
+                   if (!gv)
+                       RETSETUNDEF;
+               }
+               else {
+                   if (PL_op->op_private & HINT_STRICT_REFS)
+                       DIE(PL_no_symref, sym, "a HASH");
+                   gv = (GV*)gv_fetchpv(sym, TRUE, SVt_PVHV);
+               }
+           }
+           else {
                gv = (GV*)sv;
            }
            hv = GvHVn(gv);
@@ -652,7 +675,7 @@ PP(pp_aassign)
                    if (SvSMAGICAL(sv))
                        mg_set(sv);
                    if (!didstore)
-                       SvREFCNT_dec(sv);
+                       sv_2mortal(sv);
                }
                TAINT_NOT;
            }
@@ -679,7 +702,7 @@ PP(pp_aassign)
                        if (SvSMAGICAL(tmpstr))
                            mg_set(tmpstr);
                        if (!didstore)
-                           SvREFCNT_dec(tmpstr);
+                           sv_2mortal(tmpstr);
                    }
                    TAINT_NOT;
                }
@@ -701,7 +724,7 @@ PP(pp_aassign)
                            if (SvSMAGICAL(tmpstr))
                                mg_set(tmpstr);
                            if (!didstore)
-                               SvREFCNT_dec(tmpstr);
+                               sv_2mortal(tmpstr);
                        }
                        TAINT_NOT;
                    }
@@ -841,6 +864,7 @@ PP(pp_match)
     I32 minmatch = 0;
     I32 oldsave = PL_savestack_ix;
     I32 update_minmatch = 1;
+    I32 had_zerolen = 0;
 
     if (PL_op->op_flags & OPf_STACKED)
        TARG = POPs;
@@ -871,12 +895,15 @@ PP(pp_match)
     if (rx->minlen > len) goto failure;
 
     truebase = t = s;
+
+    /* XXXX What part of this is needed with true \G-support? */
     if (global = pm->op_pmflags & PMf_GLOBAL) {
        rx->startp[0] = 0;
        if (SvTYPE(TARG) >= SVt_PVMG && SvMAGIC(TARG)) {
            MAGIC* mg = mg_find(TARG, 'g');
            if (mg && mg->mg_len >= 0) {
-               rx->endp[0] = rx->startp[0] = s + mg->mg_len; 
+               if (!(rx->reganch & ROPT_GPOS_SEEN))
+                   rx->endp[0] = rx->startp[0] = s + mg->mg_len; 
                minmatch = (mg->mg_flags & MGf_MINMATCH);
                update_minmatch = 0;
            }
@@ -901,7 +928,7 @@ play_it_again:
        if ((s + rx->minlen) > strend)
            goto nope;
        if (update_minmatch++)
-           minmatch = (s == rx->startp[0]);
+           minmatch = had_zerolen;
     }
     if (rx->check_substr) {
        if (!(rx->reganch & ROPT_NOSCAN)) { /* Floating checkstring. */
@@ -987,9 +1014,9 @@ play_it_again:
        if (global) {
            truebase = rx->subbeg;
            strend = rx->subend;
-           if (rx->startp[0] && rx->startp[0] == rx->endp[0])
-               ++rx->endp[0];
+           had_zerolen = (rx->startp[0] && rx->startp[0] == rx->endp[0]);
            PUTBACK;                    /* EVAL blocks may use stack */
+           r_flags |= REXEC_IGNOREPOS;
            goto play_it_again;
        }
        else if (!iters)
@@ -1270,8 +1297,18 @@ do_readline(void)
        sv = sv_2mortal(NEWSV(57, 80));
        offset = 0;
     }
+
+/* flip-flop EOF state for a snarfed empty file */
+#define SNARF_EOF(gimme,rs,io,sv) \
+    ((gimme != G_SCALAR || SvCUR(sv)                                   \
+      || (IoFLAGS(io) & IOf_NOLINE) || IoLINES(io) || !RsSNARF(rs))    \
+       ? ((IoFLAGS(io) &= ~IOf_NOLINE), TRUE)                          \
+       : ((IoFLAGS(io) |= IOf_NOLINE), FALSE))
+
     for (;;) {
-       if (!sv_gets(sv, fp, offset)) {
+       if (!sv_gets(sv, fp, offset)
+           && (type == OP_GLOB || SNARF_EOF(gimme, PL_rs, io, sv)))
+       {
            PerlIO_clearerr(fp);
            if (IoFLAGS(io) & IOf_ARGV) {
                fp = nextargv(PL_last_in_gv);
@@ -1389,8 +1426,10 @@ PP(pp_helem)
        if (!svp || *svp == &PL_sv_undef) {
            SV* lv;
            SV* key2;
-           if (!defer)
-               DIE(PL_no_helem, SvPV(keysv, PL_na));
+           if (!defer) {
+               STRLEN n_a;
+               DIE(PL_no_helem, SvPV(keysv, n_a));
+           }
            lv = sv_newmortal();
            sv_upgrade(lv, SVt_PVLV);
            LvTYPE(lv) = 'y';
@@ -1822,6 +1861,7 @@ PP(pp_subst)
            PUSHSUBST(cx);
            RETURNOP(cPMOP->op_pmreplroot);
        }
+       r_flags |= REXEC_IGNOREPOS;
        do {
            if (iters++ > maxiters)
                DIE("Substitution loop");
@@ -1840,7 +1880,7 @@ PP(pp_subst)
                sv_catpvn(dstr, c, clen);
            if (once)
                break;
-       } while (CALLREGEXEC(rx, s, strend, orig, s == m, Nullsv, NULL, r_flags));
+       } while (CALLREGEXEC(rx, s, strend, orig, s == m, TARG, NULL, r_flags));
        sv_catpvn(dstr, s, strend - s);
 
        (void)SvOOK_off(TARG);
@@ -2018,6 +2058,7 @@ PP(pp_entersub)
     default:
        if (!SvROK(sv)) {
            char *sym;
+           STRLEN n_a;
 
            if (sv == &PL_sv_yes) {             /* unfound import, ignore */
                if (hasargs)
@@ -2029,7 +2070,7 @@ PP(pp_entersub)
                sym = SvPOKp(sv) ? SvPVX(sv) : Nullch;
            }
            else
-               sym = SvPV(sv, PL_na);
+               sym = SvPV(sv, n_a);
            if (!sym)
                DIE(PL_no_usym, "a subroutine");
            if (PL_op->op_private & HINT_STRICT_REFS)
@@ -2524,7 +2565,7 @@ PP(pp_method)
        }
     }
 
-    name = SvPV(TOPs, PL_na);
+    name = SvPV(TOPs, packlen);
     sv = *(PL_stack_base + TOPMARK + 1);
     
     if (SvGMAGICAL(sv))