X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=pp_ctl.c;h=9633ba3a247e094ce2a47d448a433bfcc44877f3;hb=326b5008ebd8d91bf6b00d96127d2d711c9f2132;hp=1a0245a17f9de6752b5872aba1a223e10b51547b;hpb=941a98a017bebaf9418c346af5601481227ecf3c;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/pp_ctl.c b/pp_ctl.c
index 1a0245a..9633ba3 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -113,7 +113,7 @@ PP(pp_regcomp)
 	tmpstr = POPs;
 
     if (SvROK(tmpstr)) {
-	SV *sv = SvRV(tmpstr);
+	SV * const sv = SvRV(tmpstr);
 	if(SvMAGICAL(sv))
 	    mg = mg_find(sv, PERL_MAGIC_qr);
     }
@@ -125,14 +125,14 @@ PP(pp_regcomp)
     else {
 	STRLEN len;
 	const char *t = SvPV_const(tmpstr, len);
+	regexp * const re = PM_GETRE(pm);
 
 	/* Check against the last compiled regexp. */
-	if (!PM_GETRE(pm) || !PM_GETRE(pm)->precomp ||
-	    PM_GETRE(pm)->prelen != (I32)len ||
-	    memNE(PM_GETRE(pm)->precomp, t, len))
+	if (!re || !re->precomp || re->prelen != (I32)len ||
+	    memNE(re->precomp, t, len))
 	{
-	    if (PM_GETRE(pm)) {
-	        ReREFCNT_dec(PM_GETRE(pm));
+	    if (re) {
+	        ReREFCNT_dec(re);
 		PM_SETRE(pm, NULL);	/* crucial if regcomp aborts */
 	    }
 	    if (PL_op->op_flags & OPf_SPECIAL)
@@ -197,7 +197,7 @@ PP(pp_substcont)
     if(old != rx) {
 	if(old)
 	    ReREFCNT_dec(old);
-	PM_SETRE(pm,rx);
+	PM_SETRE(pm,ReREFCNT_inc(rx));
     }
 
     rxres_restore(&cx->sb_rxres, rx);
@@ -245,7 +245,6 @@ PP(pp_substcont)
 	    if (DO_UTF8(dstr))
 		SvUTF8_on(targ);
 	    SvPV_set(dstr, NULL);
-	    sv_free(dstr);
 
 	    TAINT_IF(cx->sb_rxtainted & 1);
 	    PUSHs(sv_2mortal(newSViv(saviters - 1)));
@@ -256,7 +255,6 @@ PP(pp_substcont)
 	    SvTAINT(targ);
 
 	    LEAVE_SCOPE(cx->sb_oldsave);
-	    ReREFCNT_dec(rx);
 	    POPSUBST(cx);
 	    RETURNOP(pm->op_next);
 	}
@@ -831,7 +829,7 @@ PP(pp_formline)
 	    /* Formats aren't yet marked for locales, so assume "yes". */
 	    {
 		STORE_NUMERIC_STANDARD_SET_LOCAL();
-		sprintf(t, fmt, (int) fieldsize, (int) arg & 255, value);
+		my_snprintf(t, SvLEN(PL_formtarget) - (t - SvPVX(PL_formtarget)), fmt, (int) fieldsize, (int) arg & 255, value);
 		RESTORE_NUMERIC_STANDARD();
 	    }
 	    t += fieldsize;
@@ -1450,7 +1448,7 @@ Perl_qerror(pTHX_ SV *err)
     else if (PL_errors)
 	sv_catsv(PL_errors, err);
     else
-	Perl_warn(aTHX_ "%"SVf, err);
+	Perl_warn(aTHX_ "%"SVf, (void*)err);
     ++PL_error_count;
 }
 
@@ -1721,10 +1719,10 @@ PP(pp_caller)
         PUSHs(sv_2mortal(mask));
     }
 
