Not OK 13843

[perl5.git] / op.c

diff --git a/op.c b/op.c
index 5bd6448..e4f84fa 100644 (file)
--- 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 '*':