X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=pp_ctl.c;h=11b36134ff44dc4c27139438a0b61e30518987d2;hb=917211f59b1d5210f3944956e717bae1a2ca7565;hp=c60f7dc4ea317dc208aaf2fa89794cff9e9f7d05;hpb=d4a8e56c4dba2cdaeeea4c6a0c703df02a2c74b3;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/pp_ctl.c b/pp_ctl.c
index c60f7dc..11b3613 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -158,6 +158,7 @@ PP(pp_substcont)
     register REGEXP *rx = cx->sb_rx;
 
     rxres_restore(&cx->sb_rxres, rx);
+    PL_reg_match_utf8 = SvUTF8(cx->sb_targ) ? 1 : 0;
 
     if (cx->sb_iters++) {
 	I32 saviters = cx->sb_iters;
@@ -395,7 +396,7 @@ PP(pp_formline)
 	    else {
 		sv = &PL_sv_no;
 		if (ckWARN(WARN_SYNTAX))
-		    Perl_warner(aTHX_ WARN_SYNTAX, "Not enough format arguments");
+		    Perl_warner(aTHX_ packWARN(WARN_SYNTAX), "Not enough format arguments");
 	    }
 	    break;
 
@@ -895,13 +896,16 @@ PP(pp_flip)
     else {
 	dTOPss;
 	SV *targ = PAD_SV(PL_op->op_targ);
- 	int flip;
+ 	int flip = 0;
 
  	if (PL_op->op_private & OPpFLIP_LINENUM) {
- 	    struct io *gp_io;
- 	    flip = PL_last_in_gv
- 		&& (gp_io = GvIO(PL_last_in_gv))
- 		&& SvIV(sv) == (IV)IoLINES(gp_io);
+	    if (GvIO(PL_last_in_gv)) {
+		flip = SvIV(sv) == (IV)IoLINES(GvIOp(PL_last_in_gv));
+	    }
+	    else {
+		GV *gv = gv_fetchpv(".", TRUE, SVt_PV);
+		if (gv && GvSV(gv)) flip = SvIV(sv) == SvIV(GvSV(gv));
+	    }
  	} else {
  	    flip = SvTRUE(sv);
  	}
@@ -979,11 +983,23 @@ PP(pp_flop)
     else {
 	dTOPss;
 	SV *targ = PAD_SV(cUNOP->op_first->op_targ);
+	int flop = 0;
 	sv_inc(targ);
-	if ((PL_op->op_private & OPpFLIP_LINENUM)
-	  ? (GvIO(PL_last_in_gv)
-	     && SvIV(sv) == (IV)IoLINES(GvIOp(PL_last_in_gv)))
-	  : SvTRUE(sv) ) {
+
+	if (PL_op->op_private & OPpFLIP_LINENUM) {
+	    if (GvIO(PL_last_in_gv)) {
+		flop = SvIV(sv) == (IV)IoLINES(GvIOp(PL_last_in_gv));
+	    }
+	    else {
+		GV *gv = gv_fetchpv(".", TRUE, SVt_PV);
+		if (gv && GvSV(gv)) flop = SvIV(sv) == SvIV(GvSV(gv));
+	    }
+	}
+	else {
+	    flop = SvTRUE(sv);
+	}
+
+	if (flop) {
 	    sv_setiv(PAD_SV(((UNOP*)cUNOP->op_first)->op_first->op_targ), 0);
 	    sv_catpv(targ, "E0");
 	}
@@ -1006,27 +1022,27 @@ S_dopoptolabel(pTHX_ char *label)
 	switch (CxTYPE(cx)) {
 	case CXt_SUBST:
 	    if (ckWARN(WARN_EXITING))
-		Perl_warner(aTHX_ WARN_EXITING, "Exiting substitution via %s",
+		Perl_warner(aTHX_ packWARN(WARN_EXITING), "Exiting substitution via %s",
 			OP_NAME(PL_op));
 	    break;
 	case CXt_SUB:
 	    if (ckWARN(WARN_EXITING))
-		Perl_warner(aTHX_ WARN_EXITING, "Exiting subroutine via %s",
+		Perl_warner(aTHX_ packWARN(WARN_EXITING), "Exiting subroutine via %s",
 			OP_NAME(PL_op));
 	    break;
 	case CXt_FORMAT:
 	    if (ckWARN(WARN_EXITING))
-		Perl_warner(aTHX_ WARN_EXITING, "Exiting format via %s",
+		Perl_warner(aTHX_ packWARN(WARN_EXITING), "Exiting format via %s",
 			OP_NAME(PL_op));
 	    break;
 	case CXt_EVAL:
 	    if (ckWARN(WARN_EXITING))
-		Perl_warner(aTHX_ WARN_EXITING, "Exiting eval via %s",
+		Perl_warner(aTHX_ packWARN(WARN_EXITING), "Exiting eval via %s",
 			OP_NAME(PL_op));
 	    break;
 	case CXt_NULL:
 	    if (ckWARN(WARN_EXITING))
-		Perl_warner(aTHX_ WARN_EXITING, "Exiting pseudo-block via %s",
+		Perl_warner(aTHX_ packWARN(WARN_EXITING), "Exiting pseudo-block via %s",
 			OP_NAME(PL_op));
 	    return -1;
 	case CXt_LOOP:
@@ -1141,27 +1157,27 @@ S_dopoptoloop(pTHX_ I32 startingblock)
 	switch (CxTYPE(cx)) {
 	case CXt_SUBST:
 	    if (ckWARN(WARN_EXITING))
-		Perl_warner(aTHX_ WARN_EXITING, "Exiting substitution via %s",
+		Perl_warner(aTHX_ packWARN(WARN_EXITING), "Exiting substitution via %s",
 			OP_NAME(PL_op));
 	    break;
 	case CXt_SUB:
 	    if (ckWARN(WARN_EXITING))
-		Perl_warner(aTHX_ WARN_EXITING, "Exiting subroutine via %s",
+		Perl_warner(aTHX_ packWARN(WARN_EXITING), "Exiting subroutine via %s",
 			OP_NAME(PL_op));
 	    break;
 	case CXt_FORMAT:
 	    if (ckWARN(WARN_EXITING))
-		Perl_warner(aTHX_ WARN_EXITING, "Exiting format via %s",
+		Perl_warner(aTHX_ packWARN(WARN_EXITING), "Exiting format via %s",
 			OP_NAME(PL_op));
 	    break;
 	case CXt_EVAL:
 	    if (ckWARN(WARN_EXITING))
-		Perl_warner(aTHX_ WARN_EXITING, "Exiting eval via %s",
+		Perl_warner(aTHX_ packWARN(WARN_EXITING), "Exiting eval via %s",
 			OP_NAME(PL_op));
 	    break;
 	case CXt_NULL:
 	    if (ckWARN(WARN_EXITING))
-		Perl_warner(aTHX_ WARN_EXITING, "Exiting pseudo-block via %s",
+		Perl_warner(aTHX_ packWARN(WARN_EXITING), "Exiting pseudo-block via %s",
 			OP_NAME(PL_op));
 	    return -1;
 	case CXt_LOOP:
@@ -1252,7 +1268,7 @@ Perl_die_where(pTHX_ char *message, STRLEN msglen)
 		    sv_catpvn(err, message, msglen);
 		    if (ckWARN(WARN_MISC)) {
 			STRLEN start = SvCUR(err)-msglen-sizeof(prefix)+1;
-			Perl_warner(aTHX_ WARN_MISC, SvPVX(err)+start);
+			Perl_warner(aTHX_ packWARN(WARN_MISC), SvPVX(err)+start);
 		    }
 		}
 	    }
@@ -2897,7 +2913,7 @@ PP(pp_require)
 		    PERL_VERSION, PERL_SUBVERSION);
 	    }
 	    if (ckWARN(WARN_PORTABLE))
-		Perl_warner(aTHX_ WARN_PORTABLE,
+		Perl_warner(aTHX_ packWARN(WARN_PORTABLE),
                         "v-string in use/require non-portable");
 	    RETPUSHYES;
 	}