From: Dave Mitchell Date: Mon, 21 May 2007 22:35:15 +0000 (+0000) Subject: move PL_error_count into the PL_parser struct X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=13765c85de4dc05031cfb5d6273ea7e178b9807b;p=p5sagit%2Fp5-mst-13.2.git move PL_error_count into the PL_parser struct p4raw-id: //depot/perl@31255 --- diff --git a/embedvar.h b/embedvar.h index b02de5e..acad545 100644 --- a/embedvar.h +++ b/embedvar.h @@ -133,7 +133,6 @@ #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) @@ -453,7 +452,6 @@ #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 diff --git a/intrpvar.h b/intrpvar.h index 20e1c97..0f72441 100644 --- a/intrpvar.h +++ b/intrpvar.h @@ -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 --- 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) diff --git a/parser.h b/parser.h index 7e42c80..f62ac3d 100644 --- 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 --- 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 { diff --git a/perlapi.h b/perlapi.h index 4585f5e..72073b0 100644 --- 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 diff --git a/pp_ctl.c b/pp_ctl.c index 032ffaa..c6ee3f7 100644 --- 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 --- 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 --- 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)