}
#endif
+#if 0
STATIC I32
S_utf16_textfilter(pTHX_ int idx, SV *sv, int maxlen)
{
New(898, tmps, SvCUR(sv) * 3 / 2 + 1, U8);
tend = utf16_to_utf8((U16*)SvPVX(sv), tmps, SvCUR(sv));
sv_usepvn(sv, (char*)tmps, tend - tmps);
-
}
return count;
}
New(898, tmps, SvCUR(sv) * 3 / 2 + 1, U8);
tend = utf16_to_utf8_reversed((U16*)SvPVX(sv), tmps, SvCUR(sv));
sv_usepvn(sv, (char*)tmps, tend - tmps);
-
}
return count;
}
+#endif
/*
* Perl_lex_start
}
}
+NV
+Perl_str_to_version(pTHX_ SV *sv)
+{
+ NV retval = 0.0;
+ NV nshift = 1.0;
+ STRLEN len;
+ char *start = SvPVx(sv,len);
+ bool utf = SvUTF8(sv);
+ char *end = start + len;
+ while (start < end) {
+ I32 skip;
+ UV n;
+ if (utf)
+ n = utf8_to_uv((U8*)start, &skip);
+ else {
+ n = *(U8*)start;
+ skip = 1;
+ }
+ retval += ((NV)n)/nshift;
+ start += skip;
+ nshift *= 1000;
+ }
+ return retval;
+}
+
/*
* S_force_version
* Forces the next token to be a version number.
S_force_version(pTHX_ char *s)
{
OP *version = Nullop;
- bool is_vstr = FALSE;
char *d;
s = skipspace(s);
d = s;
- if (*d == 'v') {
- is_vstr = TRUE;
+ if (*d == 'v')
d++;
- }
if (isDIGIT(*d)) {
for (; isDIGIT(*d) || *d == '_' || *d == '.'; d++);
if (*d == ';' || isSPACE(*d) || *d == '}' || !*d) {
+ SV *ver;
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 */
+ ver = cSVOPx(version)->op_sv;
+ if (SvPOK(ver) && !SvNIOK(ver)) {
+ (void)SvUPGRADE(ver, SVt_PVNV);
+ SvNVX(ver) = str_to_version(ver);
+ SvNOK_on(ver); /* hint that it is a version */
}
}
}
if (s[2] == '#') {
while (s < send && *s != ')')
*d++ = *s++;
- } else if (s[2] == '{'
- || s[2] == 'p' && s[3] == '{') { /* This should march regcomp.c */
+ }
+ else if (s[2] == '{' /* This should match regcomp.c */
+ || ((s[2] == 'p' || s[2] == '?') && s[3] == '{'))
+ {
I32 count = 1;
char *regparse = s + (s[2] == '{' ? 3 : 4);
char c;
++s;
if (*s == '{') {
char* e = strchr(s, '}');
- HV *hv;
- SV **svp;
- SV *res, *cv;
+ SV *res;
STRLEN len;
char *str;
- char *why = Nullch;
if (!e) {
yyerror("Missing right brace on \\N{}");
}
d = moreswitches(d);
} while (d);
- if (PERLDB_LINE && !oldpdb ||
- ( PL_minus_n || PL_minus_p ) && !(oldn || oldp) )
+ if ((PERLDB_LINE && !oldpdb) ||
+ ((PL_minus_n || PL_minus_p) && !(oldn || oldp)))
/* if we have already added "LINE: while (<>) {",
we must not do it again */
{
else if (isIDFIRST_lazy_if(s,UTF)) {
char tmpbuf[sizeof PL_tokenbuf];
scan_word(s, tmpbuf, sizeof tmpbuf, TRUE, &len);
- if (tmp = keyword(tmpbuf, len)) {
+ if ((tmp = keyword(tmpbuf, len))) {
/* binary operators exclude handle interpretations */
switch (tmp) {
case -KEY_x:
char *start = s;
start++;
start++;
- while (isDIGIT(*start))
+ while (isDIGIT(*start) || *start == '_')
start++;
if (*start == '.' && isDIGIT(start[1])) {
s = scan_num(s);
case 'z': case 'Z':
keylookup: {
- STRLEN n_a;
gv = Nullgv;
gvp = 0;
s = scan_word(s, PL_tokenbuf, sizeof PL_tokenbuf, FALSE, &len);
/* Some keywords can be followed by any delimiter, including ':' */
- tmp = (len == 1 && strchr("msyq", PL_tokenbuf[0]) ||
- len == 2 && ((PL_tokenbuf[0] == 't' && PL_tokenbuf[1] == 'r') ||
- (PL_tokenbuf[0] == 'q' &&
- strchr("qwxr", PL_tokenbuf[1]))));
+ tmp = ((len == 1 && strchr("msyq", PL_tokenbuf[0])) ||
+ (len == 2 && ((PL_tokenbuf[0] == 't' && PL_tokenbuf[1] == 'r') ||
+ (PL_tokenbuf[0] == 'q' &&
+ strchr("qwxr", PL_tokenbuf[1])))));
/* x::* is just a word, unless x is "CORE" */
if (!tmp && *s == ':' && s[1] == ':' && strNE(PL_tokenbuf, "CORE"))
/* Get the rest if it looks like a package qualifier */
- if (*s == '\'' || *s == ':' && s[1] == ':') {
+ if (*s == '\'' || (*s == ':' && s[1] == ':')) {
STRLEN morelen;
s = scan_word(s, PL_tokenbuf + len, sizeof PL_tokenbuf - len,
TRUE, &morelen);
s += 2;
d = s;
s = scan_word(s, PL_tokenbuf, sizeof PL_tokenbuf, FALSE, &len);
- tmp = keyword(PL_tokenbuf, len);
+ if (!(tmp = keyword(PL_tokenbuf, len)))
+ Perl_croak(aTHX_ "CORE::%s is not a keyword", PL_tokenbuf);
if (tmp < 0)
tmp = -tmp;
goto reserved_word;
LOP(OP_BIND,XTERM);
case KEY_binmode:
- UNI(OP_BINMODE);
+ LOP(OP_BINMODE,XTERM);
case KEY_bless:
LOP(OP_BLESS,XTERM);
STATIC SV *
S_new_constant(pTHX_ char *s, STRLEN len, const char *key, SV *sv, SV *pv,
- const char *type)
+ const char *type)
{
dSP;
HV *table = GvHV(PL_hintgv); /* ^H */
SPAGAIN ;
/* Check the eval first */
- if (!PL_in_eval && SvTRUE(ERRSV))
- {
+ if (!PL_in_eval && SvTRUE(ERRSV)) {
STRLEN n_a;
sv_catpv(ERRSV, "Propagated");
yyerror(SvPV(ERRSV, n_a)); /* Duplicates the message inside eval */
why2 = key;
sv = res;
goto report;
- }
+ }
- return res;
+ return res;
}
STATIC char *
d++;
if (UTF) {
e = s;
- while (e < send && isALNUM_lazy_if(e,UTF) || *e == ':') {
+ while ((e < send && isALNUM_lazy_if(e,UTF)) || *e == ':') {
e += UTF8SKIP(e);
while (e < send && *e & 0x80 && is_utf8_mark((U8*)e))
e += UTF8SKIP(e);
register char *s = start; /* current position in buffer */
register char *d; /* destination in temp buffer */
register char *e; /* end of temp buffer */
- IV tryiv; /* used to see if it can be an IV */
NV value; /* number read, as a double */
SV *sv = Nullsv; /* place to put the converted number */
bool floatit; /* boolean: int or float? */
if (*s != '_')
*d++ = *s;
}
+ if (*s == '.' && isDIGIT(s[1])) {
+ /* oops, it's really a v-string, but without the "v" */
+ s = start - 1;
+ goto vstring;
+ }
}
/* read exponent part, if present */
/* make an sv from the string */
sv = NEWSV(92,0);
+ /* unfortunately this monster needs to be on one line or
+ makedepend will be confused. */
+#if (defined(USE_64_BIT_INT) && (!defined(HAS_STRTOLL)|| !defined(HAS_STRTOULL))) || (!defined(USE_64_BIT_INT) && (!defined(HAS_STRTOL) || !defined(HAS_STRTOUL)))
+
+ /*
+ No working strto[u]l[l]. Since atoi() doesn't do range checks,
+ we need to do this the hard way.
+ */
+
value = Atof(PL_tokenbuf);
/*
Note: if floatit is true, then we don't need to do the
conversion at all.
*/
- tryiv = I_V(value);
- if (!floatit && (NV)tryiv == value)
- sv_setiv(sv, tryiv);
- else
+ {
+ UV tryuv = U_V(value);
+ if (!floatit && (NV)tryuv == value) {
+ if (tryuv <= IV_MAX)
+ sv_setiv(sv, (IV)tryuv);
+ else
+ sv_setuv(sv, tryuv);
+ }
+ else
+ sv_setnv(sv, value);
+ }
+#else
+ /*
+ strtol/strtoll sets errno to ERANGE if the number is too big
+ for an integer. We try to do an integer conversion first
+ if no characters indicating "float" have been found.
+ */
+
+ if (!floatit) {
+ IV iv;
+ UV uv;
+ errno = 0;
+ if (*PL_tokenbuf == '-')
+ iv = Strtol(PL_tokenbuf, (char**)NULL, 10);
+ else
+ uv = Strtoul(PL_tokenbuf, (char**)NULL, 10);
+ if (errno)
+ floatit = TRUE; /* probably just too large */
+ else if (*PL_tokenbuf == '-')
+ sv_setiv(sv, iv);
+ else
+ sv_setuv(sv, uv);
+ }
+ if (floatit) {
+ value = Atof(PL_tokenbuf);
sv_setnv(sv, value);
+ }
+#endif
if ( floatit ? (PL_hints & HINT_NEW_FLOAT) :
(PL_hints & HINT_NEW_INTEGER) )
sv = new_constant(PL_tokenbuf, d - PL_tokenbuf,
(floatit ? "float" : "integer"),
sv, Nullsv, NULL);
break;
- /* if it starts with a v, it could be a version number */
+
+ /* if it starts with a v, it could be a v-string */
case 'v':
+vstring:
{
char *pos = s;
pos++;
- while (isDIGIT(*pos))
+ while (isDIGIT(*pos) || *pos == '_')
pos++;
if (!isALPHA(*pos)) {
UV rev;
for (;;) {
if (*s == '0' && isDIGIT(s[1]))
yyerror("Octal number in vector unsupported");
- rev = atoi(s);
+ rev = 0;
+ {
+ /* this is atoi() that tolerates underscores */
+ char *end = pos;
+ UV mult = 1;
+ while (--end >= s) {
+ UV orev;
+ if (*end == '_')
+ continue;
+ orev = rev;
+ rev += (*end - '0') * mult;
+ mult *= 10;
+ if (orev > rev && ckWARN_d(WARN_OVERFLOW))
+ Perl_warner(aTHX_ WARN_OVERFLOW,
+ "Integer overflow in decimal number");
+ }
+ }
tmpend = uv_to_utf8(tmpbuf, rev);
utf8 = utf8 || rev > 127;
sv_catpvn(sv, (const char*)tmpbuf, tmpend - tmpbuf);
s = pos;
break;
}
- while (isDIGIT(*pos))
+ while (isDIGIT(*pos) || *pos == '_')
pos++;
}
https://perl5.git.perl.org / perl5.git / blobdiff