-    PUSHs(cx->blk_oldcop->cop_hints ?
+    PUSHs(cx->blk_oldcop->cop_hints_hash ?
 	  sv_2mortal(newRV_noinc(
-		(SV*)Perl_refcounted_he_chain_2hv(aTHX_
-						  cx->blk_oldcop->cop_hints)))
+	    (SV*)Perl_refcounted_he_chain_2hv(aTHX_
+					      cx->blk_oldcop->cop_hints_hash)))
 	  : &PL_sv_undef);
     RETURN;
 }
@@ -1925,7 +1923,7 @@ PP(pp_leaveloop)
 
     TAINT_NOT;
     if (gimme == G_VOID)
-	/*EMPTY*/; /* do nothing */
+	NOOP;
     else if (gimme == G_SCALAR) {
 	if (mark < SP)
 	    *++newsp = sv_mortalcopy(*SP);
@@ -2012,7 +2010,7 @@ PP(pp_return)
 	    /* Unassume the success we assumed earlier. */
 	    SV * const nsv = cx->blk_eval.old_namesv;
 	    (void)hv_delete(GvHVn(PL_incgv), SvPVX_const(nsv), SvCUR(nsv), G_DISCARD);
-	    DIE(aTHX_ "%"SVf" did not return a true value", nsv);
+	    DIE(aTHX_ "%"SVf" did not return a true value", (void*)nsv);
 	}
 	break;
     case CXt_FORMAT:
@@ -2320,7 +2318,7 @@ PP(pp_goto)
 			goto retry;
 		    tmpstr = sv_newmortal();
 		    gv_efullname3(tmpstr, gv, NULL);
-		    DIE(aTHX_ "Goto undefined subroutine &%"SVf"",tmpstr);
+		    DIE(aTHX_ "Goto undefined subroutine &%"SVf"",(void*)tmpstr);
 		}
 		DIE(aTHX_ "Goto undefined subroutine");
 	    }
@@ -2413,7 +2411,7 @@ PP(pp_goto)
 
 		CvDEPTH(cv)++;
 		if (CvDEPTH(cv) < 2)
-		    SvREFCNT_inc_void_NN(cv);
+		    SvREFCNT_inc_simple_void_NN(cv);
 		else {
 		    if (CvDEPTH(cv) == 100 && ckWARN(WARN_RECURSION))
 			sub_crush_depth(cv);
@@ -2769,8 +2767,8 @@ Perl_sv_compile_2op(pTHX_ SV *sv, OP** startop, const char *code, PAD** padp)
 	len = SvCUR(sv);
     }
     else
-	len = my_sprintf(tmpbuf, "_<(%.10s_eval %lu)", code,
-			 (unsigned long)++PL_evalseq);
+	len = my_snprintf(tmpbuf, sizeof(tbuf), "_<(%.10s_eval %lu)", code,
+			  (unsigned long)++PL_evalseq);
     SAVECOPFILE_FREE(&PL_compiling);
     CopFILE_set(&PL_compiling, tmpbuf+2);
     SAVECOPLINE(&PL_compiling);
@@ -2898,6 +2896,7 @@ S_doeval(pTHX_ int gimme, OP** startop, CV* outside, U32 seq)
     /* set up a scratch pad */
 
     CvPADLIST(PL_compcv) = pad_new(padnew_SAVE);
+    PL_op = NULL; /* avoid PL_op and PL_curpad referring to different CVs */
 
 
     if (!PL_madskills)
@@ -2994,7 +2993,7 @@ S_doeval(pTHX_ int gimme, OP** startop, CV* outside, U32 seq)
     DEBUG_x(dump_eval());
 
     /* Register with debugger: */
