Integrate with Sarathy.

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

diff --git a/toke.c b/toke.c
index d9f54f7..85b37a4 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -20,6 +20,10 @@
 
 static char ident_too_long[] = "Identifier too long";
 
+static void restore_rsfp(pTHXo_ void *f);
+static void restore_expect(pTHXo_ void *e);
+static void restore_lex_expect(pTHXo_ void *e);
+
 #define UTF (PL_hints & HINT_UTF8)
 /*
  * Note: we try to be careful never to call the isXXX_utf8() functions
@@ -282,12 +286,12 @@ Perl_lex_start(pTHX_ SV *line)
     SAVESPTR(PL_linestr);
     SAVEPPTR(PL_lex_brackstack);
     SAVEPPTR(PL_lex_casestack);
-    SAVEDESTRUCTOR(S_restore_rsfp, PL_rsfp);
+    SAVEDESTRUCTOR(restore_rsfp, PL_rsfp);
     SAVESPTR(PL_lex_stuff);
     SAVEI32(PL_lex_defer);
     SAVESPTR(PL_lex_repl);
-    SAVEDESTRUCTOR(S_restore_expect, PL_tokenbuf + PL_expect); /* encode as pointer */
-    SAVEDESTRUCTOR(S_restore_lex_expect, PL_tokenbuf + PL_expect);
+    SAVEDESTRUCTOR(restore_expect, PL_tokenbuf + PL_expect); /* encode as pointer */
+    SAVEDESTRUCTOR(restore_lex_expect, PL_tokenbuf + PL_expect);
 
     PL_lex_state = LEX_NORMAL;
     PL_lex_defer = 0;
@@ -330,32 +334,6 @@ Perl_lex_end(pTHX)
 }
 
 STATIC void
-S_restore_rsfp(pTHX_ void *f)
-{
-    PerlIO *fp = (PerlIO*)f;
-
-    if (PL_rsfp == PerlIO_stdin())
-       PerlIO_clearerr(PL_rsfp);
-    else if (PL_rsfp && (PL_rsfp != fp))
-       PerlIO_close(PL_rsfp);
-    PL_rsfp = fp;
-}
-
-STATIC void
-S_restore_expect(pTHX_ void *e)
-{
-    /* a safe way to store a small integer in a pointer */
-    PL_expect = (expectation)((char *)e - PL_tokenbuf);
-}
-
-STATIC void
-S_restore_lex_expect(pTHX_ void *e)
-{
-    /* a safe way to store a small integer in a pointer */
-    PL_lex_expect = (expectation)((char *)e - PL_tokenbuf);
-}
-
-STATIC void
 S_incline(pTHX_ char *s)
 {
     dTHR;
@@ -463,7 +441,6 @@ STATIC void
 S_check_uni(pTHX)
 {
     char *s;
-    char ch;
     char *t;
     dTHR;
 
@@ -475,7 +452,7 @@ S_check_uni(pTHX)
     if ((t = strchr(s, '(')) && t < PL_bufptr)
        return;
     if (ckWARN_d(WARN_AMBIGUOUS)){
-        ch = *s;
+        char ch = *s;
         *s = '\0';
         Perl_warner(aTHX_ WARN_AMBIGUOUS, 
                   "Warning: Use of \"%s\" without parens is ambiguous", 
@@ -3259,8 +3236,7 @@ Perl_yylex(pTHX)
                }
 
            safe_bareword:
-               if (lastchar && strchr("*%&", lastchar) && 
-                       ckWARN_d(WARN_AMBIGUOUS)) {
+               if (lastchar && strchr("*%&", lastchar) && ckWARN_d(WARN_AMBIGUOUS)) {
                    Perl_warner(aTHX_ WARN_AMBIGUOUS,
                        "Operator or semicolon missing before %c%s",
                        lastchar, PL_tokenbuf);
@@ -6000,10 +5976,10 @@ Perl_scan_num(pTHX_ char *start)
             we in octal/hex/binary?" indicator to disallow hex characters
             when in octal mode.
           */
+           dTHR;
            UV u;
            I32 shift;
            bool overflowed = FALSE;
-           dTHR;
 
            /* check for hex */
            if (s[1] == 'x') {
@@ -6071,10 +6047,13 @@ Perl_scan_num(pTHX_ char *start)
                  digit:
                    n = u << shift;     /* make room for the digit */
                    if (!overflowed && (n >> shift) != u
-                       && !(PL_hints & HINT_NEW_BINARY) && ckWARN_d(WARN_UNSAFE)) {
-                       Perl_warner(aTHX_ WARN_UNSAFE, "Integer overflow in %s number",
-                            (shift == 4) ? "hex"
-                            : ((shift == 3) ? "octal" : "binary"));
+                       && !(PL_hints & HINT_NEW_BINARY))
+                   {
+                       if (ckWARN_d(WARN_UNSAFE))
+                           Perl_warner(aTHX_ WARN_UNSAFE,
+                                       "Integer overflow in %s number",
+                                       (shift == 4) ? "hex"
+                                           : ((shift == 3) ? "octal" : "binary"));
                        overflowed = TRUE;
                    }
                    u = n | b;          /* add the digit to the end */
@@ -6431,3 +6410,34 @@ Perl_yyerror(pTHX_ char *s)
 }
 
 
+#ifdef PERL_OBJECT
+#define NO_XSLOCKS
+#include "XSUB.h"
+#endif
+
+static void
+restore_rsfp(pTHXo_ void *f)
+{
+    PerlIO *fp = (PerlIO*)f;
+
+    if (PL_rsfp == PerlIO_stdin())
+       PerlIO_clearerr(PL_rsfp);
+    else if (PL_rsfp && (PL_rsfp != fp))
+       PerlIO_close(PL_rsfp);
+    PL_rsfp = fp;
+}
+
+static void
+restore_expect(pTHXo_ void *e)
+{
+    /* a safe way to store a small integer in a pointer */
+    PL_expect = (expectation)((char *)e - PL_tokenbuf);
+}
+
+static void
+restore_lex_expect(pTHXo_ void *e)
+{
+    /* a safe way to store a small integer in a pointer */
+    PL_lex_expect = (expectation)((char *)e - PL_tokenbuf);
+}
+