projects / p5sagit/p5-mst-13.2.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw
Given that @optype and @specialsv_name are hard coded tables, it seems
[p5sagit/p5-mst-13.2.git] / op.c
diff --git a/op.c b/op.c
index d623f2b..40b415d 100644 (file)
--- a/op.c
+++ b/op.c
@@ -782,8 +782,8 @@ S_scalarboolean(pTHX_ OP *o)
        if (ckWARN(WARN_SYNTAX)) {
            const line_t oldline = CopLINE(PL_curcop);
 
-           if (PL_copline != NOLINE)
-               CopLINE_set(PL_curcop, PL_copline);
+           if (PL_parser && PL_parser->copline != NOLINE)
+               CopLINE_set(PL_curcop, PL_parser->copline);
            Perl_warner(aTHX_ packWARN(WARN_SYNTAX), "Found = in conditional, should be ==");
            CopLINE_set(PL_curcop, oldline);
        }
@@ -1818,7 +1818,6 @@ S_apply_attrs(pTHX_ HV *stash, SV *target, OP *attrs, bool for_my)
 
     /* fake up C<use attributes $pkg,$rv,@attrs> */
     ENTER;             /* need to protect against side-effects of 'use' */
-    SAVEI8(PL_expect);
     stashsv = stash ? newSVhek(HvNAME_HEK(stash)) : &PL_sv_no;
 
 #define ATTRSMODULE "attributes"
@@ -2261,10 +2260,11 @@ Perl_localize(pTHX_ OP *o, I32 lex)
        NOOP;
 #endif
     else {
-       if ( PL_bufptr > PL_oldbufptr && PL_bufptr[-1] == ','
+       if ( PL_parser->bufptr > PL_parser->oldbufptr
+           && PL_parser->bufptr[-1] == ','
            && ckWARN(WARN_PARENTHESIS))
        {
-           char *s = PL_bufptr;
+           char *s = PL_parser->bufptr;
            bool sigil = FALSE;
 
            /* some heuristics to detect a potential error */
@@ -2818,7 +2818,7 @@ Perl_mad_free(pTHX_ MADPROP* mp)
        return;
     if (mp->mad_next)
        mad_free(mp->mad_next);
-/*    if (PL_lex_state != LEX_NOTPARSING && mp->mad_vlen)
+/*    if (PL_parser && PL_parser->lex_state != LEX_NOTPARSING && mp->mad_vlen)
        PerlIO_printf(PerlIO_stderr(), "DESTROYING '%c'=<%s>\n", mp->mad_key & 255, mp->mad_val); */
     switch (mp->mad_type) {
     case MAD_NULL:
@@ -3650,15 +3650,11 @@ Perl_package(pTHX_ OP *o)
 
     PL_curstash = gv_stashsv(sv, GV_ADD);
 
-    /* In case mg.c:Perl_magic_setisa faked
-       this package earlier, we clear the fake flag */
-    HvMROMETA(PL_curstash)->fake = 0;
-
     sv_setsv(PL_curstname, sv);
 
     PL_hints |= HINT_BLOCK_SCOPE;
-    PL_copline = NOLINE;
-    PL_expect = XSTATE;
+    PL_parser->copline = NOLINE;
+    PL_parser->expect = XSTATE;
 
 #ifndef PERL_MAD
     op_free(o);
@@ -3782,8 +3778,8 @@ Perl_utilize(pTHX_ int aver, I32 floor, OP *version, OP *idop, OP *arg)
      */
 
     PL_hints |= HINT_BLOCK_SCOPE;
-    PL_copline = NOLINE;
-    PL_expect = XSTATE;
+    PL_parser->copline = NOLINE;
+    PL_parser->expect = XSTATE;
     PL_cop_seqmax++; /* Purely for B::*'s benefit */
 
 #ifdef PERL_MAD
@@ -3861,17 +3857,19 @@ Perl_vload_module(pTHX_ U32 flags, SV *name, SV *ver, va_list *args)
            sv = va_arg(*args, SV*);
        }
     }
-    {
-       const line_t ocopline = PL_copline;
-       COP * const ocurcop = PL_curcop;
-       const U8 oexpect = PL_expect;
 
-       utilize(!(flags & PERL_LOADMOD_DENY), start_subparse(FALSE, 0),
-               veop, modname, imop);
-       PL_expect = oexpect;
-       PL_copline = ocopline;
-       PL_curcop = ocurcop;
-    }
+    /* utilize() fakes up a BEGIN { require ..; import ... }, so make sure
+     * that it has a PL_parser to play with while doing that, and also
+     * that it doesn't mess with any existing parser, by creating a tmp
+     * new parser with lex_start(). This won't actually be used for much,
+     * since pp_require() will create another parser for the real work. */
+
+    ENTER;
+    SAVEVPTR(PL_curcop);
+    lex_start(NULL);
+    utilize(!(flags & PERL_LOADMOD_DENY), start_subparse(FALSE, 0),
+           veop, modname, imop);
+    LEAVE;
 }
 
 OP *
@@ -4180,11 +4178,12 @@ Perl_newSTATEOP(pTHX_ I32 flags, char *label, OP *o)
        HINTS_REFCNT_UNLOCK;
     }
 