-    if (PERLDB_INTER && saveop->op_type == OP_REQUIRE) {
+    if (PERLDB_INTER && saveop && saveop->op_type == OP_REQUIRE) {
 	CV * const cv = get_cv("DB::postponed", FALSE);
 	if (cv) {
 	    dSP;
@@ -3020,6 +3019,7 @@ S_check_type_and_open(pTHX_ const char *name, const char *mode)
 {
     Stat_t st;
     const int st_rc = PerlLIO_stat(name, &st);
+
     if (st_rc < 0 || S_ISDIR(st.st_mode) || S_ISBLK(st.st_mode)) {
 	return NULL;
     }
@@ -3067,6 +3067,7 @@ PP(pp_require)
     const I32 gimme = GIMME_V;
     int filter_has_file = 0;
     PerlIO *tryrsfp = NULL;
+    SV *filter_cache = NULL;
     SV *filter_state = NULL;
     SV *filter_sub = NULL;
     SV *hook_sv = NULL;
@@ -3083,14 +3084,14 @@ PP(pp_require)
 	if (!sv_derived_from(PL_patchlevel, "version"))
 	    upg_version(PL_patchlevel);
 	if (cUNOP->op_first->op_type == OP_CONST && cUNOP->op_first->op_private & OPpCONST_NOVER) {
-	    if ( vcmp(sv,PL_patchlevel) < 0 )
+	    if ( vcmp(sv,PL_patchlevel) <= 0 )
 		DIE(aTHX_ "Perls since %"SVf" too modern--this is %"SVf", stopped",
-		    vnormal(sv), vnormal(PL_patchlevel));
+		    (void*)vnormal(sv), (void*)vnormal(PL_patchlevel));
 	}
 	else {
 	    if ( vcmp(sv,PL_patchlevel) > 0 )
 		DIE(aTHX_ "Perl %"SVf" required--this is only %"SVf", stopped",
-		    vnormal(sv), vnormal(PL_patchlevel));
+		    (void*)vnormal(sv), (void*)vnormal(PL_patchlevel));
 	}
 
 	    RETPUSHYES;
@@ -3136,7 +3137,7 @@ PP(pp_require)
 	{
 	    namesv = newSV(0);
 	    for (i = 0; i <= AvFILL(ar); i++) {
-		SV *dirsv = *av_fetch(ar, i, TRUE);
+		SV * const dirsv = *av_fetch(ar, i, TRUE);
 
 		if (SvROK(dirsv)) {
 		    int count;
@@ -3174,12 +3175,22 @@ PP(pp_require)
 			SP -= count - 1;
 			arg = SP[i++];
 
+			if (SvROK(arg) && (SvTYPE(SvRV(arg)) <= SVt_PVLV)
+			    && !isGV_with_GP(SvRV(arg))) {
+			    filter_cache = SvRV(arg);
+			    SvREFCNT_inc_simple_void_NN(filter_cache);
+
+			    if (i < count) {
+				arg = SP[i++];
+			    }
+			}
+
 			if (SvROK(arg) && SvTYPE(SvRV(arg)) == SVt_PVGV) {
 			    arg = SvRV(arg);
 			}
 
 			if (SvTYPE(arg) == SVt_PVGV) {
-			    IO *io = GvIO((GV *)arg);
+			    IO * const io = GvIO((GV *)arg);
 
 			    ++filter_has_file;
 
@@ -3199,17 +3210,17 @@ PP(pp_require)
 
 			if (SvROK(arg) && SvTYPE(SvRV(arg)) == SVt_PVCV) {
 			    filter_sub = arg;
-			    SvREFCNT_inc_void_NN(filter_sub);
+			    SvREFCNT_inc_simple_void_NN(filter_sub);
 
 			    if (i < count) {
 				filter_state = SP[i];
 				SvREFCNT_inc_simple_void(filter_state);
 			    }
+			}
 
-			    if (!tryrsfp) {
-				tryrsfp = PerlIO_open(BIT_BUCKET,
-						      PERL_SCRIPT_MODE);
-			    }
+			if (!tryrsfp && (filter_cache || filter_sub)) {
+			    tryrsfp = PerlIO_open(BIT_BUCKET,
+						  PERL_SCRIPT_MODE);
 			}
 			SP--;
 		    }
@@ -3224,6 +3235,10 @@ PP(pp_require)
 		    }
 
 		    filter_has_file = 0;
+		    if (filter_cache) {
+			SvREFCNT_dec(filter_cache);
+			filter_cache = NULL;
+		    }
 		    if (filter_state) {
 			SvREFCNT_dec(filter_state);
 			filter_state = NULL;
@@ -3282,6 +3297,9 @@ PP(pp_require)
 			    tryname += 2;
 			break;
 		    }
+		    else if (errno == EMFILE)
+			/* no point in trying other paths if out of handles */
+			break;
 		  }
 		}
 	    }
@@ -3358,14 +3376,13 @@ PP(pp_require)
     }
     else
         PL_compiling.cop_warnings = pWARN_STD ;
