X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=op.c;h=c97dacd5c38e5c726a21f8609ca7e64f01a7c472;hb=78d3e1bf81e401020937b98d17bdfe2107623029;hp=5bd644850751a73dafc8c2f8e8144a4d25e1a36d;hpb=c6b79628012c18b06d27164432d66e56c627b161;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/op.c b/op.c
index 5bd6448..c97dacd 100644
--- a/op.c
+++ b/op.c
@@ -15,6 +15,7 @@
  * either way, as the saying is, if you follow me."  --the Gaffer
  */
 
+
 #include "EXTERN.h"
 #define PERL_IN_OP_C
 #include "perl.h"
@@ -867,7 +868,7 @@ clear_pmop:
 	    SvREPADTMP_on(PL_regex_pad[(cPMOPo)->op_pmoffset]);
             PM_SETRE(cPMOPo, (cPMOPo)->op_pmoffset);
         }
-#endif 
+#endif
 
 	break;
     }
@@ -3089,7 +3090,7 @@ Perl_newPMOP(pTHX_ I32 type, I32 flags)
             pmop->op_pmoffset = SvIV(repointer);
 	    SvREPADTMP_off(repointer);
 	    sv_setiv(repointer,0);
-        } else { 
+        } else {
             repointer = newSViv(0);
             av_push(PL_regex_padav,SvREFCNT_inc(repointer));
             pmop->op_pmoffset = av_len(PL_regex_padav);
@@ -3097,7 +3098,7 @@ Perl_newPMOP(pTHX_ I32 type, I32 flags)
         }
     }
 #endif
-        
+
         /* link into pm list */
     if (type != OP_TRANS && PL_curstash) {
 	pmop->op_pmnext = HvPMROOT(PL_curstash);
@@ -3130,7 +3131,7 @@ Perl_pmruntime(pTHX_ OP *o, OP *expr, OP *repl)
 	    p = SvPV(pat, plen);
 	    pm->op_pmflags |= PMf_SKIPWHITE;
 	}
-        if (DO_UTF8(pat) || (PL_hints & HINT_UTF8))
+        if (DO_UTF8(pat))
 	    pm->op_pmdynflags |= PMdf_UTF8;
 	PM_SETRE(pm, CALLREGCOMP(aTHX_ p, p + plen, pm));
 	if (strEQ("\\s+", PM_GETRE(pm)->precomp))
@@ -3138,8 +3139,6 @@ Perl_pmruntime(pTHX_ OP *o, OP *expr, OP *repl)
 	op_free(expr);
     }
     else {
-        if (PL_hints & HINT_UTF8)
-	    pm->op_pmdynflags |= PMdf_UTF8;
 	if (pm->op_pmflags & PMf_KEEP || !(PL_hints & HINT_RE_EVAL))
 	    expr = newUNOP((!(PL_hints & HINT_RE_EVAL)
 			    ? OP_REGCRESET
@@ -3453,6 +3452,8 @@ Perl_utilize(pTHX_ int aver, I32 floor, OP *version, OP *id, OP *arg)
 }
 
 /*
+=head1 Embedding Functions
+
 =for apidoc load_module
 
 Loads the module whose name is pointed to by the string part of name.
@@ -3804,10 +3805,10 @@ Perl_newSTATEOP(pTHX_ I32 flags, char *label, OP *o)
 
     if (PERLDB_LINE && PL_curstash != PL_debstash) {
 	SV **svp = av_fetch(CopFILEAV(PL_curcop), (I32)CopLINE(cop), FALSE);
-        if (svp && *svp != &PL_sv_undef ) { 
+        if (svp && *svp != &PL_sv_undef ) {
            (void)SvIOK_on(*svp);
 	    SvIVX(*svp) = PTR2IV(cop);
-	} 
+	}
     }
 
     return prepend_elem(OP_LINESEQ, (OP*)cop, o);
@@ -4632,6 +4633,9 @@ Perl_cv_ckproto(pTHX_ CV *cv, GV *gv, char *p)
 static void const_sv_xsub(pTHX_ CV* cv);
 
 /*
+
+=head1 Optree Manipulation Functions
+
 =for apidoc cv_const_sv
 
 If C<cv> is a constant sub eligible for inlining. returns the constant
@@ -5877,7 +5881,7 @@ Perl_ck_fun(pTHX_ OP *o)
 		    Perl_warner(aTHX_ WARN_SYNTAX,
 			"Useless use of %s with no values",
 			PL_op_desc[type]);
-		    
+		
 		if (kid->op_type == OP_CONST &&
 		    (kid->op_private & OPpCONST_BARE))
 		{
@@ -5929,8 +5933,6 @@ Perl_ck_fun(pTHX_ OP *o)
 		}
 		break;
 	    case OA_FILEREF:
-                       if(kid==cLISTOPo->op_last)
-                           cLISTOPo->op_last = newop;
 		if (kid->op_type != OP_GV && kid->op_type != OP_RV2GV) {
 		    if (kid->op_type == OP_CONST &&
 			(kid->op_private & OPpCONST_BARE))
@@ -5938,6 +5940,8 @@ Perl_ck_fun(pTHX_ OP *o)
 			OP *newop = newGVOP(OP_GV, 0,
 			    gv_fetchpv(SvPVx(((SVOP*)kid)->op_sv, n_a), TRUE,
 					SVt_PVIO) );
+			if (kid == cLISTOPo->op_last)
+			    cLISTOPo->op_last = newop;
 			op_free(kid);
 			kid = newop;
 		    }
@@ -6781,9 +6785,16 @@ Perl_ck_subr(pTHX_ OP *o)
 		     goto again;
 		     break;
 		case ']':
-		     if (contextclass)
-			  contextclass = 0;
-		     else
+		     if (contextclass) {
+			 char *p = proto;
+			 char s = *p;
+			 contextclass = 0;
+			 *p = '\0';
+			 while (*--p != '[');
+			 bad_type(arg, Perl_form(aTHX_ "one of %s", p),
+				 gv_ename(namegv), o2);
+			 *proto = s;
+		     } else
 			  goto oops;
 		     break;
 		case '*':
@@ -7024,7 +7035,7 @@ Perl_peep(pTHX_ register OP *o)
 	    else if (o->op_next->op_type == OP_RV2AV) {
 		OP* pop = o->op_next->op_next;
 		IV i;
-		if (pop->op_type == OP_CONST &&
+		if (pop && pop->op_type == OP_CONST &&
 		    (PL_op = pop->op_next) &&
 		    pop->op_next->op_type == OP_AELEM &&
 		    !(pop->op_next->op_private &