#define LEX_FORMLINE 1
#define LEX_KNOWNEXT 0
-#ifdef I_FCNTL
-#include <fcntl.h>
-#endif
-#ifdef I_SYS_FILE
-#include <sys/file.h>
-#endif
-
/* XXX If this causes problems, set i_unistd=undef in the hint file. */
#ifdef I_UNISTD
# include <unistd.h> /* Needed for execv() */
dTHR;
char *t;
char *n;
+ char *e;
char ch;
- int sawline = 0;
CopLINE_inc(PL_curcop);
if (*s++ != '#')
return;
while (*s == ' ' || *s == '\t') s++;
- if (strnEQ(s, "line ", 5)) {
- s += 5;
- sawline = 1;
- }
+ if (strnEQ(s, "line", 4))
+ s += 4;
+ else
+ return;
+ if (*s == ' ' || *s == '\t')
+ s++;
+ else
+ return;
+ while (*s == ' ' || *s == '\t') s++;
if (!isDIGIT(*s))
return;
n = s;
s++;
while (*s == ' ' || *s == '\t')
s++;
- if (*s == '"' && (t = strchr(s+1, '"')))
+ if (*s == '"' && (t = strchr(s+1, '"'))) {
s++;
+ e = t + 1;
+ }
else {
- if (!sawline)
- return; /* false alarm */
for (t = s; !isSPACE(*t); t++) ;
+ e = t;
}
+ while (*e == ' ' || *e == '\t' || *e == '\r' || *e == '\f')
+ e++;
+ if (*e != '\n' && *e != '\0')
+ return; /* false alarm */
+
ch = *t;
*t = '\0';
if (t - s > 0)
S_force_version(pTHX_ char *s)
{
OP *version = Nullop;
+ bool is_vstr = FALSE;
+ char *d;
s = skipspace(s);
- if (isDIGIT(*s) || (*s == 'v' && isDIGIT(s[1]))) {
- char *d = s;
- if (*d == 'v')
- d++;
+ d = s;
+ if (*d == 'v') {
+ is_vstr = TRUE;
+ d++;
+ }
+ if (isDIGIT(*d)) {
for (; isDIGIT(*d) || *d == '_' || *d == '.'; d++);
- if ((*d == ';' || isSPACE(*d)) && *(skipspace(d)) != ',') {
+ if (*d == ';' || isSPACE(*d) || *d == '}' || !*d) {
s = scan_num(s);
/* real VERSION number -- GBARR */
version = yylval.opval;
+ if (is_vstr) {
+ SV *ver = cSVOPx(version)->op_sv;
+ SvUPGRADE(ver, SVt_PVIV);
+ SvIOKp_on(ver); /* hint that it is a version */
+ }
}
}
default:
{
dTHR;
- if (ckWARN(WARN_UNSAFE) && isALPHA(*s))
- Perl_warner(aTHX_ WARN_UNSAFE,
+ if (ckWARN(WARN_MISC) && isALPHA(*s))
+ Perl_warner(aTHX_ WARN_MISC,
"Unrecognized escape \\%c passed through",
*s);
/* default action is to copy the quoted character */
++s;
if (*s == '{') {
char* e = strchr(s, '}');
+ UV uv;
if (!e) {
yyerror("Missing right brace on \\x{}");
e = s;
}
/* note: utf always shorter than hex */
- d = (char*)uv_to_utf8((U8*)d,
- (UV)scan_hex(s + 1, e - s - 1, &len));
+ uv = (UV)scan_hex(s + 1, e - s - 1, &len);
+ if (uv > 127) {
+ d = (char*)uv_to_utf8((U8*)d, uv);
+ has_utf = TRUE;
+ }
+ else
+ *d++ = (char)uv;
s = e + 1;
- has_utf = TRUE;
}
else {
+ /* XXX collapse this branch into the one above */
UV uv = (UV)scan_hex(s, 2, &len);
if (utf && PL_lex_inwhat == OP_TRANS &&
utf != (OPpTRANS_FROM_UTF|OPpTRANS_TO_UTF))
OPERATOR(REFGEN);
case 'v':
- if (isDIGIT(s[1]) && PL_expect == XTERM) {
+ if (isDIGIT(s[1]) && PL_expect != XOPERATOR) {
char *start = s;
start++;
start++;
s = scan_num(s);
TERM(THING);
}
+ /* avoid v123abc() or $h{v1}, allow C<print v10;> */
+ else if (!isALPHA(*start) && (PL_expect == XTERM || PL_expect == XREF)) {
+ char c = *start;
+ GV *gv;
+ *start = '\0';
+ gv = gv_fetchpv(s, FALSE, SVt_PVCV);
+ *start = c;
+ if (!gv) {
+ s = scan_num(s);
+ TERM(THING);
+ }
+ }
}
goto keylookup;
case 'x':
if (len > 2 &&
PL_tokenbuf[len - 2] == ':' && PL_tokenbuf[len - 1] == ':')
{
- if (ckWARN(WARN_UNSAFE) && ! gv_fetchpv(PL_tokenbuf, FALSE, SVt_PVHV))
- Perl_warner(aTHX_ WARN_UNSAFE,
+ if (ckWARN(WARN_BAREWORD) && ! gv_fetchpv(PL_tokenbuf, FALSE, SVt_PVHV))
+ Perl_warner(aTHX_ WARN_BAREWORD,
"Bareword \"%s\" refers to nonexistent package",
PL_tokenbuf);
len -= 2;
LOP(OP_CRYPT,XTERM);
case KEY_chmod:
- if (ckWARN(WARN_OCTAL)) {
+ if (ckWARN(WARN_CHMOD)) {
for (d = s; d < PL_bufend && (isSPACE(*d) || *d == '('); d++) ;
if (*d != '0' && isDIGIT(*d))
- Perl_warner(aTHX_ WARN_OCTAL,
- "chmod: mode argument is missing initial 0");
+ Perl_warner(aTHX_ WARN_CHMOD,
+ "chmod() mode argument is missing initial 0");
}
LOP(OP_CHMOD,XTERM);
char *t;
for (d = s; isALNUM_lazy_if(d,UTF); d++) ;
t = skipspace(d);
- if (strchr("|&*+-=!?:.", *t) && ckWARN_d(WARN_AMBIGUOUS))
- Perl_warner(aTHX_ WARN_AMBIGUOUS,
+ if (strchr("|&*+-=!?:.", *t) && ckWARN_d(WARN_PRECEDENCE))
+ Perl_warner(aTHX_ WARN_PRECEDENCE,
"Precedence problem: open %.*s should be open(%.*s)",
d-s,s, d-s,s);
}
for (; isSPACE(*d) && len; --len, ++d) ;
if (len) {
char *b = d;
- if (!warned && ckWARN(WARN_SYNTAX)) {
+ if (!warned && ckWARN(WARN_QW)) {
for (; !isSPACE(*d) && len; --len, ++d) {
if (*d == ',') {
- Perl_warner(aTHX_ WARN_SYNTAX,
+ Perl_warner(aTHX_ WARN_QW,
"Possible attempt to separate words with commas");
++warned;
}
else if (*d == '#') {
- Perl_warner(aTHX_ WARN_SYNTAX,
+ Perl_warner(aTHX_ WARN_QW,
"Possible attempt to put comments in qw() list");
++warned;
}
LOP(OP_UTIME,XTERM);
case KEY_umask:
- if (ckWARN(WARN_OCTAL)) {
+ if (ckWARN(WARN_UMASK)) {
for (d = s; d < PL_bufend && (isSPACE(*d) || *d == '('); d++) ;
if (*d != '0' && isDIGIT(*d))
- Perl_warner(aTHX_ WARN_OCTAL,
+ Perl_warner(aTHX_ WARN_UMASK,
"umask: argument is missing initial 0");
}
UNI(OP_UMASK);
pos++;
while (isDIGIT(*pos))
pos++;
- if (*pos == '.' && isDIGIT(pos[1])) {
+ if (!isALPHA(*pos)) {
UV rev;
- U8 tmpbuf[10];
+ U8 tmpbuf[UTF8_MAXLEN];
U8 *tmpend;
- NV nshift = 1.0;
bool utf8 = FALSE;
s++; /* get past 'v' */
sv = NEWSV(92,5);
- SvUPGRADE(sv, SVt_PVNV);
sv_setpvn(sv, "", 0);
- do {
+ for (;;) {
if (*s == '0' && isDIGIT(s[1]))
yyerror("Octal number in vector unsupported");
rev = atoi(s);
- s = ++pos;
- while (isDIGIT(*pos))
- pos++;
-
- if (rev > 127) {
- tmpend = uv_to_utf8(tmpbuf, rev);
- utf8 = TRUE;
- }
+ tmpend = uv_to_utf8(tmpbuf, rev);
+ utf8 = utf8 || rev > 127;
+ sv_catpvn(sv, (const char*)tmpbuf, tmpend - tmpbuf);
+ if (*pos == '.' && isDIGIT(pos[1]))
+ s = ++pos;
else {
- tmpbuf[0] = (U8)rev;
- tmpend = &tmpbuf[1];
+ s = pos;
+ break;
}
- *tmpend = '\0';
- sv_catpvn(sv, (const char*)tmpbuf, tmpend - tmpbuf);
- if (rev > 0)
- SvNVX(sv) += (NV)rev/nshift;
- nshift *= 1000;
- } while (*pos == '.' && isDIGIT(pos[1]));
-
- if (*s == '0' && isDIGIT(s[1]))
- yyerror("Octal number in vector unsupported");
- rev = atoi(s);
- s = pos;
- tmpend = uv_to_utf8(tmpbuf, rev);
- utf8 = utf8 || rev > 127;
- *tmpend = '\0';
- sv_catpvn(sv, (const char*)tmpbuf, tmpend - tmpbuf);
- if (rev > 0)
- SvNVX(sv) += (NV)rev/nshift;
+ while (isDIGIT(*pos))
+ pos++;
+ }
SvPOK_on(sv);
- SvNOK_on(sv);
SvREADONLY_on(sv);
- if (utf8)
+ if (utf8) {
SvUTF8_on(sv);
+ sv_utf8_downgrade(sv, TRUE);
+ }
}
}
break;
}
else if (yychar > 255)
where = "next token ???";
+#ifdef USE_PURE_BISON
+/* GNU Bison sets the value -2 */
+ else if (yychar == -2) {
+#else
else if ((yychar & 127) == 127) {
+#endif
if (PL_lex_state == LEX_NORMAL ||
(PL_lex_state == LEX_KNOWNEXT && PL_lex_defer == LEX_NORMAL))
where = "at end of line";