This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Less sed'ing in Cygwin Makefile.SHs
[perl5.git] / pp_ctl.c
index 7fd8145..c6ee3f7 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -125,7 +125,7 @@ PP(pp_regcomp)
     }
     else {
        STRLEN len;
-       const char *t = SvPV_const(tmpstr, len);
+       const char *t = SvOK(tmpstr) ? SvPV_const(tmpstr, len) : "";
        re = PM_GETRE(pm);
 
        /* Check against the last compiled regexp. */
@@ -150,10 +150,10 @@ PP(pp_regcomp)
            if (DO_UTF8(tmpstr))
                pm_flags |= RXf_UTF8;
 
-           if (eng) 
-               PM_SETRE(pm, CALLREGCOMP_ENG(eng,(char *)t, (char *)t + len, pm_flags));
-            else
-                PM_SETRE(pm, CALLREGCOMP((char *)t, (char *)t + len, pm_flags));
+               if (eng) 
+               PM_SETRE(pm, CALLREGCOMP_ENG(eng, tmpstr, pm_flags));
+               else
+               PM_SETRE(pm, CALLREGCOMP(tmpstr, pm_flags));
 
            PL_reginterp_cnt = 0;       /* XXXX Be extra paranoid - needed
                                           inside tie/overload accessors.  */
@@ -302,7 +302,7 @@ PP(pp_substcont)
        (void)ReREFCNT_inc(rx);
     cx->sb_rxtainted |= RX_MATCH_TAINTED(rx);
     rxres_save(&cx->sb_rxres, rx);
-    RETURNOP(pm->op_pmreplstart);
+    RETURNOP(pm->op_pmstashstartu.op_pmreplstart);
 }
 
 void
@@ -1459,7 +1459,8 @@ Perl_qerror(pTHX_ SV *err)
        sv_catsv(PL_errors, err);
     else
        Perl_warn(aTHX_ "%"SVf, SVfARG(err));
-    ++PL_error_count;
+    if (PL_parser)
+       ++PL_parser->error_count;
 }
 
 OP *
@@ -2745,7 +2746,7 @@ Perl_sv_compile_2op(pTHX_ SV *sv, OP** startop, const char *code, PAD** padp)
     STRLEN len;
 
     ENTER;
-    lex_start(sv);
+    lex_start(sv, NULL, FALSE);
     SAVETMPS;
     /* switch to eval mode */
 
@@ -2908,24 +2909,22 @@ S_doeval(pTHX_ int gimme, OP** startop, CV* outside, U32 seq)
     SAVESPTR(PL_unitcheckav);
     PL_unitcheckav = newAV();
     SAVEFREESV(PL_unitcheckav);
-    SAVEI32(PL_error_count);
 
 #ifdef PERL_MAD
-    SAVEI32(PL_madskills);
+    SAVEBOOL(PL_madskills);
     PL_madskills = 0;
 #endif
 
     /* try to compile it */
 
     PL_eval_root = NULL;
-    PL_error_count = 0;
     PL_curcop = &PL_compiling;
     CopARYBASE_set(PL_curcop, 0);
     if (saveop && (saveop->op_type != OP_REQUIRE) && (saveop->op_flags & OPf_SPECIAL))
        PL_in_eval |= EVAL_KEEPERR;
     else
        sv_setpvn(ERRSV,"",0);
-    if (yyparse() || PL_error_count || !PL_eval_root) {
+    if (yyparse() || PL_parser->error_count || !PL_eval_root) {
        SV **newsp;                     /* Used by POPBLOCK. */
        PERL_CONTEXT *cx = &cxstack[cxstack_ix];
        I32 optype = 0;                 /* Might be reset by POPEVAL. */
@@ -3009,7 +3008,7 @@ S_doeval(pTHX_ int gimme, OP** startop, CV* outside, U32 seq)
     CvDEPTH(PL_compcv) = 1;
     SP = PL_stack_base + POPMARK;              /* pop original mark */
     PL_op = saveop;                    /* The caller may need it. */
-    PL_lex_state = LEX_NOTPARSING;     /* $^S needs this. */
+    PL_parser->lex_state = LEX_NOTPARSING;     /* $^S needs this. */
 
     RETURNOP(PL_eval_start);
 }
@@ -3276,7 +3275,7 @@ PP(pp_require)
                        || (*name == ':' && name[1] != ':' && strchr(name+2, ':'))
 #endif
                  ) {
-                   const char *dir = SvPVx_nolen_const(dirsv);
+                   const char *dir = SvPV_nolen_const(dirsv);
 #ifdef MACOS_TRADITIONAL
                    char buf1[256];
                    char buf2[256];
@@ -3377,11 +3376,8 @@ PP(pp_require)
 
     ENTER;
     SAVETMPS;
-    lex_start(NULL);
-    SAVEGENERICSV(PL_rsfp_filters);
-    PL_rsfp_filters = NULL;
+    lex_start(NULL, tryrsfp, TRUE);
 
-    PL_rsfp = tryrsfp;
     SAVEHINTS();
     PL_hints = 0;
     SAVECOMPILEWARNINGS();
@@ -3449,7 +3445,7 @@ PP(pp_entereval)
     TAINT_PROPER("eval");
 
     ENTER;
-    lex_start(sv);
+    lex_start(sv, NULL, FALSE);
     SAVETMPS;
 
     /* switch to eval mode */
@@ -3504,7 +3500,7 @@ PP(pp_entereval)
     /* prepare to compile string */
 
     if (PERLDB_LINE && PL_curstash != PL_debstash)
-       save_lines(CopFILEAV(&PL_compiling), PL_linestr);
+       save_lines(CopFILEAV(&PL_compiling), PL_parser->linestr);
     PUTBACK;
     ret = doeval(gimme, NULL, runcv, seq);
     if (PERLDB_INTER && was != (I32)PL_sub_generation /* Some subs defined here. */
@@ -3730,8 +3726,7 @@ PP(pp_leavegiven)
 }
 
 /* Helper routines used by pp_smartmatch */
-STATIC
-PMOP *
+STATIC PMOP *
 S_make_matcher(pTHX_ regexp *re)
 {
     dVAR;
@@ -3744,8 +3739,7 @@ S_make_matcher(pTHX_ regexp *re)
     return matcher;
 }
 
-STATIC
-bool
+STATIC bool
 S_matcher_matches_sv(pTHX_ PMOP *matcher, SV *sv)
 {
     dVAR;
@@ -3759,8 +3753,7 @@ S_matcher_matches_sv(pTHX_ PMOP *matcher, SV *sv)
     return (SvTRUEx(POPs));
 }
 
-STATIC
-void
+STATIC void
 S_destroy_matcher(pTHX_ PMOP *matcher)
 {
     dVAR;
@@ -3778,8 +3771,7 @@ PP(pp_smartmatch)
 /* This version of do_smartmatch() implements the
  * table of smart matches that is found in perlsyn.
  */
-STATIC
-OP *
+STATIC OP *
 S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other)
 {
     dVAR;
@@ -4523,7 +4515,7 @@ S_run_user_filter(pTHX_ int idx, SV *buf_sv, int maxlen)
 
     /* 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 --
+       for PL_parser->error_count == 0.)  Solaris doesn't segfault --
        not sure where the trouble is yet.  XXX */
 
     if (IoFMT_GV(datasv)) {