move PL_error_count into the PL_parser struct
Dave Mitchell [Mon, 21 May 2007 22:35:15 +0000 (22:35 +0000)]
p4raw-id: //depot/perl@31255

embedvar.h
intrpvar.h
op.c
parser.h
perl.c
perlapi.h
pp_ctl.c
sv.c
toke.c

index b02de5e..acad545 100644 (file)
 #define PL_endav               (vTHX->Iendav)
 #define PL_envgv               (vTHX->Ienvgv)
 #define PL_errgv               (vTHX->Ierrgv)
-#define PL_error_count         (vTHX->Ierror_count)
 #define PL_errors              (vTHX->Ierrors)
 #define PL_euid                        (vTHX->Ieuid)
 #define PL_eval_root           (vTHX->Ieval_root)
 #define PL_Iendav              PL_endav
 #define PL_Ienvgv              PL_envgv
 #define PL_Ierrgv              PL_errgv
-#define PL_Ierror_count                PL_error_count
 #define PL_Ierrors             PL_errors
 #define PL_Ieuid               PL_euid
 #define PL_Ieval_root          PL_eval_root
index 20e1c97..0f72441 100644 (file)
@@ -357,7 +357,6 @@ PERLVAR(Imess_sv,   SV *)
 PERLVAR(Iors_sv,       SV *)           /* output record separator $\ */
 /* statics moved here for shared library purposes */
 PERLVARI(Igensym,      I32,    0)      /* next symbol for getsym() to define */
-PERLVAR(Ierror_count,  U8)             /* how many errors so far, max 10 */
 PERLVARI(Icv_has_eval, bool, FALSE) /* PL_compcv includes an entereval or similar */
 PERLVARI(Ilaststype,   U16,    OP_STAT)
 PERLVARI(Ilaststatval, int,    -1)
diff --git a/op.c b/op.c
index 5445e31..2269f7e 100644 (file)
--- a/op.c
+++ b/op.c
@@ -799,7 +799,8 @@ Perl_scalar(pTHX_ OP *o)
     OP *kid;
 
     /* assumes no premature commitment */
