This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
https://perl5.git.perl.org / perl5.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
C++: regcomp.c and ext/Time/Piece/Piece.xs
[perl5.git] / toke.c
diff --git a/toke.c b/toke.c
index 4513c40..32edd1d 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -23,8 +23,7 @@
 #define PERL_IN_TOKE_C
 #include "perl.h"
 
-#define yychar (*PL_yycharp)
-#define yylval (*PL_yylvalp)
+#define yylval (PL_parser->yylval)
 
 static const char ident_too_long[] = "Identifier too long";
 static const char commaless_variable_list[] = "comma-less variable list";
@@ -662,13 +661,11 @@ Perl_lex_start(pTHX_ SV *line)
     PL_lex_inwhat = 0;
     PL_sublex_info.sub_inwhat = 0;
     PL_linestr = line;
-    if (SvREADONLY(PL_linestr))
-       PL_linestr = sv_2mortal(newSVsv(PL_linestr));
     s = SvPV_const(PL_linestr, len);
-    if (!len || s[len-1] != ';') {
-       if (!(SvFLAGS(PL_linestr) & SVs_TEMP))
-           PL_linestr = sv_2mortal(newSVsv(PL_linestr));
-       sv_catpvs(PL_linestr, "\n;");
+    if (SvREADONLY(PL_linestr) || !len || s[len-1] != ';') {
+       PL_linestr = sv_2mortal(len ? newSVsv(PL_linestr) : newSVpvn(s, 0));
+       if (!len || s[len-1] != ';')
+           sv_catpvs(PL_linestr, "\n;");
     }
     SvTEMP_off(PL_linestr);
     PL_oldoldbufptr = PL_oldbufptr = PL_bufptr = PL_linestart = SvPVX(PL_linestr);
@@ -776,12 +773,13 @@ S_incline(pTHX_ char *s)
            gvp = (GV**)hv_fetch(PL_defstash, tmpbuf, tmplen, FALSE);
            if (gvp) {
                gv2 = *(GV**)hv_fetch(PL_defstash, tmpbuf2, tmplen2, TRUE);
-               if (!isGV(gv2))
+               if (!isGV(gv2)) {
                    gv_init(gv2, PL_defstash, tmpbuf2, tmplen2, FALSE);
-               /* adjust ${"::_<newfilename"} to store the new file name */
-               GvSV(gv2) = newSVpvn(tmpbuf2 + 2, tmplen2 - 2);
-               GvHV(gv2) = (HV*)SvREFCNT_inc(GvHV(*gvp));
-               GvAV(gv2) = (AV*)SvREFCNT_inc(GvAV(*gvp));
+                   /* adjust ${"::_<newfilename"} to store the new file name */
+                   GvSV(gv2) = newSVpvn(tmpbuf2 + 2, tmplen2 - 2);
+                   GvHV(gv2) = (HV*)SvREFCNT_inc(GvHV(*gvp));
+                   GvAV(gv2) = (AV*)SvREFCNT_inc(GvAV(*gvp));
+               }
            }
            if (tmpbuf != smallbuf) Safefree(tmpbuf);
            if (tmpbuf2 != smallbuf2) Safefree(tmpbuf2);
@@ -870,6 +868,34 @@ S_skipspace2(pTHX_ register char *s, SV **svp)
 }
 #endif
 
+STATIC void
+S_update_debugger_info_pv(pTHX_ const char *buf, STRLEN len)
+{
+    AV *av = CopFILEAVx(PL_curcop);
+    if (av) {
+       SV * const sv = newSV(0);
+       sv_upgrade(sv, SVt_PVMG);
+       sv_setpvn(sv, buf, len);
+       (void)SvIOK_on(sv);
+       SvIV_set(sv, 0);
+       av_store(av, (I32)CopLINE(PL_curcop), sv);
+    }
+}
+
+STATIC void
+S_update_debugger_info_sv(pTHX_ SV *orig_sv)
+{
+    AV *av = CopFILEAVx(PL_curcop);
+    if (av) {
+       SV * const sv = newSV(0);
+       sv_upgrade(sv, SVt_PVMG);
+       sv_setsv(sv, orig_sv);
+       (void)SvIOK_on(sv);
+       SvIV_set(sv, 0);
+       av_store(av, (I32)CopLINE(PL_curcop), sv);
+    }
+}
+
 /*
  * S_skipspace
  * Called to gobble the appropriate amount and type of whitespace.
@@ -1033,15 +1059,8 @@ S_skipspace(pTHX_ register char *s)
        /* debugger active and we're not compiling the debugger code,
         * so store the line into the debugger's array of lines
         */
-       if (PERLDB_LINE && PL_curstash != PL_debstash) {
-           SV * const sv = newSV(0);
-
-           sv_upgrade(sv, SVt_PVMG);
-           sv_setpvn(sv,PL_bufptr,PL_bufend-PL_bufptr);
-            (void)SvIOK_on(sv);
-            SvIV_set(sv, 0);
-           av_store(CopFILEAVx(PL_curcop),(I32)CopLINE(PL_curcop),sv);
-       }
+       if (PERLDB_LINE && PL_curstash != PL_debstash)
+           update_debugger_info_pv(PL_bufptr, PL_bufend - PL_bufptr);
     }
 
 #ifdef PERL_MAD