-    SAVESPTR(PL_compiling.cop_io);
-    PL_compiling.cop_io = NULL;
 
-    if (filter_sub) {
+    if (filter_sub || filter_cache) {
 	SV * const datasv = filter_add(S_run_user_filter, NULL);
 	IoLINES(datasv) = filter_has_file;
 	IoTOP_GV(datasv) = (GV *)filter_state;
 	IoBOTTOM_GV(datasv) = (GV *)filter_sub;
+	IoFMT_GV(datasv) = (GV *)filter_cache;
     }
 
     /* switch to eval mode */
@@ -3405,6 +3422,10 @@ PP(pp_entereval)
     CV* runcv;
     U32 seq;
     HV *saved_hh = NULL;
+    const char * const fakestr = "_<(eval )";
+#ifdef HAS_STRLCPY
+    const int fakelen = 9 + 1;
+#endif
     
     if (PL_op->op_private & OPpEVAL_HAS_HH) {
 	saved_hh = (HV*) SvREFCNT_inc(POPs);
@@ -3430,7 +3451,7 @@ PP(pp_entereval)
 	len = SvCUR(temp_sv);
     }
     else
-	len = my_sprintf(tmpbuf, "_<(eval %lu)", (unsigned long)++PL_evalseq);
+	len = my_snprintf(tmpbuf, sizeof(tbuf), "_<(eval %lu)", (unsigned long)++PL_evalseq);
     SAVECOPFILE_FREE(&PL_compiling);
     CopFILE_set(&PL_compiling, tmpbuf+2);
     SAVECOPLINE(&PL_compiling);
@@ -3448,20 +3469,13 @@ PP(pp_entereval)
 	GvHV(PL_hintgv) = saved_hh;
     SAVECOMPILEWARNINGS();
     PL_compiling.cop_warnings = DUP_WARNINGS(PL_curcop->cop_warnings);
-    SAVESPTR(PL_compiling.cop_io);
-    if (specialCopIO(PL_curcop->cop_io))
-        PL_compiling.cop_io = PL_curcop->cop_io;
-    else {
-        PL_compiling.cop_io = newSVsv(PL_curcop->cop_io);
-        SAVEFREESV(PL_compiling.cop_io);
+    if (PL_compiling.cop_hints_hash) {
+	Perl_refcounted_he_free(aTHX_ PL_compiling.cop_hints_hash);
     }
-    if (PL_compiling.cop_hints) {
-	Perl_refcounted_he_free(aTHX_ PL_compiling.cop_hints);
-    }
-    PL_compiling.cop_hints = PL_curcop->cop_hints;
-    if (PL_compiling.cop_hints) {
+    PL_compiling.cop_hints_hash = PL_curcop->cop_hints_hash;
+    if (PL_compiling.cop_hints_hash) {
 	HINTS_REFCNT_LOCK;
-	PL_compiling.cop_hints->refcounted_he_refcnt++;
+	PL_compiling.cop_hints_hash->refcounted_he_refcnt++;
 	HINTS_REFCNT_UNLOCK;
     }
     /* special case: an eval '' executed within the DB package gets lexically
@@ -3483,7 +3497,12 @@ PP(pp_entereval)
     ret = doeval(gimme, NULL, runcv, seq);
     if (PERLDB_INTER && was != (I32)PL_sub_generation /* Some subs defined here. */
 	&& ret != PL_op->op_next) {	/* Successive compilation. */
-	strcpy(safestr, "_<(eval )");	/* Anything fake and short. */
+	/* Copy in anything fake and short. */
+#ifdef HAS_STRLCPY
+	strlcpy(safestr, fakestr, fakelen);
+#else
+	strcpy(safestr, fakestr);
+#endif /* #ifdef HAS_STRLCPY */
     }
     return DOCATCH(ret);
 }
@@ -3544,7 +3563,7 @@ PP(pp_leaveeval)
 	/* Unassume the success we assumed earlier. */
 	SV * const nsv = cx->blk_eval.old_namesv;
 	(void)hv_delete(GvHVn(PL_incgv), SvPVX_const(nsv), SvCUR(nsv), G_DISCARD);
-	retop = Perl_die(aTHX_ "%"SVf" did not return a true value", nsv);
+	retop = Perl_die(aTHX_ "%"SVf" did not return a true value", (void*)nsv);
 	/* die_where() did LEAVE, or we won't be here */
     }
     else {
@@ -3605,7 +3624,7 @@ Perl_create_eval_scope(pTHX_ U32 flags)
 PP(pp_entertry)
 {
     dVAR;
-    PERL_CONTEXT *cx = create_eval_scope(0);
+    PERL_CONTEXT * const cx = create_eval_scope(0);
     cx->blk_eval.retop = cLOGOP->op_other->op_next;
     return DOCATCH(PL_op->op_next);
 }
@@ -3875,7 +3894,7 @@ S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other)
 	if (c == 0)
 	    PUSHs(&PL_sv_no);
 	else if (SvTEMP(TOPs))