-    if (PL_copline == NOLINE)
+    if (PL_parser && PL_parser->copline == NOLINE)
         CopLINE_set(cop, CopLINE(PL_curcop));
     else {
-       CopLINE_set(cop, PL_copline);
-        PL_copline = NOLINE;
+       CopLINE_set(cop, PL_parser->copline);
+       if (PL_parser)
+           PL_parser->copline = NOLINE;
     }
 #ifdef USE_ITHREADS
     CopFILE_set(cop, CopFILE(PL_curcop));      /* XXX share in a pvtable? */
@@ -4330,7 +4329,7 @@ S_new_logop(pTHX_ I32 type, I32 flags, OP** firstp, OP** otherp)
        }
        if (warnop) {
            const line_t oldline = CopLINE(PL_curcop);
-           CopLINE_set(PL_curcop, PL_copline);
+           CopLINE_set(PL_curcop, PL_parser->copline);
            Perl_warner(aTHX_ packWARN(WARN_MISC),
                 "Value of %s%s can be \"0\"; test with defined()",
                 PL_op_desc[warnop],
@@ -4599,7 +4598,7 @@ whileline, OP *expr, OP *block, OP *cont, I32 has_my)
     redo = LINKLIST(listop);
 
     if (expr) {
-       PL_copline = (line_t)whileline;
+       PL_parser->copline = (line_t)whileline;
        scalar(listop);
        o = new_logop(OP_AND, 0, &expr, &listop);
        if (o == expr && o->op_type == OP_CONST && !SvTRUE(cSVOPo->op_sv)) {
@@ -4758,7 +4757,7 @@ Perl_newFOROP(pTHX_ I32 flags, char *label, line_t forline, OP *sv, OP *expr, OP
     wop = newWHILEOP(flags, 1, loop, forline, newOP(OP_ITER, 0), block, cont, 0);
     if (madsv)
        op_getmad(madsv, (OP*)loop, 'v');
-    PL_copline = forline;
+    PL_parser->copline = forline;
     return newSTATEOP(0, label, wop);
 }
 
@@ -5322,8 +5321,8 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
                        && (!const_sv || sv_cmp(cv_const_sv(cv), const_sv))))
                {
                    const line_t oldline = CopLINE(PL_curcop);
-                   if (PL_copline != NOLINE)
-                       CopLINE_set(PL_curcop, PL_copline);
+                   if (PL_parser && PL_parser->copline != NOLINE)
+                       CopLINE_set(PL_curcop, PL_parser->copline);
                    Perl_warner(aTHX_ packWARN(WARN_REDEFINE),
                        CvCONST(cv) ? "Constant subroutine %s redefined"
                                    : "Subroutine %s redefined", name);
@@ -5543,7 +5542,8 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
     }
 
   done:
-    PL_copline = NOLINE;
+    if (PL_parser)
+       PL_parser->copline = NOLINE;
     LEAVE_SCOPE(floor);
     return cv;
 }
@@ -5639,7 +5639,7 @@ Perl_newCONSTSUB(pTHX_ HV *stash, const char *name, SV *sv)
     ENTER;
 
     SAVECOPLINE(PL_curcop);
-    CopLINE_set(PL_curcop, PL_copline);
+    CopLINE_set(PL_curcop, PL_parser ? PL_parser->copline : NOLINE);
 
     SAVEHINTS();
     PL_hints &= ~HINT_BLOCK_SCOPE;
@@ -5752,8 +5752,8 @@ Perl_newXS(pTHX_ const char *name, XSUBADDR_t subaddr, const char *filename)
                        const char *redefined_name = HvNAME_get(stash);
                        if ( strEQ(redefined_name,"autouse") ) {
                            const line_t oldline = CopLINE(PL_curcop);
-                           if (PL_copline != NOLINE)
-                               CopLINE_set(PL_curcop, PL_copline);
+                           if (PL_parser && PL_parser->copline != NOLINE)
+                               CopLINE_set(PL_curcop, PL_parser->copline);
                            Perl_warner(aTHX_ packWARN(WARN_REDEFINE),
                                        CvCONST(cv) ? "Constant subroutine %s redefined"
                                                    : "Subroutine %s redefined"
@@ -5819,8 +5819,8 @@ Perl_newFORM(pTHX_ I32 floor, OP *o, OP *block)
     if ((cv = GvFORM(gv))) {
        if (ckWARN(WARN_REDEFINE)) {
            const line_t oldline = CopLINE(PL_curcop);
-           if (PL_copline != NOLINE)
-               CopLINE_set(PL_curcop, PL_copline);
+           if (PL_parser && PL_parser->copline != NOLINE)
+               CopLINE_set(PL_curcop, PL_parser->copline);
            Perl_warner(aTHX_ packWARN(WARN_REDEFINE),
                        o ? "Format %"SVf" redefined"
                        : "Format STDOUT redefined", SVfARG(cSVOPo->op_sv));
@@ -5847,7 +5847,8 @@ Perl_newFORM(pTHX_ I32 floor, OP *o, OP *block)
 #else
     op_free(o);
 #endif
-    PL_copline = NOLINE;
+    if (PL_parser)
+       PL_parser->copline = NOLINE;
     LEAVE_SCOPE(floor);
 #ifdef PERL_MAD
     return pegop;
Unnamed repository; edit this file to name it for gitweb.