@@ -3546,15 +3565,8 @@ 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;
-           if (PERLDB_LINE && PL_curstash != PL_debstash) {
-               SV * const sv = newSV(0);
-
-               sv_upgrade(sv, SVt_PVMG);
-               sv_setsv(sv,PL_linestr);
-                (void)SvIOK_on(sv);
-                SvIV_set(sv, 0);
-               av_store(CopFILEAVx(PL_curcop),(I32)CopLINE(PL_curcop),sv);
-           }
+           if (PERLDB_LINE && PL_curstash != PL_debstash)
+               update_debugger_info_sv(PL_linestr);
            goto retry;
        }
        do {
@@ -3646,15 +3658,8 @@ Perl_yylex(pTHX)
            incline(s);
        } while (PL_doextract);
        PL_oldoldbufptr = PL_oldbufptr = PL_bufptr = PL_linestart = s;
-       if (PERLDB_LINE && PL_curstash != PL_debstash) {
-           SV * const sv = newSV(0);
-
-           sv_upgrade(sv, SVt_PVMG);
-           sv_setsv(sv,PL_linestr);
-            (void)SvIOK_on(sv);
-            SvIV_set(sv, 0);
-           av_store(CopFILEAVx(PL_curcop),(I32)CopLINE(PL_curcop),sv);
-       }
+       if (PERLDB_LINE && PL_curstash != PL_debstash)
+           update_debugger_info_sv(PL_linestr);
        PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr);
        PL_last_lop = PL_last_uni = NULL;
        if (CopLINE(PL_curcop) == 1) {
@@ -11216,15 +11221,8 @@ S_scan_heredoc(pTHX_ register char *s)
        else if (PL_bufend - PL_linestart == 1 && PL_bufend[-1] == '\r')
            PL_bufend[-1] = '\n';
 #endif
-       if (PERLDB_LINE && PL_curstash != PL_debstash) {
-           SV * const sv = newSV(0);
-
-           sv_upgrade(sv, SVt_PVMG);
-           sv_setsv(sv,PL_linestr);
-            (void)SvIOK_on(sv);
-            SvIV_set(sv, 0);
-           av_store(CopFILEAVx(PL_curcop), (I32)CopLINE(PL_curcop),sv);
-       }
+       if (PERLDB_LINE && PL_curstash != PL_debstash)
+           update_debugger_info_sv(PL_linestr);
        if (*s == term && memEQ(s,PL_tokenbuf,len)) {
            STRLEN off = PL_bufend - 1 - SvPVX_const(PL_linestr);
            *(SvPVX(PL_linestr) + off ) = ' ';
@@ -11473,7 +11471,7 @@ S_scan_str(pTHX_ char *start, int keep_quoted, int keep_delims)
     I32 termcode;                      /* terminating char. code */
     U8 termstr[UTF8_MAXBYTES];         /* terminating string */
     STRLEN termlen;                    /* length of terminating string */
-    char *last = NULL;                 /* last position for nesting bracket */
+    int last_off = 0;                  /* last position for nesting bracket */
 #ifdef PERL_MAD
     int stuffstart;
     char *tstart;
@@ -11574,9 +11572,7 @@ S_scan_str(pTHX_ char *start, int keep_quoted, int keep_delims)
                    else {
                        const char *t;
                        char *w;
-                       if (!last)
-                           last = SvPVX(sv);
-                       for (t = w = last; t < svlast; w++, t++) {
+                       for (t = w = SvPVX(sv)+last_off; t < svlast; w++, t++) {
                            /* At here, all closes are "was quoted" one,
                               so we don't check PL_multi_close. */
                            if (*t == '\\') {
@@ -11595,7 +11591,7 @@ S_scan_str(pTHX_ char *start, int keep_quoted, int keep_delims)
                            *w = '\0';
                            SvCUR_set(sv, w - SvPVX_const(sv));
                        }
-                       last = w;
+                       last_off = w - SvPVX(sv);
                        if (--brackets <= 0)
                            cont = FALSE;
                    }
@@ -11722,15 +11718,8 @@ S_scan_str(pTHX_ char *start, int keep_quoted, int keep_delims)
        CopLINE_inc(PL_curcop);
 
        /* update debugger info */
-       if (PERLDB_LINE && PL_curstash != PL_debstash) {
-           SV * const line_sv = newSV(0);
-
-           sv_upgrade(line_sv, SVt_PVMG);
-           sv_setsv(line_sv,PL_linestr);
-           (void)SvIOK_on(line_sv);
-           SvIV_set(line_sv, 0);
-           av_store(CopFILEAVx(PL_curcop), (I32)CopLINE(PL_curcop), line_sv);
-       }
+       if (PERLDB_LINE && PL_curstash != PL_debstash)
+           update_debugger_info_sv(PL_linestr);
 
        /* having changed the buffer, we must update PL_bufend */
        PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr);
@@ -11743,7 +11732,7 @@ S_scan_str(pTHX_ char *start, int keep_quoted, int keep_delims)
 #ifdef PERL_MAD
        if (PL_madskills) {
            char * const tstart = SvPVX(PL_linestr) + stuffstart;
-           const int len = s - start;
+           const int len = s - tstart;
            if (PL_thisstuff)
                sv_catpvn(PL_thisstuff, tstart, len);
            else
@@ -12391,6 +12380,7 @@ Perl_yyerror(pTHX_ const char *s)
     const char *context = NULL;
     int contlen = -1;
     SV *msg;
+    int yychar  = PL_parser->yychar;
 
     if (!yychar || (yychar == ';' && !PL_rsfp))
        where = "at EOF";
Unnamed repository; edit this file 'description' to name the repository.