-	    SvREFCNT_inc(TOPs);
+	    SvREFCNT_inc_void(TOPs);
 	FREETMPS;
 	LEAVE;
 	RETURN;
@@ -4116,7 +4135,7 @@ S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other)
 	if (c == 0)
 	    PUSHs(&PL_sv_undef);
 	else if (SvTEMP(TOPs))
-	    SvREFCNT_inc(TOPs);
+	    SvREFCNT_inc_void(TOPs);
 
 	if (SM_OTHER_REF(PVCV)) {
 	    /* This one has to be null-proto'd too.
@@ -4127,7 +4146,7 @@ S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other)
 	    if (c == 0)
 		PUSHs(&PL_sv_undef);
 	    else if (SvTEMP(TOPs))
-		SvREFCNT_inc(TOPs);
+		SvREFCNT_inc_void(TOPs);
 	    FREETMPS;
 	    LEAVE;
 	    PUTBACK;
@@ -4519,19 +4538,16 @@ S_run_user_filter(pTHX_ int idx, SV *buf_sv, int maxlen)
     SV * const filter_state = (SV *)IoTOP_GV(datasv);
     SV * const filter_sub = (SV *)IoBOTTOM_GV(datasv);
     int status = 0;
-    /* Filter API says that the filter appends to the contents of the buffer.
-       Usually the buffer is "", so the details don't matter. But if it's not,
-       then clearly what it contains is already filtered by this filter, so we
-       don't want to pass it in a second time.
-       I'm going to use a mortal in case the upstream filter croaks.  */
-    SV *const upstream
-	= ((SvOK(buf_sv) && sv_len(buf_sv)) || SvGMAGICAL(buf_sv))
-	? sv_newmortal() : buf_sv;
+    SV *upstream;
     STRLEN got_len;
-    const char *got_p;
+    const char *got_p = NULL;
     const char *prune_from = NULL;
+    bool read_from_cache = FALSE;
+    STRLEN umaxlen;
+
+    assert(maxlen >= 0);
+    umaxlen = maxlen;
 
-    SvUPGRADE(upstream, SVt_PV);
     /* I was having segfault trouble under Linux 2.2.5 after a
        parse error occured.  (Had to hack around it with a test
        for PL_error_count == 0.)  Solaris doesn't segfault --
@@ -4544,13 +4560,13 @@ S_run_user_filter(pTHX_ int idx, SV *buf_sv, int maxlen)
 	    const char *cache_p = SvPV(cache, cache_len);
 	    STRLEN take = 0;
 
-	    if (maxlen) {
+	    if (umaxlen) {
 		/* Running in block mode and we have some cached data already.
 		 */
-		if (cache_len >= maxlen) {
+		if (cache_len >= umaxlen) {
 		    /* In fact, so much data we don't even need to call
 		       filter_read.  */
-		    take = maxlen;
+		    take = umaxlen;
 		}
 	    } else {
 		const char *const first_nl = memchr(cache_p, '\n', cache_len);
@@ -4566,15 +4582,25 @@ S_run_user_filter(pTHX_ int idx, SV *buf_sv, int maxlen)
 	    }
 
 	    sv_catsv(buf_sv, cache);
-	    if (maxlen) {
-		maxlen -= cache_len;
+	    if (umaxlen) {
+		umaxlen -= cache_len;
 	    }
 	    SvOK_off(cache);
+	    read_from_cache = TRUE;
 	}
     }
