This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
replace PL_doextract with better kinds of variable
authorZefram <zefram@fysh.org>
Wed, 13 Oct 2010 18:59:23 +0000 (19:59 +0100)
committerFather Chrysostomos <sprout@cpan.org>
Thu, 21 Oct 2010 12:52:39 +0000 (05:52 -0700)
PL_doextract had two unrelated jobs, neither best served by an interpreter
global variable.  The first was to track the -x command-line switch.
That is replaced with a local variable in S_parse_body().  The second
was to track whether the lexer is in the middle of a =pod section.
That is replaced with an element in PL_parser.

embedvar.h
intrpvar.h
parser.h
perl.c
sv.c
toke.c

index b7f2454..262ddb0 100644 (file)
 #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)
 #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
index 55e91f6..c798285 100644 (file)
@@ -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. */
index 4ef4608..f4054d5 100644 (file)
--- a/parser.h
+++ b/parser.h
@@ -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 */
diff --git a/perl.c b/perl.c
index bdb9b56..962b046 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -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)))
+               ;
     }
 }
 
diff --git a/sv.c b/sv.c
index 2f39778..500c7c7 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -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);
diff --git a/toke.c b/toke.c
index cba2bd9..68e5aee 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -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;
                }
        }