diff options
| -rw-r--r-- | embedvar.h | 2 | ||||
| -rw-r--r-- | intrpvar.h | 1 | ||||
| -rw-r--r-- | parser.h | 1 | ||||
| -rw-r--r-- | perl.c | 33 | ||||
| -rw-r--r-- | sv.c | 1 | ||||
| -rw-r--r-- | toke.c | 14 |
6 files changed, 23 insertions, 29 deletions
diff --git a/embedvar.h b/embedvar.h index b7f245476e..262ddb0d3c 100644 --- a/embedvar.h +++ b/embedvar.h @@ -119,7 +119,6 @@ #define PL_destroyhook (vTHX->Idestroyhook) #define PL_diehook (vTHX->Idiehook) #define PL_dirty (vTHX->Idirty) -#define PL_doextract (vTHX->Idoextract) #define PL_doswitches (vTHX->Idoswitches) #define PL_dowarn (vTHX->Idowarn) #define PL_dumper_fd (vTHX->Idumper_fd) @@ -449,7 +448,6 @@ #define PL_Idestroyhook PL_destroyhook #define PL_Idiehook PL_diehook #define PL_Idirty PL_dirty -#define PL_Idoextract PL_doextract #define PL_Idoswitches PL_doswitches #define PL_Idowarn PL_dowarn #define PL_Idumper_fd PL_dumper_fd diff --git a/intrpvar.h b/intrpvar.h index 55e91f6437..c798285349 100644 --- a/intrpvar.h +++ b/intrpvar.h @@ -295,7 +295,6 @@ The C variable which corresponds to Perl's $^W warning variable. */ PERLVAR(Idowarn, U8) -PERLVAR(Idoextract, bool) PERLVAR(Isawampersand, bool) /* must save all match strings */ PERLVAR(Iunsafe, bool) PERLVAR(Iexit_flags, U8) /* was exit() unexpected, etc. */ @@ -105,6 +105,7 @@ typedef struct yy_parser { COP *saved_curcop; /* the previous PL_curcop */ char tokenbuf[256]; + bool in_pod; /* lexer is within a =pod section */ } yy_parser; /* flags for lexer API */ @@ -864,7 +864,6 @@ perl_destruct(pTHXx) PL_minus_F = FALSE; PL_doswitches = FALSE; PL_dowarn = G_WARN_OFF; - PL_doextract = FALSE; PL_sawampersand = FALSE; /* must save all match strings */ PL_unsafe = FALSE; @@ -1746,6 +1745,7 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit) const char *scriptname = NULL; VOL bool dosearch = FALSE; register char c; + bool doextract = FALSE; const char *cddir = NULL; #ifdef USE_SITECUSTOMIZE bool minus_f = FALSE; @@ -1874,7 +1874,7 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit) goto reswitch; } case 'x': - PL_doextract = TRUE; + doextract = TRUE; s++; if (*s) cddir = s; @@ -2018,7 +2018,7 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit) # endif #endif - if (PL_doextract) { + if (doextract) { /* This will croak if suidscript is true, as -x cannot be used with setuid scripts. */ @@ -3674,24 +3674,21 @@ S_find_beginning(pTHX_ SV* linestr_sv, PerlIO *rsfp) /* skip forward in input to the real script? */ - while (PL_doextract) { + do { if ((s = sv_gets(linestr_sv, rsfp, 0)) == NULL) Perl_croak(aTHX_ "No Perl script found in input\n"); s2 = s; - if (*s == '#' && s[1] == '!' && ((s = instr(s,"perl")) || (s = instr(s2,"PERL")))) { - PerlIO_ungetc(rsfp, '\n'); /* to keep line count right */ - PL_doextract = FALSE; - while (*s && !(isSPACE (*s) || *s == '#')) s++; - s2 = s; - while (*s == ' ' || *s == '\t') s++; - if (*s++ == '-') { - while (isDIGIT(s2[-1]) || s2[-1] == '-' || s2[-1] == '.' - || s2[-1] == '_') s2--; - if (strnEQ(s2-4,"perl",4)) - while ((s = moreswitches(s))) - ; - } - } + } while (!(*s == '#' && s[1] == '!' && ((s = instr(s,"perl")) || (s = instr(s2,"PERL"))))); + PerlIO_ungetc(rsfp, '\n'); /* to keep line count right */ + while (*s && !(isSPACE (*s) || *s == '#')) s++; + s2 = s; + while (*s == ' ' || *s == '\t') s++; + if (*s++ == '-') { + while (isDIGIT(s2[-1]) || s2[-1] == '-' || s2[-1] == '.' + || s2[-1] == '_') s2--; + if (strnEQ(s2-4,"perl",4)) + while ((s = moreswitches(s))) + ; } } @@ -12645,7 +12645,6 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags, PL_minus_F = proto_perl->Iminus_F; PL_doswitches = proto_perl->Idoswitches; PL_dowarn = proto_perl->Idowarn; - PL_doextract = proto_perl->Idoextract; PL_sawampersand = proto_perl->Isawampersand; PL_unsafe = proto_perl->Iunsafe; PL_inplace = SAVEPV(proto_perl->Iinplace); @@ -720,6 +720,8 @@ Perl_lex_start(pTHX_ SV *line, PerlIO *rsfp) parser->linestart = SvPVX(parser->linestr); parser->bufend = parser->bufptr + SvCUR(parser->linestr); parser->last_lop = parser->last_uni = NULL; + + parser->in_pod = 0; } @@ -756,8 +758,6 @@ Perl_parser_free(pTHX_ const yy_parser *parser) void Perl_lex_end(pTHX) { - dVAR; - PL_doextract = FALSE; } /* @@ -1267,7 +1267,7 @@ Perl_lex_next_chunk(pTHX_ U32 flags) else if (PL_parser->rsfp) (void)PerlIO_close(PL_parser->rsfp); PL_parser->rsfp = NULL; - PL_doextract = FALSE; + PL_parser->in_pod = 0; #ifdef PERL_MAD if (PL_madskills && !PL_in_eval && (PL_minus_p || PL_minus_n)) PL_faketokens = 1; @@ -4693,7 +4693,7 @@ Perl_yylex(pTHX) s = swallow_bom((U8*)s); } } - if (PL_doextract) { + if (PL_parser->in_pod) { /* Incest with pod. */ #ifdef PERL_MAD if (PL_madskills) @@ -4704,12 +4704,12 @@ Perl_yylex(pTHX) PL_oldoldbufptr = PL_oldbufptr = s = PL_linestart = SvPVX(PL_linestr); PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr); PL_last_lop = PL_last_uni = NULL; - PL_doextract = FALSE; + PL_parser->in_pod = 0; } } if (PL_rsfp) incline(s); - } while (PL_doextract); + } while (PL_parser->in_pod); PL_oldoldbufptr = PL_oldbufptr = PL_bufptr = PL_linestart = s; PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr); PL_last_lop = PL_last_uni = NULL; @@ -5658,7 +5658,7 @@ Perl_yylex(pTHX) } #endif s = PL_bufend; - PL_doextract = TRUE; + PL_parser->in_pod = 1; goto retry; } } |