+
+    /* Filter API says that the filter appends to the contents of the buffer.
+       Usually the buffer is "", so the details don't matter. But if it's not,
+       then clearly what it contains is already filtered by this filter, so we
+       don't want to pass it in a second time.
+       I'm going to use a mortal in case the upstream filter croaks.  */
+    upstream = ((SvOK(buf_sv) && sv_len(buf_sv)) || SvGMAGICAL(buf_sv))
+	? sv_newmortal() : buf_sv;
+    SvUPGRADE(upstream, SVt_PV);
 	
     if (filter_has_file) {
-	status = FILTER_READ(idx+1, upstream, maxlen);
+	status = FILTER_READ(idx+1, upstream, 0);
     }
 
     if (filter_sub && status >= 0) {
@@ -4588,7 +4614,7 @@ S_run_user_filter(pTHX_ int idx, SV *buf_sv, int maxlen)
 
 	DEFSV = upstream;
 	PUSHMARK(SP);
-	PUSHs(sv_2mortal(newSViv(maxlen)));
+	PUSHs(sv_2mortal(newSViv(0)));
 	if (filter_state) {
 	    PUSHs(filter_state);
 	}
@@ -4610,9 +4636,9 @@ S_run_user_filter(pTHX_ int idx, SV *buf_sv, int maxlen)
 
     if(SvOK(upstream)) {
 	got_p = SvPV(upstream, got_len);
-	if (maxlen) {
-	    if (got_len > maxlen) {
-		prune_from = got_p + maxlen;
+	if (umaxlen) {
+	    if (got_len > umaxlen) {
+		prune_from = got_p + umaxlen;
 	    }
 	} else {
 	    const char *const first_nl = memchr(got_p, '\n', got_len);
@@ -4628,7 +4654,7 @@ S_run_user_filter(pTHX_ int idx, SV *buf_sv, int maxlen)
 	SV *cache = (SV *)IoFMT_GV(datasv);
 
 	if (!cache) {
-	    IoFMT_GV(datasv) = (GV*) (cache = newSV(got_len - maxlen));
+	    IoFMT_GV(datasv) = (GV*) (cache = newSV(got_len - umaxlen));
 	} else if (SvOK(cache)) {
 	    /* Cache should be empty.  */
 	    assert(!SvCUR(cache));
@@ -4648,7 +4674,11 @@ S_run_user_filter(pTHX_ int idx, SV *buf_sv, int maxlen)
 	    status = 1;
     }
 
-    if (upstream != buf_sv) {
+    /* If they are at EOF but buf_sv has something in it, then they may never
+       have touched the SV upstream, so it may be undefined.  If we naively
+       concatenate it then we get a warning about use of uninitialised value.
+    */
+    if (upstream != buf_sv && (SvOK(upstream) || SvGMAGICAL(upstream))) {
 	sv_catsv(buf_sv, upstream);
     }
 
@@ -4665,6 +4695,12 @@ S_run_user_filter(pTHX_ int idx, SV *buf_sv, int maxlen)
 	}
 	filter_del(S_run_user_filter);
     }
+    if (status == 0 && read_from_cache) {
+	/* If we read some data from the cache (and by getting here it implies
+	   that we emptied the cache) then we aren't yet at EOF, and mustn't
+	   report that to our caller.  */
+	return 1;
+    }
     return status;
 }