#include "EXTERN.h"
#include "perl.h"
+#define yychar PL_yychar
+#define yylval PL_yylval
+
#ifndef PERL_OBJECT
static void check_uni _((void));
static void force_next _((I32 type));
}
#endif
+#ifndef PERL_OBJECT
+
STATIC I32
utf16_textfilter(int idx, SV *sv, int maxlen)
{
I32 count = FILTER_READ(idx+1, sv, maxlen);
if (count) {
- char* tmps;
- char* tend;
- New(898, tmps, SvCUR(sv) * 3 / 2 + 1, char);
+ U8* tmps;
+ U8* tend;
+ New(898, tmps, SvCUR(sv) * 3 / 2 + 1, U8);
tend = utf16_to_utf8((U16*)SvPVX(sv), tmps, SvCUR(sv));
- sv_usepvn(sv, tmps, tend - tmps);
+ sv_usepvn(sv, (char*)tmps, tend - tmps);
}
return count;
{
I32 count = FILTER_READ(idx+1, sv, maxlen);
if (count) {
- char* tmps;
- char* tend;
- New(898, tmps, SvCUR(sv) * 3 / 2 + 1, char);
+ U8* tmps;
+ U8* tend;
+ New(898, tmps, SvCUR(sv) * 3 / 2 + 1, U8);
tend = utf16_to_utf8_reversed((U16*)SvPVX(sv), tmps, SvCUR(sv));
- sv_usepvn(sv, tmps, tend - tmps);
+ sv_usepvn(sv, (char*)tmps, tend - tmps);
}
return count;
}
+#endif
+
void
lex_start(SV *line)
{
/* expand a range A-Z to the full set of characters. AIE! */
if (dorange) {
I32 i; /* current expanded character */
+ I32 min; /* first character in range */
I32 max; /* last character in range */
i = d - SvPVX(sv); /* remember current offset */
d = SvPVX(sv) + i; /* restore d after the grow potentially has changed the ptr */
d -= 2; /* eat the first char and the - */
- max = (U8)d[1]; /* last char in range */
-
- for (i = (U8)*d; i <= max; i++)
- *d++ = i;
+ min = (U8)*d; /* first char in range */
+ max = (U8)d[1]; /* last char in range */
+
+#ifndef ASCIIish
+ if ((isLOWER(min) && isLOWER(max)) ||
+ (isUPPER(min) && isUPPER(max))) {
+ if (isLOWER(min)) {
+ for (i = min; i <= max; i++)
+ if (isLOWER(i))
+ *d++ = i;
+ } else {
+ for (i = min; i <= max; i++)
+ if (isUPPER(i))
+ *d++ = i;
+ }
+ }
+ else
+#endif
+ for (i = min; i <= max; i++)
+ *d++ = i;
/* mark the range as done, and continue */
dorange = FALSE;
/* if we get here, we're not doing a transliteration */
- /* skip for regexp comments /(?#comment)/ */
+ /* skip for regexp comments /(?#comment)/ and code /(?{code})/,
+ except for the last char, which will be done separately. */
else if (*s == '(' && PL_lex_inpat && s[1] == '?') {
if (s[2] == '#') {
while (s < send && *s != ')')
*d++ = *s++;
- } else if (s[2] == '{') { /* This should march regcomp.c */
+ } else if (s[2] == '{'
+ || s[2] == 'p' && s[3] == '{') { /* This should march regcomp.c */
I32 count = 1;
- char *regparse = s + 3;
+ char *regparse = s + (s[2] == '{' ? 3 : 4);
char c;
while (count && (c = *regparse)) {
count--;
regparse++;
}
- if (*regparse == ')')
- regparse++;
- else
+ if (*regparse != ')') {
+ regparse--; /* Leave one char for continuation. */
yyerror("Sequence (?{...}) not terminated or not {}-balanced");
- while (s < regparse && *s != ')')
+ }
+ while (s < regparse)
*d++ = *s++;
}
}
if (*s & 0x80 && thisutf) {
dTHR; /* only for ckWARN */
if (ckWARN(WARN_UTF8)) {
- (void)utf8_to_uv(s, &len); /* could cvt latin-1 to utf8 here... */
+ (void)utf8_to_uv((U8*)s, &len); /* could cvt latin-1 to utf8 here... */
if (len) {
while (len--)
*d++ = *s++;
"Use of \\x{} without utf8 declaration");
}
/* note: utf always shorter than hex */
- d = uv_to_utf8(d, scan_hex(s + 1, e - s - 1, &len));
+ d = (char*)uv_to_utf8((U8*)d,
+ scan_hex(s + 1, e - s - 1, &len));
s = e + 1;
}
if (utf && PL_lex_inwhat == OP_TRANS &&
utf != (OPpTRANS_FROM_UTF|OPpTRANS_TO_UTF))
{
- d = uv_to_utf8(d, uv); /* doing a CU or UC */
+ d = (char*)uv_to_utf8((U8*)d, uv); /* doing a CU or UC */
}
else {
if (uv >= 127 && UTF) {
if (!PL_rsfp_filters || AvFILLp(PL_rsfp_filters)<0)
return;
/* if filter is on top of stack (usual case) just pop it off */
- if (IoDIRP(FILTER_DATA(AvFILLp(PL_rsfp_filters))) == (void*)funcp){
+ if (IoDIRP(FILTER_DATA(AvFILLp(PL_rsfp_filters))) == (DIR*)funcp){
sv_free(av_pop(PL_rsfp_filters));
return;
* routines unnecessarily. You will see this not just here but throughout this file.
*/
if (UTF && (*s & 0xc0) == 0x80) {
- if (isIDFIRST_utf8(s))
+ if (isIDFIRST_utf8((U8*)s))
goto keylookup;
}
croak("Unrecognized character \\x%02X", *s & 255);
}
if (PL_lex_brackets < PL_lex_formbrack) {
char *t;
+#ifdef PERL_STRICT_CR
for (t = s; *t == ' ' || *t == '\t'; t++) ;
+#else
+ for (t = s; *t == ' ' || *t == '\t' || *t == '\r'; t++) ;
+#endif
if (*t == '\n' || *t == '#') {
s--;
PL_expect = XBLOCK;
}
}
- if (s[1] == '#' && (isALPHA(s[2]) || strchr("_{$:", s[2]))) {
+ if (s[1] == '#' && (isALPHA(s[2]) || strchr("_{$:+-", s[2]))) {
if (PL_expect == XOPERATOR)
no_op("Array length", PL_bufptr);
PL_tokenbuf[0] = '@';
OPERATOR(tmp);
case '.':
- if (PL_lex_formbrack && PL_lex_brackets == PL_lex_formbrack && s[1] == '\n' &&
- (s == PL_linestart || s[-1] == '\n') ) {
+ if (PL_lex_formbrack && PL_lex_brackets == PL_lex_formbrack
+#ifdef PERL_STRICT_CR
+ && s[1] == '\n'
+#else
+ && (s[1] == '\n' || (s[1] == '\r' && s[2] == '\n'))
+#endif
+ && (s == PL_linestart || s[-1] == '\n') )
+ {
PL_lex_formbrack = 0;
PL_expect = XSTATE;
goto rightbracket;
tmp = -tmp;
gv = Nullgv;
gvp = 0;
- if (ckWARN(WARN_AMBIGUOUS) && hgv)
+ if (ckWARN(WARN_AMBIGUOUS) && hgv
+ && tmp != KEY_x && tmp != KEY_CORE) /* never ambiguous */
warner(WARN_AMBIGUOUS,
"Ambiguous call resolved as CORE::%s(), %s",
GvENAME(hgv), "qualify as such or use &");
*d++ = *s++;
*d++ = *s++;
}
- else if (UTF && (*s & 0xc0) == 0x80 && isALNUM_utf8(s)) {
+ else if (UTF && (*s & 0xc0) == 0x80 && isALNUM_utf8((U8*)s)) {
char *t = s + UTF8SKIP(s);
- while (*t & 0x80 && is_utf8_mark(t))
+ while (*t & 0x80 && is_utf8_mark((U8*)t))
t += UTF8SKIP(t);
if (d + (t - s) > e)
croak(ident_too_long);
*d++ = *s++;
*d++ = *s++;
}
- else if (UTF && (*s & 0xc0) == 0x80 && isALNUM_utf8(s)) {
+ else if (UTF && (*s & 0xc0) == 0x80 && isALNUM_utf8((U8*)s)) {
char *t = s + UTF8SKIP(s);
- while (*t & 0x80 && is_utf8_mark(t))
+ while (*t & 0x80 && is_utf8_mark((U8*)t))
t += UTF8SKIP(t);
if (d + (t - s) > e)
croak(ident_too_long);
return s;
}
if (*s == '$' && s[1] &&
- (isALNUM(s[1]) || strchr("${", s[1]) || strnEQ(s+1,"::",2)) )
+ (isALNUM(s[1]) || strchr("${", s[1]) || strnEQ(s+1,"::",2)) )
{
- if (isDIGIT(s[1]) && PL_lex_state == LEX_INTERPNORMAL)
- deprecate("\"$$<digit>\" to mean \"${$}<digit>\"");
- else
- return s;
+ return s;
}
if (*s == '{') {
bracket = s;
}
}
}
- if (isIDFIRST(*d) || (UTF && (*d & 0xc0) == 0x80 && isIDFIRST_utf8(d))) {
+ if (isIDFIRST(*d) || (UTF && (*d & 0xc0) == 0x80 && isIDFIRST_utf8((U8*)d))) {
d++;
if (UTF) {
e = s;
while (e < send && (isALNUM(*e) || ((*e & 0xc0) == 0x80 && isALNUM_utf8((U8*)e)) || *e == ':')) {
e += UTF8SKIP(e);
- while (e < send && *e & 0x80 && is_utf8_mark(e))
+ while (e < send && *e & 0x80 && is_utf8_mark((U8*)e))
e += UTF8SKIP(e);
}
Copy(s, d, e - s, char);
while (!needargs) {
if (*s == '.' || *s == '}') {
/*SUPPRESS 530*/
- for (t = s+1; *t == ' ' || *t == '\t'; t++) ;
+#ifdef PERL_STRICT_CR
+ for (t = s+1;*t == ' ' || *t == '\t'; t++) ;
+#else
+ for (t = s+1;*t == ' ' || *t == '\t' || *t == '\r'; t++) ;
+#endif
if (*t == '\n')
break;
}
projects / p5sagit/p5-mst-13.2.git / blobdiff