Integrate mainline

[p5sagit/p5-mst-13.2.git] / toke.c

diff --git a/toke.c b/toke.c
index 28c71ff..5243fea 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -472,7 +472,7 @@ S_incline(pTHX_ char *s)
        s += 4;
     else
        return;
-    if (*s == ' ' || *s == '\t')
+    if (SPACE_OR_TAB(*s))
        s++;
     else
        return;
@@ -2115,9 +2115,6 @@ S_find_in_my_stash(pTHX_ char *pkgname, I32 len)
 */
 
 #ifdef USE_PURE_BISON
-#ifdef __SC__
-#pragma segment Perl_yylex_r
-#endif
 int
 Perl_yylex_r(pTHX_ YYSTYPE *lvalp, int *lcharp)
 {
@@ -3044,10 +3041,6 @@ Perl_yylex(pTHX)
                if (*d == '(') {
                    d = scan_str(d,TRUE,TRUE);
                    if (!d) {
-                       if (PL_lex_stuff) {
-                           SvREFCNT_dec(PL_lex_stuff);
-                           PL_lex_stuff = Nullsv;
-                       }
                        /* MUST advance bufptr here to avoid bogus
                           "at end of line" context messages from yyerror().
                         */
@@ -3073,12 +3066,16 @@ Perl_yylex(pTHX)
                        CvLOCKED_on(PL_compcv);
                    else if (!PL_in_my && len == 6 && strnEQ(s, "method", len))
                        CvMETHOD_on(PL_compcv);
+#ifdef USE_ITHREADS
+                   else if (PL_in_my == KEY_our && len == 6 && strnEQ(s, "shared", len))
+                       GvSHARED_on(cGVOPx_gv(yylval.opval));
+#endif
                    /* After we've set the flags, it could be argued that
                       we don't need to do the attributes.pm-based setting
                       process, and shouldn't bother appending recognized
                       flags. To experiment with that, uncomment the
                       following "else": */
-                   /* else */
+                   else
                        attrs = append_elem(OP_LIST, attrs,
                                            newSVOP(OP_CONST, 0,
                                                    newSVpvn(s, len)));
@@ -4742,9 +4739,10 @@ Perl_yylex(pTHX)
                    force_next(THING);
                }
            }
-           if (PL_lex_stuff)
+           if (PL_lex_stuff) {
                SvREFCNT_dec(PL_lex_stuff);
-           PL_lex_stuff = Nullsv;
+               PL_lex_stuff = Nullsv;
+           }
            PL_expect = XTERM;
            TOKEN('(');
 
@@ -5016,12 +5014,8 @@ Perl_yylex(pTHX)
                    char *p;
 
                    s = scan_str(s,FALSE,FALSE);
-                   if (!s) {
-                       if (PL_lex_stuff)
-                           SvREFCNT_dec(PL_lex_stuff);
-                       PL_lex_stuff = Nullsv;
+                   if (!s)
                        Perl_croak(aTHX_ "Prototype not terminated");
-                   }
                    /* strip spaces */
                    d = SvPVX(PL_lex_stuff);
                    tmp = 0;
@@ -6189,12 +6183,8 @@ S_scan_pat(pTHX_ char *start, I32 type)
     char *s;
 
     s = scan_str(start,FALSE,FALSE);
-    if (!s) {
-       if (PL_lex_stuff)
-           SvREFCNT_dec(PL_lex_stuff);
-       PL_lex_stuff = Nullsv;
+    if (!s)
        Perl_croak(aTHX_ "Search pattern not terminated");
-    }
 
     pm = (PMOP*)newPMOP(type, 0);
     if (PL_multi_open == '?')
@@ -6226,12 +6216,8 @@ S_scan_subst(pTHX_ char *start)
 
     s = scan_str(start,FALSE,FALSE);
 
-    if (!s) {
-       if (PL_lex_stuff)
-           SvREFCNT_dec(PL_lex_stuff);
-       PL_lex_stuff = Nullsv;
+    if (!s)
        Perl_croak(aTHX_ "Substitution pattern not terminated");
-    }
 
     if (s[-1] == PL_multi_open)
        s--;
@@ -6239,12 +6225,10 @@ S_scan_subst(pTHX_ char *start)
     first_start = PL_multi_start;
     s = scan_str(s,FALSE,FALSE);
     if (!s) {
-       if (PL_lex_stuff)
+       if (PL_lex_stuff) {
            SvREFCNT_dec(PL_lex_stuff);
-       PL_lex_stuff = Nullsv;
-       if (PL_lex_repl)
-           SvREFCNT_dec(PL_lex_repl);
-       PL_lex_repl = Nullsv;
+           PL_lex_stuff = Nullsv;
+       }
        Perl_croak(aTHX_ "Substitution replacement not terminated");
     }
     PL_multi_start = first_start;      /* so whole substitution is taken together */
@@ -6293,29 +6277,21 @@ S_scan_trans(pTHX_ char *start)
     I32 squash;
     I32 del;
     I32 complement;
-    I32 utf8;
-    I32 count = 0;
 
     yylval.ival = OP_NULL;
 
     s = scan_str(start,FALSE,FALSE);
-    if (!s) {
-       if (PL_lex_stuff)
-           SvREFCNT_dec(PL_lex_stuff);
-       PL_lex_stuff = Nullsv;
+    if (!s)
        Perl_croak(aTHX_ "Transliteration pattern not terminated");
-    }
     if (s[-1] == PL_multi_open)
        s--;
 
     s = scan_str(s,FALSE,FALSE);
     if (!s) {
-       if (PL_lex_stuff)
+       if (PL_lex_stuff) {
            SvREFCNT_dec(PL_lex_stuff);
-       PL_lex_stuff = Nullsv;
-       if (PL_lex_repl)
-           SvREFCNT_dec(PL_lex_repl);
-       PL_lex_repl = Nullsv;
+           PL_lex_stuff = Nullsv;
+       }
        Perl_croak(aTHX_ "Transliteration replacement not terminated");
     }
 
@@ -6687,11 +6663,11 @@ S_scan_inputsymbol(pTHX_ char *start)
    delimiter.  It allows quoting of delimiters, and if the string has
    balanced delimiters ([{<>}]) it allows nesting.
 
-   The lexer always reads these strings into lex_stuff, except in the
-   case of the operators which take *two* arguments (s/// and tr///)
-   when it checks to see if lex_stuff is full (presumably with the 1st
-   arg to s or tr) and if so puts the string into lex_repl.
-
+   On success, the SV with the resulting string is put into lex_stuff or,
+   if that is already non-NULL, into lex_repl. The second case occurs only
+   when parsing the RHS of the special constructs s/// and tr/// (y///).
+   For convenience, the terminating delimiter character is stuffed into
+   SvIVX of the SV.
 */
 
 STATIC char *
@@ -7456,6 +7432,9 @@ Perl_start_subparse(pTHX_ I32 is_format, U32 flags)
     return oldsavestack_ix;
 }
 
+#ifdef __SC__
+#pragma segment Perl_yylex
+#endif
 int
 Perl_yywarn(pTHX_ char *s)
 {
@@ -7544,6 +7523,9 @@ Perl_yyerror(pTHX_ char *s)
     PL_in_my_stash = Nullhv;
     return 0;
 }
+#ifdef __SC__
+#pragma segment Main
+#endif
 
 STATIC char*
 S_swallow_bom(pTHX_ U8 *s)