-    if (!o || PL_error_count || (o->op_flags & OPf_WANT)
+    if (!o || (PL_parser && PL_parser->error_count)
+        || (o->op_flags & OPf_WANT)
         || o->op_type == OP_RETURN)
     {
        return o;
@@ -897,7 +898,8 @@ Perl_scalarvoid(pTHX_ OP *o)
 
     /* assumes no premature commitment */
     want = o->op_flags & OPf_WANT;
-    if ((want && want != OPf_WANT_SCALAR) || PL_error_count
+    if ((want && want != OPf_WANT_SCALAR)
+        || (PL_parser && PL_parser->error_count)
         || o->op_type == OP_RETURN)
     {
        return o;
@@ -1142,7 +1144,8 @@ Perl_list(pTHX_ OP *o)
     OP *kid;
 
     /* assumes no premature commitment */
-    if (!o || (o->op_flags & OPf_WANT) || PL_error_count
+    if (!o || (o->op_flags & OPf_WANT)
+        || (PL_parser && PL_parser->error_count)
         || o->op_type == OP_RETURN)
     {
        return o;
@@ -1268,7 +1271,7 @@ Perl_mod(pTHX_ OP *o, I32 type)
     /* -1 = error on localize, 0 = ignore localize, 1 = ok to localize */
     int localize = -1;
 
-    if (!o || PL_error_count)
+    if (!o || (PL_parser && PL_parser->error_count))
        return o;
 
     if ((o->op_private & OPpTARGET_MY)
@@ -1697,7 +1700,7 @@ Perl_doref(pTHX_ OP *o, I32 type, bool set_op_ref)
     dVAR;
     OP *kid;
 
-    if (!o || PL_error_count)
+    if (!o || (PL_parser && PL_parser->error_count))
        return o;
 
     switch (o->op_type) {
@@ -1945,7 +1948,7 @@ S_my_kid(pTHX_ OP *o, OP *attrs, OP **imopsp)
     dVAR;
     I32 type;
 
-    if (!o || PL_error_count)
+    if (!o || (PL_parser && PL_parser->error_count))
        return o;
 
     type = o->op_type;
@@ -2373,7 +2376,7 @@ Perl_fold_constants(pTHX_ register OP *o)
            goto nope;
     }
 
-    if (PL_error_count)
+    if (PL_parser && PL_parser->error_count)
        goto nope;              /* Don't try to run w/ errors */
 
     for (curop = LINKLIST(o); curop != o; curop = LINKLIST(curop)) {
@@ -2459,7 +2462,7 @@ Perl_gen_constant_list(pTHX_ register OP *o)
     const I32 oldtmps_floor = PL_tmps_floor;
 
     list(o);
-    if (PL_error_count)
+    if (PL_parser && PL_parser->error_count)
        return o;               /* Don't attempt to run with errors */
 
     PL_op = curop = LINKLIST(o);
@@ -5455,7 +5458,7 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
     if (ps)
        sv_setpvn((SV*)cv, ps, ps_len);
 
-    if (PL_error_count) {
+    if (PL_parser && PL_parser->error_count) {
        op_free(block);
        block = NULL;
        if (name) {
@@ -5540,7 +5543,7 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
            }
        }
 
-       if (name && !PL_error_count)
+       if (name && ! (PL_parser && PL_parser->error_count))
            process_special_blocks(name, gv, cv);
     }
 
@@ -6243,7 +6246,8 @@ Perl_ck_exists(pTHX_ OP *o)
        OP * const kid = cUNOPo->op_first;
        if (kid->op_type == OP_ENTERSUB) {
            (void) ref(kid, o->op_type);
-           if (kid->op_type != OP_RV2CV && !PL_error_count)
+           if (kid->op_type != OP_RV2CV
+                       && !(PL_parser && PL_parser->error_count))
                Perl_croak(aTHX_ "%s argument is not a subroutine name",
                            OP_DESC(o));
            o->op_private |= OPpEXISTS_SUB;
@@ -6759,7 +6763,7 @@ Perl_ck_grep(pTHX_ OP *o)
     PADOFFSET offset;
 
     o->op_ppaddr = PL_ppaddr[OP_GREPSTART];
-    /* don't allocate gwop here, as we may leak it if PL_error_count > 0 */
+    /* don't allocate gwop here, as we may leak it if PL_parser->error_count > 0 */
 
     if (o->op_flags & OPf_STACKED) {
        OP* k;
@@ -6780,7 +6784,7 @@ Perl_ck_grep(pTHX_ OP *o)
     else
        scalar(kid);
     o = ck_fun(o);
-    if (PL_error_count)
+    if (PL_parser && PL_parser->error_count)
        return o;
     kid = cLISTOPo->op_first->op_sibling;
     if (kid->op_type != OP_NULL)
index 7e42c80..f62ac3d 100644 (file)
--- a/parser.h
+++ b/parser.h
@@ -77,6 +77,7 @@ typedef struct yy_parser {
     HV         *in_my_stash;   /* declared class of this "my" declaration */
     PerlIO     *rsfp;          /* current source file pointer */
     AV         *rsfp_filters;  /* holds chain of active source filters */
+    U8         error_count;    /* how many compile errors so far, max 10 */
 
 #ifdef PERL_MAD
     SV         *endwhite;
diff --git a/perl.c b/perl.c
index 9234ce6..c62722a 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -2267,9 +2267,8 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
     /* now parse the script */
 
     SETERRNO(0,SS_NORMAL);
-    PL_error_count = 0;
 #ifdef MACOS_TRADITIONAL
-    if (gMacPerl_SyntaxError = (yyparse() || PL_error_count)) {
+    if (gMacPerl_SyntaxError = (yyparse() || PL_parser->error_count)) {
        if (PL_minus_c)
            Perl_croak(aTHX_ "%s had compilation errors.\n", MacPerl_MPWFileName(PL_origfilename));
        else {
@@ -2278,7 +2277,7 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
        }
     }
 #else
-    if (yyparse() || PL_error_count) {
+    if (yyparse() || PL_parser->error_count) {
        if (PL_minus_c)
            Perl_croak(aTHX_ "%s had compilation errors.\n", PL_origfilename);
        else {
index 4585f5e..72073b0 100644 (file)
--- a/perlapi.h
+++ b/perlapi.h
@@ -302,8 +302,6 @@ END_EXTERN_C
 #define PL_envgv               (*Perl_Ienvgv_ptr(aTHX))
 #undef  PL_errgv
 #define PL_errgv               (*Perl_Ierrgv_ptr(aTHX))
-#undef  PL_error_count
-#define PL_error_count         (*Perl_Ierror_count_ptr(aTHX))
 #undef  PL_errors
 #define PL_errors              (*Perl_Ierrors_ptr(aTHX))
 #undef  PL_euid
index 032ffaa..c6ee3f7 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -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 *
@@ -2908,7 +2909,6 @@ S_doeval(pTHX_ int gimme, OP** startop, CV* outside, U32 seq)
     SAVESPTR(PL_unitcheckav);
     PL_unitcheckav = newAV();
     SAVEFREESV(PL_unitcheckav);
-    SAVEI8(PL_error_count);
 
 #ifdef PERL_MAD
     SAVEBOOL(PL_madskills);
@@ -2918,14 +2918,13 @@ S_doeval(pTHX_ int gimme, OP** startop, CV* outside, U32 seq)
     /* 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. */
@@ -4516,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)) {
diff --git a/sv.c b/sv.c
index d1d6702..0cd9ca8 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -9586,6 +9586,7 @@ Perl_parser_dup(pTHX_ const yy_parser *proto, CLONE_PARAMS* param)
     parser->rsfp_filters= av_dup_inc(proto->rsfp_filters, param);
     parser->in_my      = proto->in_my;
     parser->in_my_stash        = hv_dup(proto->in_my_stash, param);
+    parser->error_count        = proto->error_count;
 
 
     parser->linestr    = sv_dup_inc(proto->linestr, param);
@@ -11267,7 +11268,6 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
 
     PL_parser          = parser_dup(proto_perl->Iparser, param);
 
-    PL_error_count     = proto_perl->Ierror_count;
     PL_subline         = proto_perl->Isubline;
     PL_subname         = sv_dup_inc(proto_perl->Isubname, param);
 
diff --git a/toke.c b/toke.c
index f59372b..6959773 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -67,6 +67,7 @@
 #define PL_in_my_stash         (PL_parser->in_my_stash)
 #define PL_tokenbuf            (PL_parser->tokenbuf)
 #define PL_multi_end           (PL_parser->multi_end)
+#define PL_error_count         (PL_parser->error_count)
 
 #ifdef PERL_MAD
 #  define PL_endwhite          (PL_parser->endwhite)