#endif
#ifdef USE_PURE_BISON
-YYSTYPE* yylval_pointer = NULL;
-int* yychar_pointer = NULL;
+#ifndef YYMAXLEVEL
+#define YYMAXLEVEL 100
+#endif
+YYSTYPE* yylval_pointer[YYMAXLEVEL];
+int* yychar_pointer[YYMAXLEVEL];
+int yyactlevel = 0;
# undef yylval
# undef yychar
-# define yylval (*yylval_pointer)
-# define yychar (*yychar_pointer)
-# define PERL_YYLEX_PARAM yylval_pointer,yychar_pointer
-# undef yylex
-# define yylex() Perl_yylex(aTHX_ yylval_pointer, yychar_pointer)
+# define yylval (*yylval_pointer[yyactlevel])
+# define yychar (*yychar_pointer[yyactlevel])
+# define PERL_YYLEX_PARAM yylval_pointer[yyactlevel],yychar_pointer[yyactlevel]
+# undef yylex
+# define yylex() Perl_yylex(aTHX_ yylval_pointer[yyactlevel],yychar_pointer[yyactlevel])
#endif
#include "keywords.h"
if (!s)
s = oldbp;
- else {
- assert(s >= oldbp);
+ else
PL_bufptr = s;
- }
yywarn(Perl_form(aTHX_ "%s found where operator expected", what));
if (is_first)
Perl_warn(aTHX_ "\t(Missing semicolon on previous line?)\n");
Perl_warn(aTHX_ "\t(Do you need to predeclare %.*s?)\n",
t - PL_oldoldbufptr, PL_oldoldbufptr);
}
- else
+ else {
+ assert(s >= oldbp);
Perl_warn(aTHX_ "\t(Missing operator before %.*s?)\n", s - oldbp, oldbp);
+ }
PL_bufptr = oldbp;
}
SAVEVPTR(PL_nextval[toke]);
}
SAVEI32(PL_nexttoke);
- PL_nexttoke = 0;
}
SAVECOPLINE(PL_curcop);
SAVEPPTR(PL_bufptr);
PL_lex_stuff = Nullsv;
PL_lex_repl = Nullsv;
PL_lex_inpat = 0;
+ PL_nexttoke = 0;
PL_lex_inwhat = 0;
PL_sublex_info.sub_inwhat = 0;
PL_linestr = line;
I32 skip;
UV n;
if (utf)
- n = utf8_to_uv((U8*)start, &skip);
+ n = utf8_to_uv_chk((U8*)start, &skip, 0);
else {
n = *(U8*)start;
skip = 1;
for (; isDIGIT(*d) || *d == '_' || *d == '.'; d++);
if (*d == ';' || isSPACE(*d) || *d == '}' || !*d) {
SV *ver;
- s = scan_num(s);
+ s = scan_num(s, &yylval);
version = yylval.opval;
ver = cSVOPx(version)->op_sv;
if (SvPOK(ver) && !SvNIOK(ver)) {
if (min > max) {
Perl_croak(aTHX_
"Invalid [] range \"%c-%c\" in transliteration operator",
- min, max);
+ (char)min, (char)max);
}
#ifndef ASCIIish
*d++ = *s++;
}
- /* check for embedded arrays (@foo, @:foo, @'foo, @{foo}, @$foo) */
+ /* check for embedded arrays
+ (@foo, @:foo, @'foo, @{foo}, @$foo, @+, @-)
+ */
else if (*s == '@' && s[1]
- && (isALNUM_lazy_if(s+1,UTF) || strchr(":'{$", s[1])))
+ && (isALNUM_lazy_if(s+1,UTF) || strchr(":'{$+-", s[1])))
break;
/* check for embedded scalars. only stop if we're sure it's a
/* (now in tr/// code again) */
if (*s & 0x80 && thisutf) {
- (void)utf8_to_uv((U8*)s, &len);
+ (void)utf8_to_uv_chk((U8*)s, &len, 0);
if (len == 1) {
/* illegal UTF8, make it valid */
char *old_pvx = SvPVX(sv);
char *ostart = SvPVX(sv);
SvCUR_set(sv, d - ostart);
SvPOK_on(sv);
+ *d = '\0';
sv_utf8_upgrade(sv);
+ /* this just broke our allocation above... */
+ SvGROW(sv, send - start);
d = SvPVX(sv) + SvCUR(sv);
has_utf = TRUE;
}
#endif
{
dTHR;
+ int r;
+
+#ifdef USE_PURE_BISON
+ yylval_pointer[yyactlevel] = lvalp;
+ yychar_pointer[yyactlevel] = lcharp;
+ yyactlevel++;
+ if (yyactlevel >= YYMAXLEVEL)
+ Perl_croak(aTHX_ "panic: YYMAXLEVEL");
+#endif
+
+ r = S_syylex(aTHX);
+
+#ifdef USE_PURE_BISON
+ yyactlevel--;
+#endif
+
+ return r;
+}
+
+STATIC int
+S_syylex(pTHX) /* need to be separate from yylex for reentrancy */
+{
+ dTHR;
register char *s;
register char *d;
register I32 tmp;
GV *gv = Nullgv;
GV **gvp = 0;
-#ifdef USE_PURE_BISON
- yylval_pointer = lvalp;
- yychar_pointer = lcharp;
-#endif
-
/* check if there's an identifier for us to look at */
if (PL_pending_ident) {
/* pit holds the identifier we read and pending_ident is reset */
/* FALL THROUGH */
case '0': case '1': case '2': case '3': case '4':
case '5': case '6': case '7': case '8': case '9':
- s = scan_num(s);
+ s = scan_num(s, &yylval);
if (PL_expect == XOPERATOR)
no_op("Number",s);
TERM(THING);
while (isDIGIT(*start) || *start == '_')
start++;
if (*start == '.' && isDIGIT(start[1])) {
- s = scan_num(s);
+ s = scan_num(s, &yylval);
TERM(THING);
}
/* avoid v123abc() or $h{v1}, allow C<print v10;> */
gv = gv_fetchpv(s, FALSE, SVt_PVCV);
*start = c;
if (!gv) {
- s = scan_num(s);
+ s = scan_num(s, &yylval);
TERM(THING);
}
}
/* Mark this internal pseudo-handle as clean */
IoFLAGS(GvIOp(gv)) |= IOf_UNTAINT;
if (PL_preprocess)
- IoTYPE(GvIOp(gv)) = '|';
+ IoTYPE(GvIOp(gv)) = IoTYPE_PIPE;
else if ((PerlIO*)PL_rsfp == PerlIO_stdin())
- IoTYPE(GvIOp(gv)) = '-';
+ IoTYPE(GvIOp(gv)) = IoTYPE_STD;
else
- IoTYPE(GvIOp(gv)) = '<';
+ IoTYPE(GvIOp(gv)) = IoTYPE_RDONLY;
#if defined(WIN32) && !defined(PERL_TEXTMODE_SCRIPTS)
/* if the script was opened in binmode, we need to revert
* it to text mode for compatibility; but only iff it has CRs
&& PL_bufend[-1] == '\n' && PL_bufend[-2] == '\r')
{
Off_t loc = 0;
- if (IoTYPE(GvIOp(gv)) == '<') {
+ if (IoTYPE(GvIOp(gv)) == IoTYPE_RDONLY) {
loc = PerlIO_tell(PL_rsfp);
(void)PerlIO_seek(PL_rsfp, 0L, 0);
}
if (strEQ(d,"cos")) return -KEY_cos;
break;
case 4:
- if (strEQ(d,"chop")) return KEY_chop;
+ if (strEQ(d,"chop")) return -KEY_chop;
break;
case 5:
if (strEQ(d,"close")) return -KEY_close;
if (strEQ(d,"chdir")) return -KEY_chdir;
- if (strEQ(d,"chomp")) return KEY_chomp;
+ if (strEQ(d,"chomp")) return -KEY_chomp;
if (strEQ(d,"chmod")) return -KEY_chmod;
if (strEQ(d,"chown")) return -KEY_chown;
if (strEQ(d,"crypt")) return -KEY_crypt;
SAVETMPS;
PUSHMARK(SP) ;
- EXTEND(sp, 4);
+ EXTEND(sp, 3);
if (pv)
PUSHs(pv);
PUSHs(sv);
if (pv)
PUSHs(typesv);
- PUSHs(cv);
PUTBACK;
call_sv(cv, G_SCALAR | ( PL_in_eval ? 0 : G_EVAL));
*/
char *
-Perl_scan_num(pTHX_ char *start)
+Perl_scan_num(pTHX_ char *start, YYSTYPE* lvalp)
{
register char *s = start; /* current position in buffer */
register char *d; /* destination in temp buffer */
/* make the op for the constant and return */
if (sv)
- yylval.opval = newSVOP(OP_CONST, 0, sv);
+ lvalp->opval = newSVOP(OP_CONST, 0, sv);
else
- yylval.opval = Nullop;
+ lvalp->opval = Nullop;
return s;
}
qerror(msg);
if (PL_error_count >= 10) {
if (PL_in_eval && SvCUR(ERRSV))
- Perl_croak(aTHX_ "%_%s has too many errors.\n",
+ Perl_croak(aTHX_ "%"SVf"%s has too many errors.\n",
ERRSV, CopFILE(PL_curcop));
else
Perl_croak(aTHX_ "%s has too many errors.\n",
filter_add(utf16rev_textfilter, NULL);
New(898, news, (PL_bufend - (char*)s) * 3 / 2 + 1, U8);
- PL_bufend = (char*)utf16_to_utf8(s, news,
- PL_bufend - (char*)s,
+ PL_bufend = (char*)utf16_to_utf8_reversed(s, news,
+ PL_bufend - (char*)s - 1,
&newlen);
Copy(news, s, newlen, U8);
SvCUR_set(PL_linestr, newlen);
U8* tend;
I32 newlen;
New(898, tmps, SvCUR(sv) * 3 / 2 + 1, U8);
+ if (!*SvPV_nolen(sv))
+ /* Game over, but don't feed an odd-length string to utf16_to_utf8 */
+ return count;
+
tend = utf16_to_utf8((U8*)SvPVX(sv), tmps, SvCUR(sv), &newlen);
sv_usepvn(sv, (char*)tmps, tend - tmps);
}
U8* tmps;
U8* tend;
I32 newlen;
+ if (!*SvPV_nolen(sv))
+ /* Game over, but don't feed an odd-length string to utf16_to_utf8 */
+ return count;
+
New(898, tmps, SvCUR(sv) * 3 / 2 + 1, U8);
tend = utf16_to_utf8_reversed((U8*)SvPVX(sv), tmps, SvCUR(sv), &newlen);
sv_usepvn(sv, (char*)tmps, tend - tmps);