This is a live mirror of the Perl 5 development currently hosted at
https://github.com/perl/perl5
https://perl5.git.perl.org
/
perl5.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Replace the use Test::More in t/{op,io,run} with t/test.pl.
[perl5.git]
/
toke.c
diff --git
a/toke.c
b/toke.c
index
abb0c2d
..
af117bc
100644
(file)
--- a/
toke.c
+++ b/
toke.c
@@
-27,20
+27,23
@@
static char ident_too_long[] = "Identifier too long";
static char ident_too_long[] = "Identifier too long";
-static void restore_rsfp(pTHX
o
_ void *f);
+static void restore_rsfp(pTHX_ void *f);
#ifndef PERL_NO_UTF16_FILTER
#ifndef PERL_NO_UTF16_FILTER
-static I32 utf16_textfilter(pTHX
o
_ int idx, SV *sv, int maxlen);
-static I32 utf16rev_textfilter(pTHX
o
_ 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
#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
#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.
#endif
/* In variables named $^X, these are the legal values for X.
@@
-442,8
+445,6
@@
Perl_lex_start(pTHX_ SV *line)
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;
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;
}
PL_rsfp = 0;
}
@@
-861,10
+862,13
@@
Perl_str_to_version(pTHX_ SV *sv)
/*
* S_force_version
* Forces the next token to be a version number.
/*
* 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 *
*/
STATIC char *
-S_force_version(pTHX_ char *s)
+S_force_version(pTHX_ char *s
, int guessing
)
{
OP *version = Nullop;
char *d;
{
OP *version = Nullop;
char *d;
@@
-875,7
+879,8
@@
S_force_version(pTHX_ char *s)
if (*d == 'v')
d++;
if (isDIGIT(*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);
if (*d == ';' || isSPACE(*d) || *d == '}' || !*d) {
SV *ver;
s = scan_num(s, &yylval);
@@
-887,13
+892,15
@@
S_force_version(pTHX_ char *s)
SvNOK_on(ver); /* hint that it is a version */
}
}
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);
}
/* NOTE: The parser sees the package name and the VERSION swapped */
PL_nextval[PL_nexttoke].opval = version;
force_next(WORD);
- return
(s)
;
+ return
s
;
}
/*
}
/*
@@
-1431,8
+1438,9
@@
S_scan_const(pTHX_ char *start)
case '0': case '1': case '2': case '3':
case '4': case '5': case '6': case '7':
{
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 += len;
}
goto NUM_ESCAPE_INSERT;
@@
-1442,20
+1450,24
@@
S_scan_const(pTHX_ char *start)
++s;
if (*s == '{') {
char* e = strchr(s, '}');
++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{}");
if (!e) {
yyerror("Missing right brace on \\x{}");
- ++s;
continue;
}
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 {
{
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;
}
}
s += len;
}
}
@@
-2048,7
+2060,7
@@
Perl_filter_read(pTHX_ int idx, SV *buf_sv, int maxlen)
/* Call function. The function is expected to */
/* call "FILTER_READ(idx+1, buf_sv)" first. */
/* Return: <0:error, =0:eof, >0:not eof */
/* 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)(aTHX
o
_ idx, buf_sv, maxlen);
+ return (*funcp)(aTHX_ idx, buf_sv, maxlen);
}
STATIC char *
}
STATIC char *
@@
-2282,13
+2294,13
@@
Perl_yylex(pTHX)
if (PL_lex_dojoin) {
PL_nextval[PL_nexttoke].ival = 0;
force_next(',');
if (PL_lex_dojoin) {
PL_nextval[PL_nexttoke].ival = 0;
force_next(',');
-#ifdef USE_THREADS
+#ifdef USE_
5005
THREADS
PL_nextval[PL_nexttoke].opval = newOP(OP_THREADSV, 0);
PL_nextval[PL_nexttoke].opval->op_targ = find_threadsv("\"");
force_next(PRIVATEREF);
#else
force_ident("\"", '$');
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_
5005
THREADS */
PL_nextval[PL_nexttoke].ival = 0;
force_next('$');
PL_nextval[PL_nexttoke].ival = 0;
PL_nextval[PL_nexttoke].ival = 0;
force_next('$');
PL_nextval[PL_nexttoke].ival = 0;
@@
-3993,7
+4005,7
@@
Perl_yylex(pTHX)
if (ckWARN(WARN_RESERVED)) {
if (lastchar != '-') {
for (d = PL_tokenbuf; *d && isLOWER(*d); d++) ;
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);
}
Perl_warner(aTHX_ WARN_RESERVED, PL_warn_reserved,
PL_tokenbuf);
}
@@
-4197,7
+4209,7
@@
Perl_yylex(pTHX)
if (*s == '{')
PRETERMBLOCK(DO);
if (*s != '\'')
if (*s == '{')
PRETERMBLOCK(DO);
if (*s != '\'')
- s = force_word(s,WORD,
FALS
E,TRUE,FALSE);
+ s = force_word(s,WORD,
TRU
E,TRUE,FALSE);
OPERATOR(DO);
case KEY_die:
OPERATOR(DO);
case KEY_die:
@@
-4527,7
+4539,7
@@
Perl_yylex(pTHX)
if (PL_expect != XSTATE)
yyerror("\"no\" not allowed in expression");
s = force_word(s,WORD,FALSE,TRUE,FALSE);
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);
yylval.ival = 0;
OPERATOR(USE);
@@
-4679,10
+4691,12
@@
Perl_yylex(pTHX)
case KEY_require:
s = skipspace(s);
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))
*PL_tokenbuf = '\0';
s = force_word(s,WORD,TRUE,TRUE,FALSE);
if (isIDFIRST_lazy_if(PL_tokenbuf,UTF))
@@
-5042,15
+5056,19
@@
Perl_yylex(pTHX)
yyerror("\"use\" not allowed in expression");
s = skipspace(s);
if (isDIGIT(*s) || (*s == 'v' && isDIGIT(s[1]))) {
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);
}
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);
}
else {
s = force_word(s,WORD,FALSE,TRUE,FALSE);
- s = force_version(s);
+ s = force_version(s
, FALSE
);
}
yylval.ival = 1;
OPERATOR(USE);
}
yylval.ival = 1;
OPERATOR(USE);
@@
-5161,7
+5179,7
@@
S_pending_ident(pTHX)
*/
if (!strchr(PL_tokenbuf,':')) {
*/
if (!strchr(PL_tokenbuf,':')) {
-#ifdef USE_THREADS
+#ifdef USE_
5005
THREADS
/* Check for single character per-thread SVs */
if (PL_tokenbuf[0] == '$' && PL_tokenbuf[2] == '\0'
&& !isALPHA(PL_tokenbuf[1]) /* Rule out obvious non-threadsvs */
/* Check for single character per-thread SVs */
if (PL_tokenbuf[0] == '$' && PL_tokenbuf[2] == '\0'
&& !isALPHA(PL_tokenbuf[1]) /* Rule out obvious non-threadsvs */
@@
-5171,7
+5189,7
@@
S_pending_ident(pTHX)
yylval.opval->op_targ = tmp;
return PRIVATEREF;
}
yylval.opval->op_targ = tmp;
return PRIVATEREF;
}
-#endif /* USE_THREADS */
+#endif /* USE_
5005
THREADS */
if ((tmp = pad_findmy(PL_tokenbuf)) != NOT_IN_PAD) {
SV *namesv = AvARRAY(PL_comppad_name)[tmp];
/* might be an "our" variable" */
if ((tmp = pad_findmy(PL_tokenbuf)) != NOT_IN_PAD) {
SV *namesv = AvARRAY(PL_comppad_name)[tmp];
/* might be an "our" variable" */
@@
-6909,8
+6927,7
@@
Perl_scan_num(pTHX_ char *start, YYSTYPE* lvalp)
register char *e; /* end of temp buffer */
NV nv; /* number read, as a double */
SV *sv = Nullsv; /* place to put the converted number */
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";
char *lastub = 0; /* position of last underbar */
static char number_too_long[] = "Number too long";
@@
-6964,7
+6981,6
@@
Perl_scan_num(pTHX_ char *start, YYSTYPE* lvalp)
/* so it must be octal */
else {
shift = 3;
/* so it must be octal */
else {
shift = 3;
- octal = 1;
s++;
}
s++;
}
@@
-7318,11
+7334,8
@@
vstring:
/* make the op for the constant and return */
/* make the op for the constant and return */
- if (sv)
{
+ if (sv)
lvalp->opval = newSVOP(OP_CONST, 0, sv);
lvalp->opval = newSVOP(OP_CONST, 0, sv);
- if (octal)
- ((SVOP *)lvalp->opval)->op_private |= OPpCONST_OCTAL;
- }
else
lvalp->opval = Nullop;
else
lvalp->opval = Nullop;
@@
-7364,15
+7377,19
@@
S_scan_formline(pTHX_ register char *s)
if (*t == '@' || *t == '^')
needargs = TRUE;
}
if (*t == '@' || *t == '^')
needargs = TRUE;
}
- sv_catpvn(stuff, s, eol-s);
+ if (eol > s) {
+ sv_catpvn(stuff, s, eol-s);
#ifndef PERL_STRICT_CR
#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
#endif
+ }
+ else
+ break;
}
s = eol;
if (PL_rsfp) {
}
s = eol;
if (PL_rsfp) {
@@
-7453,11
+7470,11
@@
Perl_start_subparse(pTHX_ I32 is_format, U32 flags)
PL_min_intro_pending = 0;
PL_padix = 0;
PL_subline = CopLINE(PL_curcop);
PL_min_intro_pending = 0;
PL_padix = 0;
PL_subline = CopLINE(PL_curcop);
-#ifdef USE_THREADS
+#ifdef USE_
5005
THREADS
av_store(PL_comppad_name, 0, newSVpvn("@_", 2));
PL_curpad[0] = (SV*)newAV();
SvPADMY_on(PL_curpad[0]); /* XXX Needed? */
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_
5005
THREADS */
comppadlist = newAV();
AvREAL_off(comppadlist);
comppadlist = newAV();
AvREAL_off(comppadlist);
@@
-7466,11
+7483,11
@@
Perl_start_subparse(pTHX_ I32 is_format, U32 flags)
CvPADLIST(PL_compcv) = comppadlist;
CvOUTSIDE(PL_compcv) = (CV*)SvREFCNT_inc(outsidecv);
CvPADLIST(PL_compcv) = comppadlist;
CvOUTSIDE(PL_compcv) = (CV*)SvREFCNT_inc(outsidecv);
-#ifdef USE_THREADS
+#ifdef USE_
5005
THREADS
CvOWNER(PL_compcv) = 0;
New(666, CvMUTEXP(PL_compcv), 1, perl_mutex);
MUTEX_INIT(CvMUTEXP(PL_compcv));
CvOWNER(PL_compcv) = 0;
New(666, CvMUTEXP(PL_compcv), 1, perl_mutex);
MUTEX_INIT(CvMUTEXP(PL_compcv));
-#endif /* USE_THREADS */
+#endif /* USE_
5005
THREADS */
return oldsavestack_ix;
}
return oldsavestack_ix;
}
@@
-7645,17
+7662,13
@@
S_swallow_bom(pTHX_ U8 *s)
return (char*)s;
}
return (char*)s;
}
-#ifdef PERL_OBJECT
-#include "XSUB.h"
-#endif
-
/*
* restore_rsfp
* Restore a source filter.
*/
static void
/*
* restore_rsfp
* Restore a source filter.
*/
static void
-restore_rsfp(pTHX
o
_ void *f)
+restore_rsfp(pTHX_ void *f)
{
PerlIO *fp = (PerlIO*)f;
{
PerlIO *fp = (PerlIO*)f;
@@
-7668,7
+7681,7
@@
restore_rsfp(pTHXo_ void *f)
#ifndef PERL_NO_UTF16_FILTER
static I32
#ifndef PERL_NO_UTF16_FILTER
static I32
-utf16_textfilter(pTHX
o
_ 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) {
{
I32 count = FILTER_READ(idx+1, sv, maxlen);
if (count) {
@@
-7687,7
+7700,7
@@
utf16_textfilter(pTHXo_ int idx, SV *sv, int maxlen)
}
static I32
}
static I32
-utf16rev_textfilter(pTHX
o
_ 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) {
{
I32 count = FILTER_READ(idx+1, sv, maxlen);
if (count) {