static char ident_too_long[] = "Identifier too long";
-static void restore_rsfp(pTHXo_ void *f);
+static void restore_rsfp(pTHX_ void *f);
#ifndef PERL_NO_UTF16_FILTER
-static I32 utf16_textfilter(pTHXo_ int idx, SV *sv, int maxlen);
-static I32 utf16rev_textfilter(pTHXo_ int idx, SV *sv, int maxlen);
+static I32 utf16_textfilter(pTHX_ int idx, SV *sv, int maxlen);
+static I32 utf16rev_textfilter(pTHX_ int idx, SV *sv, int maxlen);
#endif
#define XFAKEBRACK 128
#define XENUMMASK 127
-#ifdef EBCDIC
-/* For now 'use utf8' does not affect tokenizer on EBCDIC */
-#define UTF (PL_linestr && DO_UTF8(PL_linestr))
+#ifdef USE_UTF8_SCRIPTS
+# define UTF (!IN_BYTES)
#else
-#define UTF ((PL_linestr && DO_UTF8(PL_linestr)) || (PL_hints & HINT_UTF8))
+# ifdef EBCDIC /* For now 'use utf8' does not affect tokenizer on EBCDIC */
+# define UTF (PL_linestr && DO_UTF8(PL_linestr))
+# else
+# define UTF ((PL_linestr && DO_UTF8(PL_linestr)) || (PL_hints & HINT_UTF8))
+# endif
#endif
/* In variables named $^X, these are the legal values for X.
PL_oldoldbufptr = PL_oldbufptr = PL_bufptr = PL_linestart = SvPVX(PL_linestr);
PL_bufend = PL_bufptr + SvCUR(PL_linestr);
PL_last_lop = PL_last_uni = Nullch;
- SvREFCNT_dec(PL_rs);
- PL_rs = newSVpvn("\n", 1);
PL_rsfp = 0;
}
/*
* S_force_version
* Forces the next token to be a version number.
+ * If the next token appears to be an invalid version number, (e.g. "v2b"),
+ * and if "guessing" is TRUE, then no new token is created (and the caller
+ * must use an alternative parsing method).
*/
STATIC char *
-S_force_version(pTHX_ char *s)
+S_force_version(pTHX_ char *s, int guessing)
{
OP *version = Nullop;
char *d;
if (*d == 'v')
d++;
if (isDIGIT(*d)) {
- for (; isDIGIT(*d) || *d == '_' || *d == '.'; d++);
+ while (isDIGIT(*d) || *d == '_' || *d == '.')
+ d++;
if (*d == ';' || isSPACE(*d) || *d == '}' || !*d) {
SV *ver;
s = scan_num(s, &yylval);
SvNOK_on(ver); /* hint that it is a version */
}
}
+ else if (guessing)
+ return s;
}
/* NOTE: The parser sees the package name and the VERSION swapped */
PL_nextval[PL_nexttoke].opval = version;
force_next(WORD);
- return (s);
+ return s;
}
/*
case '0': case '1': case '2': case '3':
case '4': case '5': case '6': case '7':
{
- STRLEN len = 0; /* disallow underscores */
- uv = (UV)scan_oct(s, 3, &len);
+ I32 flags = 0;
+ STRLEN len = 3;
+ uv = grok_oct(s, &len, &flags, NULL);
s += len;
}
goto NUM_ESCAPE_INSERT;
++s;
if (*s == '{') {
char* e = strchr(s, '}');
- STRLEN len = 1; /* allow underscores */
+ I32 flags = PERL_SCAN_ALLOW_UNDERSCORES |
+ PERL_SCAN_DISALLOW_PREFIX;
+ STRLEN len;
+ ++s;
if (!e) {
yyerror("Missing right brace on \\x{}");
- ++s;
continue;
}
- uv = (UV)scan_hex(s + 1, e - s - 1, &len);
+ len = e - s;
+ uv = grok_hex(s, &len, &flags, NULL);
s = e + 1;
}
else {
{
- STRLEN len = 0; /* disallow underscores */
- uv = (UV)scan_hex(s, 2, &len);
+ STRLEN len = 2;
+ I32 flags = PERL_SCAN_DISALLOW_PREFIX;
+ uv = grok_hex(s, &len, &flags, NULL);
s += len;
}
}
/* Call function. The function is expected to */
/* call "FILTER_READ(idx+1, buf_sv)" first. */
/* Return: <0:error, =0:eof, >0:not eof */
- return (*funcp)(aTHXo_ idx, buf_sv, maxlen);
+ return (*funcp)(aTHX_ idx, buf_sv, maxlen);
}
STATIC char *
if (PL_lex_dojoin) {
PL_nextval[PL_nexttoke].ival = 0;
force_next(',');
-#ifdef USE_THREADS
+#ifdef USE_5005THREADS
PL_nextval[PL_nexttoke].opval = newOP(OP_THREADSV, 0);
PL_nextval[PL_nexttoke].opval->op_targ = find_threadsv("\"");
force_next(PRIVATEREF);
#else
force_ident("\"", '$');
-#endif /* USE_THREADS */
+#endif /* USE_5005THREADS */
PL_nextval[PL_nexttoke].ival = 0;
force_next('$');
PL_nextval[PL_nexttoke].ival = 0;
if (ckWARN(WARN_RESERVED)) {
if (lastchar != '-') {
for (d = PL_tokenbuf; *d && isLOWER(*d); d++) ;
- if (!*d)
+ if (!*d && strNE(PL_tokenbuf,"main"))
Perl_warner(aTHX_ WARN_RESERVED, PL_warn_reserved,
PL_tokenbuf);
}
if (*s == '{')
PRETERMBLOCK(DO);
if (*s != '\'')
- s = force_word(s,WORD,FALSE,TRUE,FALSE);
+ s = force_word(s,WORD,TRUE,TRUE,FALSE);
OPERATOR(DO);
case KEY_die:
if (PL_expect != XSTATE)
yyerror("\"no\" not allowed in expression");
s = force_word(s,WORD,FALSE,TRUE,FALSE);
- s = force_version(s);
+ s = force_version(s, FALSE);
yylval.ival = 0;
OPERATOR(USE);
case KEY_require:
s = skipspace(s);
- if (isDIGIT(*s) || (*s == 'v' && isDIGIT(s[1]))) {
- s = force_version(s);
+ if (isDIGIT(*s)) {
+ s = force_version(s, FALSE);
}
- else {
+ else if (*s != 'v' || !isDIGIT(s[1])
+ || (s = force_version(s, TRUE), *s == 'v'))
+ {
*PL_tokenbuf = '\0';
s = force_word(s,WORD,TRUE,TRUE,FALSE);
if (isIDFIRST_lazy_if(PL_tokenbuf,UTF))
yyerror("\"use\" not allowed in expression");
s = skipspace(s);
if (isDIGIT(*s) || (*s == 'v' && isDIGIT(s[1]))) {
- s = force_version(s);
+ s = force_version(s, TRUE);
if (*s == ';' || (s = skipspace(s), *s == ';')) {
PL_nextval[PL_nexttoke].opval = Nullop;
force_next(WORD);
}
+ else if (*s == 'v') {
+ s = force_word(s,WORD,FALSE,TRUE,FALSE);
+ s = force_version(s, FALSE);
+ }
}
else {
s = force_word(s,WORD,FALSE,TRUE,FALSE);
- s = force_version(s);
+ s = force_version(s, FALSE);
}
yylval.ival = 1;
OPERATOR(USE);
*/
if (!strchr(PL_tokenbuf,':')) {
-#ifdef USE_THREADS
+#ifdef USE_5005THREADS
/* Check for single character per-thread SVs */
if (PL_tokenbuf[0] == '$' && PL_tokenbuf[2] == '\0'
&& !isALPHA(PL_tokenbuf[1]) /* Rule out obvious non-threadsvs */
yylval.opval->op_targ = tmp;
return PRIVATEREF;
}
-#endif /* USE_THREADS */
+#endif /* USE_5005THREADS */
if ((tmp = pad_findmy(PL_tokenbuf)) != NOT_IN_PAD) {
SV *namesv = AvARRAY(PL_comppad_name)[tmp];
/* might be an "our" variable" */
register char *e; /* end of temp buffer */
NV nv; /* number read, as a double */
SV *sv = Nullsv; /* place to put the converted number */
- bool floatit, /* boolean: int or float? */
- octal = 0; /* Is this an octal number? */
+ bool floatit; /* boolean: int or float? */
char *lastub = 0; /* position of last underbar */
static char number_too_long[] = "Number too long";
/* so it must be octal */
else {
shift = 3;
- octal = 1;
s++;
}
/* make the op for the constant and return */
- if (sv) {
+ if (sv)
lvalp->opval = newSVOP(OP_CONST, 0, sv);
- if (octal)
- ((SVOP *)lvalp->opval)->op_private |= OPpCONST_OCTAL;
- }
else
lvalp->opval = Nullop;
if (*t == '@' || *t == '^')
needargs = TRUE;
}
- sv_catpvn(stuff, s, eol-s);
+ if (eol > s) {
+ sv_catpvn(stuff, s, eol-s);
#ifndef PERL_STRICT_CR
- if (eol-s > 1 && eol[-2] == '\r' && eol[-1] == '\n') {
- char *end = SvPVX(stuff) + SvCUR(stuff);
- end[-2] = '\n';
- end[-1] = '\0';
- SvCUR(stuff)--;
- }
+ if (eol-s > 1 && eol[-2] == '\r' && eol[-1] == '\n') {
+ char *end = SvPVX(stuff) + SvCUR(stuff);
+ end[-2] = '\n';
+ end[-1] = '\0';
+ SvCUR(stuff)--;
+ }
#endif
+ }
+ else
+ break;
}
s = eol;
if (PL_rsfp) {
PL_min_intro_pending = 0;
PL_padix = 0;
PL_subline = CopLINE(PL_curcop);
-#ifdef USE_THREADS
+#ifdef USE_5005THREADS
av_store(PL_comppad_name, 0, newSVpvn("@_", 2));
PL_curpad[0] = (SV*)newAV();
SvPADMY_on(PL_curpad[0]); /* XXX Needed? */
-#endif /* USE_THREADS */
+#endif /* USE_5005THREADS */
comppadlist = newAV();
AvREAL_off(comppadlist);
CvPADLIST(PL_compcv) = comppadlist;
CvOUTSIDE(PL_compcv) = (CV*)SvREFCNT_inc(outsidecv);
-#ifdef USE_THREADS
+#ifdef USE_5005THREADS
CvOWNER(PL_compcv) = 0;
New(666, CvMUTEXP(PL_compcv), 1, perl_mutex);
MUTEX_INIT(CvMUTEXP(PL_compcv));
-#endif /* USE_THREADS */
+#endif /* USE_5005THREADS */
return oldsavestack_ix;
}
return (char*)s;
}
-#ifdef PERL_OBJECT
-#include "XSUB.h"
-#endif
-
/*
* restore_rsfp
* Restore a source filter.
*/
static void
-restore_rsfp(pTHXo_ void *f)
+restore_rsfp(pTHX_ void *f)
{
PerlIO *fp = (PerlIO*)f;
#ifndef PERL_NO_UTF16_FILTER
static I32
-utf16_textfilter(pTHXo_ int idx, SV *sv, int maxlen)
+utf16_textfilter(pTHX_ int idx, SV *sv, int maxlen)
{
I32 count = FILTER_READ(idx+1, sv, maxlen);
if (count) {
}
static I32
-utf16rev_textfilter(pTHXo_ int idx, SV *sv, int maxlen)
+utf16rev_textfilter(pTHX_ int idx, SV *sv, int maxlen)
{
I32 count = FILTER_READ(idx+1, sv, maxlen);
if (count) {
https://perl5.git.perl.org / perl5.git / blobdiff