#include "EXTERN.h"
#define PERL_IN_TOKE_C
#include "perl.h"
-#include "dquote_static.c"
+#include "dquote_inline.h"
#define new_constant(a,b,c,d,e,f,g) \
S_new_constant(aTHX_ a,b,STR_WITH_LEN(c),d,e,f, g)
will be destroyed and the former value of L</PL_parser> will be restored.
Nothing else need be done to clean up the parsing context.
-The code to be parsed comes from I<line> and I<rsfp>. I<line>, if
+The code to be parsed comes from C<line> and C<rsfp>. C<line>, if
non-null, provides a string (in SV form) containing code to be parsed.
-A copy of the string is made, so subsequent modification of I<line>
-does not affect parsing. I<rsfp>, if non-null, provides an input stream
+A copy of the string is made, so subsequent modification of C<line>
+does not affect parsing. C<rsfp>, if non-null, provides an input stream
from which code will be read to be parsed. If both are non-null, the
-code in I<line> comes first and must consist of complete lines of input,
-and I<rsfp> supplies the remainder of the source.
+code in C<line> comes first and must consist of complete lines of input,
+and C<rsfp> supplies the remainder of the source.
-The I<flags> parameter is reserved for future use. Currently it is only
+The C<flags> parameter is reserved for future use. Currently it is only
used by perl internally, so extensions should always pass zero.
=cut
if (PL_parser->lex_flags & LEX_DONT_CLOSE_RSFP)
PerlIO_clearerr(parser->rsfp);
- else if (parser->rsfp && (!parser->old_parser ||
- (parser->old_parser && parser->rsfp != parser->old_parser->rsfp)))
+ else if (parser->rsfp && (!parser->old_parser
+ || (parser->old_parser && parser->rsfp != parser->old_parser->rsfp)))
PerlIO_close(parser->rsfp);
SvREFCNT_dec(parser->rsfp_filters);
SvREFCNT_dec(parser->lex_stuff);
=for apidoc Amx|char *|lex_grow_linestr|STRLEN len
Reallocates the lexer buffer (L</PL_parser-E<gt>linestr>) to accommodate
-at least I<len> octets (including terminating C<NUL>). Returns a
+at least C<len> octets (including terminating C<NUL>). Returns a
pointer to the reallocated buffer. This is necessary before making
any direct modification of the buffer that would increase its length.
L</lex_stuff_pvn> provides a more convenient way to insert text into
uses of this facility run the risk of the inserted characters being
interpreted in an unintended manner.
-The string to be inserted is represented by I<len> octets starting
-at I<pv>. These octets are interpreted as either UTF-8 or Latin-1,
-according to whether the C<LEX_STUFF_UTF8> flag is set in I<flags>.
+The string to be inserted is represented by C<len> octets starting
+at C<pv>. These octets are interpreted as either UTF-8 or Latin-1,
+according to whether the C<LEX_STUFF_UTF8> flag is set in C<flags>.
The characters are recoded for the lexer buffer, according to how the
buffer is currently being interpreted (L</lex_bufutf8>). If a string
to be inserted is available as a Perl scalar, the L</lex_stuff_sv>
}
else {
assert(p < e -1 );
- *bufptr++ = TWO_BYTE_UTF8_TO_NATIVE(*p, *(p+1));
+ *bufptr++ = EIGHT_BIT_UTF8_TO_NATIVE(*p, *(p+1));
p += 2;
}
}
uses of this facility run the risk of the inserted characters being
interpreted in an unintended manner.
-The string to be inserted is represented by octets starting at I<pv>
+The string to be inserted is represented by octets starting at C<pv>
and continuing to the first nul. These octets are interpreted as either
UTF-8 or Latin-1, according to whether the C<LEX_STUFF_UTF8> flag is set
-in I<flags>. The characters are recoded for the lexer buffer, according
+in C<flags>. The characters are recoded for the lexer buffer, according
to how the buffer is currently being interpreted (L</lex_bufutf8>).
If it is not convenient to nul-terminate a string to be inserted, the
L</lex_stuff_pvn> function is more appropriate.
uses of this facility run the risk of the inserted characters being
interpreted in an unintended manner.
-The string to be inserted is the string value of I<sv>. The characters
+The string to be inserted is the string value of C<sv>. The characters
are recoded for the lexer buffer, according to how the buffer is currently
being interpreted (L</lex_bufutf8>). If a string to be inserted is
not already a Perl scalar, the L</lex_stuff_pvn> function avoids the
=for apidoc Amx|void|lex_unstuff|char *ptr
Discards text about to be lexed, from L</PL_parser-E<gt>bufptr> up to
-I<ptr>. Text following I<ptr> will be moved, and the buffer shortened.
+C<ptr>. Text following C<ptr> will be moved, and the buffer shortened.
This hides the discarded text from any lexing code that runs later,
as if the text had never appeared.
=for apidoc Amx|void|lex_read_to|char *ptr
Consume text in the lexer buffer, from L</PL_parser-E<gt>bufptr> up
-to I<ptr>. This advances L</PL_parser-E<gt>bufptr> to match I<ptr>,
+to C<ptr>. This advances L</PL_parser-E<gt>bufptr> to match C<ptr>,
performing the correct bookkeeping whenever a newline character is passed.
This is the normal way to consume lexed text.
=for apidoc Amx|void|lex_discard_to|char *ptr
Discards the first part of the L</PL_parser-E<gt>linestr> buffer,
-up to I<ptr>. The remaining content of the buffer will be moved, and
-all pointers into the buffer updated appropriately. I<ptr> must not
+up to C<ptr>. The remaining content of the buffer will be moved, and
+all pointers into the buffer updated appropriately. C<ptr> must not
be later in the buffer than the position of L</PL_parser-E<gt>bufptr>:
it is not permitted to discard text that has yet to be lexed.
If L</PL_parser-E<gt>bufptr> is pointing to the very end of the current
chunk (i.e., the current chunk has been entirely consumed), normally the
current chunk will be discarded at the same time that the new chunk is
-read in. If I<flags> includes C<LEX_KEEP_PREVIOUS>, the current chunk
+read in. If C<flags> has the C<LEX_KEEP_PREVIOUS> bit set, the current chunk
will not be discarded. If the current chunk has not been entirely
consumed, then it will not be discarded regardless of the flag.
return FALSE;
linestr = PL_parser->linestr;
buf = SvPVX(linestr);
- if (!(flags & LEX_KEEP_PREVIOUS) &&
- PL_parser->bufptr == PL_parser->bufend) {
+ if (!(flags & LEX_KEEP_PREVIOUS)
+ && PL_parser->bufptr == PL_parser->bufend)
+ {
old_bufend_pos = bufptr_pos = oldbufptr_pos = oldoldbufptr_pos = 0;
linestart_pos = 0;
if (PL_parser->last_uni != PL_parser->bufend)
CopLINE_set(PL_curcop, PL_parser->preambling + 1);
PL_parser->preambling = NOLINE;
}
- if (got_some_for_debugger && (PERLDB_LINE || PERLDB_SAVESRC) &&
- PL_curstash != PL_debstash) {
+ if ( got_some_for_debugger
+ && PERLDB_LINE_OR_SAVESRC
+ && PL_curstash != PL_debstash)
+ {
/* debugger active and we're not compiling the debugger code,
* so store the line into the debugger's array of lines
*/
If the next character is in (or extends into) the next chunk of input
text, the next chunk will be read in. Normally the current chunk will be
-discarded at the same time, but if I<flags> includes C<LEX_KEEP_PREVIOUS>
-then the current chunk will not be discarded.
+discarded at the same time, but if C<flags> has the C<LEX_KEEP_PREVIOUS>
+bit set, then the current chunk will not be discarded.
If the input is being interpreted as UTF-8 and a UTF-8 encoding error
is encountered, an exception is generated.
If the next character is in (or extends into) the next chunk of input
text, the next chunk will be read in. Normally the current chunk will be
-discarded at the same time, but if I<flags> includes C<LEX_KEEP_PREVIOUS>
-then the current chunk will not be discarded.
+discarded at the same time, but if C<flags> has the C<LEX_KEEP_PREVIOUS>
+bit set, then the current chunk will not be discarded.
If the input is being interpreted as UTF-8 and a UTF-8 encoding error
is encountered, an exception is generated.
If spaces extend into the next chunk of input text, the next chunk will
be read in. Normally the current chunk will be discarded at the same
-time, but if I<flags> includes C<LEX_KEEP_PREVIOUS> then the current
+time, but if C<flags> has the C<LEX_KEEP_PREVIOUS> bit set, then the current
chunk will not be discarded.
=cut
in_brackets = TRUE;
else if (*p == ']')
in_brackets = FALSE;
- else if ((*p == '@' || *p == '%') &&
- !after_slash &&
- !in_brackets ) {
+ else if ((*p == '@' || *p == '%')
+ && !after_slash
+ && !in_brackets )
+ {
must_be_last = TRUE;
greedy_proto = *p;
}
PL_last_uni++;
s = PL_last_uni;
while (isWORDCHAR_lazy_if(s,UTF) || *s == '-')
- s++;
+ s += UTF ? UTF8SKIP(s) : 1;
if ((t = strchr(s, '(')) && t < PL_bufptr)
return;
Perl_ck_warner_d(aTHX_ packWARN(WARN_AMBIGUOUS),
- "Warning: Use of \"%.*s\" without parentheses is ambiguous",
- (int)(s - PL_last_uni), PL_last_uni);
+ "Warning: Use of \"%"UTF8f"\" without parentheses is ambiguous",
+ UTF8fARG(UTF, (int)(s - PL_last_uni), PL_last_uni));
}
/*
start = skipspace(start);
s = start;
- if (isIDFIRST_lazy_if(s,UTF) ||
- (allow_pack && *s == ':') )
+ if (isIDFIRST_lazy_if(s,UTF)
+ || (allow_pack && *s == ':') )
{
s = scan_word(s, PL_tokenbuf, sizeof PL_tokenbuf, allow_pack, &len);
if (check_keyword) {
s = (char *)scan_version(s, ver, 0);
version = newSVOP(OP_CONST, 0, ver);
}
- else if ( (*s != ';' && *s != '{' && *s != '}' ) &&
- (s = skipspace(s), (*s != ';' && *s != '{' && *s != '}' )))
+ else if ((*s != ';' && *s != '{' && *s != '}' )
+ && (s = skipspace(s), (*s != ';' && *s != '{' && *s != '}' )))
{
PL_bufptr = s;
if (errstr)
SAVEI32(PL_lex_casemods);
SAVEI32(PL_lex_starts);
SAVEI8(PL_lex_state);
+ SAVEI8(PL_lex_defer);
SAVESPTR(PL_lex_repl);
SAVEVPTR(PL_lex_inpat);
SAVEI16(PL_lex_inwhat);
/* We deliberately don't try to print the malformed character, which
* might not print very well; it also may be just the first of many
* malformations, so don't print what comes after it */
- yyerror(Perl_form(aTHX_
+ yyerror_pv(Perl_form(aTHX_
"Malformed UTF-8 character immediately after '%.*s'",
- (int) (first_bad_char_loc - (U8 *) backslash_ptr), backslash_ptr));
+ (int) (first_bad_char_loc - (U8 *) backslash_ptr), backslash_ptr),
+ SVf_UTF8);
return NULL;
}
}
s++;
} else if (UTF8_IS_DOWNGRADEABLE_START(*s)) {
- if (! isALPHAU(TWO_BYTE_UTF8_TO_NATIVE(*s, *(s+1)))) {
+ if (! isALPHAU(EIGHT_BIT_UTF8_TO_NATIVE(*s, *(s+1)))) {
goto bad_charname;
}
s += 2;
s++;
}
else if (UTF8_IS_DOWNGRADEABLE_START(*s)) {
- if (! isCHARNAME_CONT(TWO_BYTE_UTF8_TO_NATIVE(*s, *(s+1))))
+ if (! isCHARNAME_CONT(EIGHT_BIT_UTF8_TO_NATIVE(*s, *(s+1))))
{
goto bad_charname;
}
\l \L \u \U \Q \E
(?{ or (??{
-
In transliterations:
characters are VERY literal, except for - not at the start or end
of the string, which indicates a range. If the range is in bytes,
#ifdef EBCDIC
/* Because of the discontinuities in EBCDIC A-Z and a-z, expand
* any subsets of these ranges into individual characters */
- if (literal_endpoint == 2 &&
- ((isLOWER_A(min) && isLOWER_A(max)) ||
- (isUPPER_A(min) && isUPPER_A(max))))
+ if (literal_endpoint == 2
+ && ((isLOWER_A(min) && isLOWER_A(max))
+ || (isUPPER_A(min) && isUPPER_A(max))))
{
for (i = min; i <= max; i++) {
if (isALPHA_A(i))
}
}
- /* if we get here, we're not doing a transliteration */
+ /* if we get to any of these else's, we're not doing a
+ * transliteration. */
else if (*s == '[' && PL_lex_inpat && !in_charclass) {
char *s1 = s-1;
while (s+1 < send && *s != ')')
*d++ = *s++;
}
- else if (!PL_lex_casemods &&
- ( s[2] == '{' /* This should match regcomp.c */
- || (s[2] == '?' && s[3] == '{')))
+ else if (!PL_lex_casemods
+ && ( s[2] == '{' /* This should match regcomp.c */
+ || (s[2] == '?' && s[3] == '{')))
{
break;
}
}
/* likewise skip #-initiated comments in //x patterns */
- else if (*s == '#' && PL_lex_inpat && !in_charclass &&
- ((PMOP*)PL_lex_inpat)->op_pmflags & RXf_PMf_EXTENDED) {
+ else if (*s == '#'
+ && PL_lex_inpat
+ && !in_charclass
+ && ((PMOP*)PL_lex_inpat)->op_pmflags & RXf_PMf_EXTENDED)
+ {
while (s+1 < send && *s != '\n')
*d++ = *s++;
}
/* warn on \1 - \9 in substitution replacements, but note that \11
* is an octal; and \19 is \1 followed by '9' */
- if (PL_lex_inwhat == OP_SUBST && !PL_lex_inpat &&
- isDIGIT(*s) && *s != '0' && !isDIGIT(s[1]))
+ if (PL_lex_inwhat == OP_SUBST
+ && !PL_lex_inpat
+ && isDIGIT(*s)
+ && *s != '0'
+ && !isDIGIT(s[1]))
{
/* diag_listed_as: \%d better written as $%d */
Perl_ck_warner(aTHX_ packWARN(WARN_SYNTAX), "\\%c better written as $%c", *s, *s);
*d = '\0';
/* See Note on sizing above. */
sv_utf8_upgrade_flags_grow(
- sv,
- SV_GMAGIC|SV_FORCE_UTF8_UPGRADE
+ sv,
+ SV_GMAGIC|SV_FORCE_UTF8_UPGRADE
/* Above-latin1 in string
* implies no encoding */
|SV_UTF8_NO_ENCODING,
- UNISKIP(uv) + (STRLEN)(send - s) + 1);
+ UVCHR_SKIP(uv) + (STRLEN)(send - s) + 1);
d = SvPVX(sv) + SvCUR(sv);
has_utf8 = TRUE;
}
if (has_utf8) {
d = (char*)uvchr_to_utf8((U8*)d, uv);
- if (PL_lex_inwhat == OP_TRANS &&
- PL_sublex_info.sub_op) {
+ if (PL_lex_inwhat == OP_TRANS
+ && PL_sublex_info.sub_op)
+ {
PL_sublex_info.sub_op->op_private |=
(PL_lex_repl ? OPpTRANS_FROM_UTF
: OPpTRANS_TO_UTF);
*d = '\0';
/* See Note on sizing above. */
sv_utf8_upgrade_flags_grow(
- sv,
- SV_GMAGIC|SV_FORCE_UTF8_UPGRADE,
- UNISKIP(uv) + (STRLEN)(send - e) + 1);
+ sv,
+ SV_GMAGIC|SV_FORCE_UTF8_UPGRADE,
+ UVCHR_SKIP(uv) + (STRLEN)(send - e) + 1);
d = SvPVX(sv) + SvCUR(sv);
has_utf8 = TRUE;
}
const UV nextuv = (this_utf8)
? utf8n_to_uvchr((U8*)s, send - s, &len, 0)
: (UV) ((U8) *s);
- const STRLEN need = UNISKIP(nextuv);
+ const STRLEN need = UVCHR_SKIP(nextuv);
if (!has_utf8) {
SvCUR_set(sv, d - SvPVX_const(sv));
SvPOK_on(sv);
else
weight -= 10;
}
- else if (*s == '$' && s[1] &&
- strchr("[#!%*<>()-=",s[1])) {
+ else if (*s == '$'
+ && s[1]
+ && strchr("[#!%*<>()-=",s[1]))
+ {
if (/*{*/ strchr("])} =",s[2]))
weight -= 10;
else
}
if (*start == '$') {
- if (cv || PL_last_lop_op == OP_PRINT || PL_last_lop_op == OP_SAY ||
- isUPPER(*PL_tokenbuf))
+ if (cv || PL_last_lop_op == OP_PRINT || PL_last_lop_op == OP_SAY
+ || isUPPER(*PL_tokenbuf))
return 0;
s = skipspace(s);
PL_bufptr = start;
if (len == 11 && *pkgname == '_' && strEQ(pkgname, "__PACKAGE__"))
return PL_curstash;
- if (len > 2 &&
- (pkgname[len - 2] == ':' && pkgname[len - 1] == ':') &&
- (gv = gv_fetchpvn_flags(pkgname, len, ( UTF ? SVf_UTF8 : 0 ), SVt_PVHV)))
+ if (len > 2
+ && (pkgname[len - 2] == ':' && pkgname[len - 1] == ':')
+ && (gv = gv_fetchpvn_flags(pkgname,
+ len,
+ ( UTF ? SVf_UTF8 : 0 ), SVt_PVHV)))
{
return GvHV(gv); /* Foo:: */
}
STATIC bool
S_word_takes_any_delimeter(char *p, STRLEN len)
{
- return (len == 1 && strchr("msyq", p[0])) ||
- (len == 2 && (
- (p[0] == 't' && p[1] == 'r') ||
- (p[0] == 'q' && strchr("qwxr", p[1]))));
+ return (len == 1 && strchr("msyq", p[0]))
+ || (len == 2
+ && ((p[0] == 't' && p[1] == 'r')
+ || (p[0] == 'q' && strchr("qwxr", p[1]))));
}
static void
I32 tmp;
if (strnEQ(s, "L\\u", 3) || strnEQ(s, "U\\l", 3))
tmp = *s, *s = s[2], s[2] = (char)tmp; /* misordered... */
- if ((*s == 'L' || *s == 'U' || *s == 'F') &&
- (strchr(PL_lex_casestack, 'L')
+ if ((*s == 'L' || *s == 'U' || *s == 'F')
+ && (strchr(PL_lex_casestack, 'L')
|| strchr(PL_lex_casestack, 'U')
- || strchr(PL_lex_casestack, 'F'))) {
+ || strchr(PL_lex_casestack, 'F')))
+ {
PL_lex_casestack[--PL_lex_casemods] = '\0';
PL_lex_allbrackets--;
return REPORT(')');
&& (!PL_parser->filtered || s+1 < PL_bufend)) {
PL_last_uni = 0;
PL_last_lop = 0;
- if (PL_lex_brackets &&
- PL_lex_brackstack[PL_lex_brackets-1] != XFAKEEOF) {
+ if (PL_lex_brackets
+ && PL_lex_brackstack[PL_lex_brackets-1] != XFAKEEOF)
+ {
yyerror((const char *)
(PL_lex_formbrack
? "Format not terminated"
PL_oldoldbufptr = PL_oldbufptr = s = PL_linestart = SvPVX(PL_linestr);
PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr);
PL_last_lop = PL_last_uni = NULL;
- if ((PERLDB_LINE || PERLDB_SAVESRC) && PL_curstash != PL_debstash)
+ if (PERLDB_LINE_OR_SAVESRC && PL_curstash != PL_debstash)
update_debugger_info(PL_linestr, NULL, 0);
goto retry;
}
s = PL_bufptr;
/* If it looks like the start of a BOM or raw UTF-16,
* check if it in fact is. */
- if (bof && PL_rsfp &&
- (*s == 0 ||
- *(U8*)s == BOM_UTF8_FIRST_BYTE ||
- *(U8*)s >= 0xFE ||
- s[1] == 0)) {
+ if (bof && PL_rsfp
+ && (*s == 0
+ || *(U8*)s == BOM_UTF8_FIRST_BYTE
+ || *(U8*)s >= 0xFE
+ || s[1] == 0))
+ {
Off_t offset = (IV)PerlIO_tell(PL_rsfp);
bof = (offset == (Off_t)SvCUR(PL_linestr));
#if defined(PERLIO_USING_CRLF) && defined(PERL_TEXTMODE_SCRIPTS)
d = instr(s,"perl -");
if (!d) {
d = instr(s,"perl");
+ if (d && d[4] == '6')
+ d = NULL;
#if defined(DOSISH)
/* avoid getting into infinite loops when shebang
* line contains "Perl" rather than "perl" */
*s = '#'; /* Don't try to parse shebang line */
}
#endif /* ALTERNATE_SHEBANG */
- if (!d &&
- *s == '#' &&
- ipathend > ipath &&
- !PL_minus_c &&
- !instr(s,"indir") &&
- instr(PL_origargv[0],"perl"))
+ if (!d
+ && *s == '#'
+ && ipathend > ipath
+ && !PL_minus_c
+ && !instr(s,"indir")
+ && instr(PL_origargv[0],"perl"))
{
dVAR;
char **newargv;
} while (argc && argv[0][0] == '-' && argv[0][1]);
init_argv_symbols(argc,argv);
}
- if (((PERLDB_LINE || PERLDB_SAVESRC) && !oldpdb) ||
- ((PL_minus_n || PL_minus_p) && !(oldn || oldp)))
+ if ( (PERLDB_LINE_OR_SAVESRC && !oldpdb)
+ || ((PL_minus_n || PL_minus_p) && !(oldn || oldp)))
/* if we have already added "LINE: while (<>) {",
we must not do it again */
{
PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr);
PL_last_lop = PL_last_uni = NULL;
PL_preambled = FALSE;
- if (PERLDB_LINE || PERLDB_SAVESRC)
+ if (PERLDB_LINE_OR_SAVESRC)
(void)gv_fetchfile(PL_origfilename);
goto retry;
}
goto retry;
case '#':
case '\n':
- if (PL_lex_state != LEX_NORMAL ||
- (PL_in_eval && !PL_rsfp && !PL_parser->filtered)) {
+ if (PL_lex_state != LEX_NORMAL
+ || (PL_in_eval && !PL_rsfp && !PL_parser->filtered))
+ {
const bool in_comment = *s == '#';
if (*s == '#' && s == PL_linestart && PL_in_eval
&& !PL_rsfp && !PL_parser->filtered) {
else if (*s == '>') {
s++;
s = skipspace(s);
- if (FEATURE_POSTDEREF_IS_ENABLED && (
- ((*s == '$' || *s == '&') && s[1] == '*')
+ if (((*s == '$' || *s == '&') && s[1] == '*')
||(*s == '$' && s[1] == '#' && s[2] == '*')
||((*s == '@' || *s == '%') && strchr("*[{", s[1]))
||(*s == '*' && (s[1] == '*' || s[1] == '{'))
- ))
+ )
{
- Perl_ck_warner_d(aTHX_
- packWARN(WARN_EXPERIMENTAL__POSTDEREF),
- "Postfix dereference is experimental"
- );
PL_expect = XPOSTDEREF;
TOKEN(ARROW);
}
TERM(ARROW);
}
if (PL_expect == XOPERATOR) {
- if (*s == '=' && !PL_lex_allbrackets &&
- PL_lex_fakeeof >= LEX_FAKEEOF_ASSIGN) {
+ if (*s == '='
+ && !PL_lex_allbrackets
+ && PL_lex_fakeeof >= LEX_FAKEEOF_ASSIGN)
+ {
s--;
TOKEN(0);
}
OPERATOR(PREINC);
}
if (PL_expect == XOPERATOR) {
- if (*s == '=' && !PL_lex_allbrackets &&
- PL_lex_fakeeof >= LEX_FAKEEOF_ASSIGN) {
+ if (*s == '='
+ && !PL_lex_allbrackets
+ && PL_lex_fakeeof >= LEX_FAKEEOF_ASSIGN)
+ {
s--;
TOKEN(0);
}
s++;
if (*s == '*') {
s++;
- if (*s == '=' && !PL_lex_allbrackets &&
- PL_lex_fakeeof >= LEX_FAKEEOF_ASSIGN) {
+ if (*s == '=' && !PL_lex_allbrackets
+ && PL_lex_fakeeof >= LEX_FAKEEOF_ASSIGN)
+ {
s -= 2;
TOKEN(0);
}
PWop(OP_POW);
}
- if (*s == '=' && !PL_lex_allbrackets &&
- PL_lex_fakeeof >= LEX_FAKEEOF_ASSIGN) {
+ if (*s == '='
+ && !PL_lex_allbrackets
+ && PL_lex_fakeeof >= LEX_FAKEEOF_ASSIGN)
+ {
s--;
TOKEN(0);
}
case '%':
{
if (PL_expect == XOPERATOR) {
- if (s[1] == '=' && !PL_lex_allbrackets &&
- PL_lex_fakeeof >= LEX_FAKEEOF_ASSIGN)
+ if (s[1] == '='
+ && !PL_lex_allbrackets
+ && PL_lex_fakeeof >= LEX_FAKEEOF_ASSIGN)
+ {
TOKEN(0);
+ }
++s;
PL_parser->saw_infix_sigil = 1;
Mop(OP_MODULO);
/* XXX losing whitespace on sequential attributes here */
}
{
- if (*s != ';' && *s != '}' &&
- !(PL_expect == XOPERATOR
- ? (*s == '=' || *s == ')')
- : (*s == '{' || *s == '('))) {
+ if (*s != ';'
+ && *s != '}'
+ && !(PL_expect == XOPERATOR
+ ? (*s == '=' || *s == ')')
+ : (*s == '{' || *s == '(')))
+ {
const char q = ((*s == '\'') ? '"' : '\'');
/* If here for an expression, and parsed no attrs, back
off. */
{
const char tmp = *s++;
if (tmp == '=') {
- if (!PL_lex_allbrackets &&
- PL_lex_fakeeof >= LEX_FAKEEOF_COMPARE) {
+ if (!PL_lex_allbrackets
+ && PL_lex_fakeeof >= LEX_FAKEEOF_COMPARE)
+ {
s -= 2;
TOKEN(0);
}
Eop(OP_EQ);
}
if (tmp == '>') {
- if (!PL_lex_allbrackets &&
- PL_lex_fakeeof >= LEX_FAKEEOF_COMMA) {
+ if (!PL_lex_allbrackets
+ && PL_lex_fakeeof >= LEX_FAKEEOF_COMMA)
+ {
s -= 2;
TOKEN(0);
}
Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
"Reversed %c= operator",(int)tmp);
s--;
- if (PL_expect == XSTATE && isALPHA(tmp) &&
- (s == PL_linestart+1 || s[-2] == '\n') )
+ if (PL_expect == XSTATE
+ && isALPHA(tmp)
+ && (s == PL_linestart+1 || s[-2] == '\n') )
{
if ((PL_in_eval && !PL_rsfp && !PL_parser->filtered)
|| PL_lex_state != LEX_NORMAL) {
while (t < PL_bufend && isSPACE(*t))
++t;
- if (*t == '/' || *t == '?' ||
- ((*t == 'm' || *t == 's' || *t == 'y')
- && !isWORDCHAR(t[1])) ||
- (*t == 't' && t[1] == 'r' && !isWORDCHAR(t[2])))
+ if (*t == '/' || *t == '?'
+ || ((*t == 'm' || *t == 's' || *t == 'y')
+ && !isWORDCHAR(t[1]))
+ || (*t == 't' && t[1] == 'r' && !isWORDCHAR(t[2])))
Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
"!=~ should be !~");
}
- if (!PL_lex_allbrackets &&
- PL_lex_fakeeof >= LEX_FAKEEOF_COMPARE) {
+ if (!PL_lex_allbrackets
+ && PL_lex_fakeeof >= LEX_FAKEEOF_COMPARE)
+ {
s -= 2;
TOKEN(0);
}
{
char tmp = *s++;
if (tmp == '<') {
- if (*s == '=' && !PL_lex_allbrackets &&
- PL_lex_fakeeof >= LEX_FAKEEOF_ASSIGN) {
+ if (*s == '=' && !PL_lex_allbrackets
+ && PL_lex_fakeeof >= LEX_FAKEEOF_ASSIGN)
+ {
s -= 2;
TOKEN(0);
}
if (tmp == '=') {
tmp = *s++;
if (tmp == '>') {
- if (!PL_lex_allbrackets &&
- PL_lex_fakeeof >= LEX_FAKEEOF_COMPARE) {
+ if (!PL_lex_allbrackets
+ && PL_lex_fakeeof >= LEX_FAKEEOF_COMPARE)
+ {
s -= 3;
TOKEN(0);
}
Eop(OP_NCMP);
}
s--;
- if (!PL_lex_allbrackets &&
- PL_lex_fakeeof >= LEX_FAKEEOF_COMPARE) {
+ if (!PL_lex_allbrackets
+ && PL_lex_fakeeof >= LEX_FAKEEOF_COMPARE)
+ {
s -= 2;
TOKEN(0);
}
{
const char tmp = *s++;
if (tmp == '>') {
- if (*s == '=' && !PL_lex_allbrackets &&
- PL_lex_fakeeof >= LEX_FAKEEOF_ASSIGN) {
+ if (*s == '=' && !PL_lex_allbrackets
+ && PL_lex_fakeeof >= LEX_FAKEEOF_ASSIGN)
+ {
s -= 2;
TOKEN(0);
}
SHop(OP_RIGHT_SHIFT);
}
else if (tmp == '=') {
- if (!PL_lex_allbrackets &&
- PL_lex_fakeeof >= LEX_FAKEEOF_COMPARE) {
+ if (!PL_lex_allbrackets
+ && PL_lex_fakeeof >= LEX_FAKEEOF_COMPARE)
+ {
s -= 2;
TOKEN(0);
}
PL_tokenbuf[0] = '@';
s = scan_ident(s + 1, PL_tokenbuf + 1,
sizeof PL_tokenbuf - 1, FALSE);
- if (PL_expect == XOPERATOR)
- no_op("Array length", s);
+ if (PL_expect == XOPERATOR) {
+ d = s;
+ if (PL_bufptr > s) {
+ d = PL_bufptr-1;
+ PL_bufptr = PL_oldbufptr;
+ }
+ no_op("Array length", d);
+ }
if (!PL_tokenbuf[1])
PREREF(DOLSHARP);
PL_expect = XOPERATOR;
char *t = s+1;
while (isSPACE(*t) || isWORDCHAR_lazy_if(t,UTF) || *t == '$')
- t++;
+ t += UTF ? UTF8SKIP(t) : 1;
if (*t++ == ',') {
PL_bufptr = skipspace(PL_bufptr); /* XXX can realloc */
while (t < PL_bufend && *t != ']')
t++;
Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
- "Multidimensional syntax %.*s not supported",
- (int)((t - PL_bufptr) + 1), PL_bufptr);
+ "Multidimensional syntax %"UTF8f" not supported",
+ UTF8fARG(UTF,(int)((t - PL_bufptr) + 1), PL_bufptr));
}
}
}
}
else if (PL_expect == XOPERATOR) {
s++;
- if (*s == '=' && !PL_lex_allbrackets &&
- PL_lex_fakeeof >= LEX_FAKEEOF_ASSIGN) {
+ if (*s == '=' && !PL_lex_allbrackets
+ && PL_lex_fakeeof >= LEX_FAKEEOF_ASSIGN)
+ {
s--;
TOKEN(0);
}
case '?': /* conditional */
s++;
- if (!PL_lex_allbrackets &&
- PL_lex_fakeeof >= LEX_FAKEEOF_IFELSE) {
+ if (!PL_lex_allbrackets
+ && PL_lex_fakeeof >= LEX_FAKEEOF_IFELSE)
+ {
s--;
TOKEN(0);
}
if (PL_expect == XOPERATOR || !isDIGIT(s[1])) {
char tmp = *s++;
if (*s == tmp) {
- if (!PL_lex_allbrackets &&
- PL_lex_fakeeof >= LEX_FAKEEOF_RANGE) {
+ if (!PL_lex_allbrackets
+ && PL_lex_fakeeof >= LEX_FAKEEOF_RANGE)
+ {
s--;
TOKEN(0);
}
pl_yylval.ival = 0;
OPERATOR(DOTDOT);
}
- if (*s == '=' && !PL_lex_allbrackets &&
- PL_lex_fakeeof >= LEX_FAKEEOF_ASSIGN) {
+ if (*s == '=' && !PL_lex_allbrackets
+ && PL_lex_fakeeof >= LEX_FAKEEOF_ASSIGN)
+ {
s--;
TOKEN(0);
}
case '`':
s = scan_str(s,FALSE,FALSE,FALSE,NULL);
- DEBUG_T( { printbuf("### Saw backtick string before %s\n", s); } );
+ DEBUG_T( {
+ if (s)
+ printbuf("### Saw backtick string before %s\n", s);
+ else
+ PerlIO_printf(Perl_debug_log,
+ "### Saw unterminated backtick string\n");
+ } );
if (PL_expect == XOPERATOR)
no_op("Backticks",s);
if (!s)
CV *cv;
if ((gv = gv_fetchpvn_flags(PL_tokenbuf, len,
(UTF ? SVf_UTF8 : 0)|GV_NOTQUAL,
- SVt_PVCV)) &&
- (cv = GvCVu(gv)))
+ SVt_PVCV))
+ && (cv = GvCVu(gv)))
{
if (GvIMPORTED_CV(gv))
ogv = gv;
else if (! CvMETHOD(cv))
hgv = gv;
}
- if (!ogv &&
- (gvp = (GV**)hv_fetch(PL_globalstash, PL_tokenbuf,
- len, FALSE)) &&
- (gv = *gvp) && (
- isGV_with_GP(gv)
- ? GvCVu(gv) && GvIMPORTED_CV(gv)
- : SvPCS_IMPORTED(gv)
- && (gv_init(gv, PL_globalstash, PL_tokenbuf,
- len, 0), 1)
- ))
+ if (!ogv
+ && (gvp = (GV**)hv_fetch(PL_globalstash, PL_tokenbuf,
+ len, FALSE))
+ && (gv = *gvp)
+ && (isGV_with_GP(gv)
+ ? GvCVu(gv) && GvIMPORTED_CV(gv)
+ : SvPCS_IMPORTED(gv)
+ && (gv_init(gv, PL_globalstash, PL_tokenbuf,
+ len, 0), 1)))
{
ogv = gv;
}
in which case Foo is a bareword
(and a package name). */
- if (len > 2 &&
- PL_tokenbuf[len - 2] == ':' && PL_tokenbuf[len - 1] == ':')
+ if (len > 2
+ && PL_tokenbuf[len - 2] == ':'
+ && PL_tokenbuf[len - 1] == ':')
{
if (ckWARN(WARN_BAREWORD)
&& ! gv_fetchpvn_flags(PL_tokenbuf, len, UTF ? SVf_UTF8 : 0, SVt_PVHV))
/* See if it's the indirect object for a list operator. */
- if (PL_oldoldbufptr &&
- PL_oldoldbufptr < PL_bufptr &&
- (PL_oldoldbufptr == PL_last_lop
- || PL_oldoldbufptr == PL_last_uni) &&
- /* NO SKIPSPACE BEFORE HERE! */
- (PL_expect == XREF ||
- ((PL_opargs[PL_last_lop_op] >> OASHIFT)& 7) == OA_FILEREF))
+ if (PL_oldoldbufptr
+ && PL_oldoldbufptr < PL_bufptr
+ && (PL_oldoldbufptr == PL_last_lop
+ || PL_oldoldbufptr == PL_last_uni)
+ && /* NO SKIPSPACE BEFORE HERE! */
+ (PL_expect == XREF
+ || ((PL_opargs[PL_last_lop_op] >> OASHIFT)& 7)
+ == OA_FILEREF))
{
bool immediate_paren = *s == '(';
/* Two barewords in a row may indicate method call. */
- if ((isIDFIRST_lazy_if(s,UTF) || *s == '$') &&
- (tmp = intuit_method(s, lex ? NULL : sv, cv))) {
+ if ((isIDFIRST_lazy_if(s,UTF) || *s == '$')
+ && (tmp = intuit_method(s, lex ? NULL : sv, cv)))
+ {
goto method;
}
/* Also, if "_" follows a filetest operator, it's a bareword */
if (
- ( !immediate_paren && (PL_last_lop_op == OP_SORT ||
- (!cv &&
- (PL_last_lop_op != OP_MAPSTART &&
- PL_last_lop_op != OP_GREPSTART))))
+ ( !immediate_paren && (PL_last_lop_op == OP_SORT
+ || (!cv
+ && (PL_last_lop_op != OP_MAPSTART
+ && PL_last_lop_op != OP_GREPSTART))))
|| (PL_tokenbuf[0] == '_' && PL_tokenbuf[1] == '\0'
- && ((PL_opargs[PL_last_lop_op] & OA_CLASS_MASK) == OA_FILESTATOP))
+ && ((PL_opargs[PL_last_lop_op] & OA_CLASS_MASK)
+ == OA_FILESTATOP))
)
{
PL_expect = (PL_last_lop == PL_oldoldbufptr) ? XTERM : XOPERATOR;
op_free(rv2cv_op);
PL_last_lop = PL_oldbufptr;
PL_last_lop_op = OP_METHOD;
- if (!PL_lex_allbrackets &&
- PL_lex_fakeeof > LEX_FAKEEOF_LOWLOGIC)
+ if (!PL_lex_allbrackets
+ && PL_lex_fakeeof > LEX_FAKEEOF_LOWLOGIC)
+ {
PL_lex_fakeeof = LEX_FAKEEOF_LOWLOGIC;
+ }
PL_expect = XBLOCKTERM;
PL_bufptr = s;
return REPORT(METHOD);
else SvUTF8_off(sv);
}
op_free(rv2cv_op);
- if (tmp == METHOD && !PL_lex_allbrackets &&
- PL_lex_fakeeof > LEX_FAKEEOF_LOWLOGIC)
+ if (tmp == METHOD && !PL_lex_allbrackets
+ && PL_lex_fakeeof > LEX_FAKEEOF_LOWLOGIC)
+ {
PL_lex_fakeeof = LEX_FAKEEOF_LOWLOGIC;
+ }
return REPORT(tmp);
}
sv_setpvs(PL_subname, "__ANON__");
else
sv_setpvs(PL_subname, "__ANON__::__ANON__");
- if (!PL_lex_allbrackets &&
- PL_lex_fakeeof > LEX_FAKEEOF_LOWLOGIC)
+ if (!PL_lex_allbrackets
+ && PL_lex_fakeeof > LEX_FAKEEOF_LOWLOGIC)
+ {
PL_lex_fakeeof = LEX_FAKEEOF_LOWLOGIC;
+ }
PREBLOCK(LSTOPSUB);
}
}
NEXTVAL_NEXTTOKE.opval = pl_yylval.opval;
PL_expect = XTERM;
force_next(off ? PRIVATEREF : WORD);
- if (!PL_lex_allbrackets &&
- PL_lex_fakeeof > LEX_FAKEEOF_LOWLOGIC)
+ if (!PL_lex_allbrackets
+ && PL_lex_fakeeof > LEX_FAKEEOF_LOWLOGIC)
+ {
PL_lex_fakeeof = LEX_FAKEEOF_LOWLOGIC;
+ }
TOKEN(NOAMP);
}
if (!GvIO(gv))
GvIOp(gv) = newIO();
IoIFP(GvIOp(gv)) = PL_rsfp;
-#if defined(HAS_FCNTL) && defined(F_SETFD)
+#if defined(HAS_FCNTL) && defined(F_SETFD) && defined(FD_CLOEXEC)
{
const int fd = PerlIO_fileno(PL_rsfp);
- fcntl(fd,F_SETFD,fd >= 3);
+ if (fd >= 3) {
+ fcntl(fd,F_SETFD, FD_CLOEXEC);
+ }
}
#endif
/* Mark this internal pseudo-handle as clean */
if (PL_expect == XSTATE && isIDFIRST_lazy_if(s,UTF)) {
char *p = s;
- if ((PL_bufend - p) >= 3 &&
- strnEQ(p, "my", 2) && isSPACE(*(p + 2)))
+ if ((PL_bufend - p) >= 3
+ && strnEQ(p, "my", 2) && isSPACE(*(p + 2)))
+ {
p += 2;
- else if ((PL_bufend - p) >= 4 &&
- strnEQ(p, "our", 3) && isSPACE(*(p + 3)))
+ }
+ else if ((PL_bufend - p) >= 4
+ && strnEQ(p, "our", 3) && isSPACE(*(p + 3)))
p += 3;
p = skipspace(p);
/* skip optional package name, as in "for my abc $x (..)" */
case KEY_our:
case KEY_my:
case KEY_state:
+ if (PL_in_my) {
+ yyerror(Perl_form(aTHX_
+ "Can't redeclare \"%s\" in \"%s\"",
+ tmp == KEY_my ? "my" :
+ tmp == KEY_state ? "state" : "our",
+ PL_in_my == KEY_my ? "my" :
+ PL_in_my == KEY_state ? "state" : "our"));
+ }
PL_in_my = (U16)tmp;
s = skipspace(s);
if (isIDFIRST_lazy_if(s,UTF)) {
if (*s == '(' || (s = skipspace(s), *s == '('))
FUN1(OP_NOT);
else {
- if (!PL_lex_allbrackets &&
- PL_lex_fakeeof > LEX_FAKEEOF_LOWLOGIC)
+ if (!PL_lex_allbrackets
+ && PL_lex_fakeeof > LEX_FAKEEOF_LOWLOGIC)
+ {
PL_lex_fakeeof = LEX_FAKEEOF_LOWLOGIC;
+ }
OPERATOR(NOTOP);
}
d = s;
s = skipspace(s);
- if (isIDFIRST_lazy_if(s,UTF) || *s == '\'' ||
- (*s == ':' && s[1] == ':'))
+ if (isIDFIRST_lazy_if(s,UTF)
+ || *s == '\''
+ || (*s == ':' && s[1] == ':'))
{
PL_expect = XBLOCK;
if (*s == ':' && s[1] != ':')
PL_expect = attrful;
- else if ((*s != '{' && *s != '(') && key == KEY_sub) {
+ else if ((*s != '{' && *s != '(') && key != KEY_format) {
+ assert(key == KEY_sub || key == KEY_AUTOLOAD ||
+ key == KEY_DESTROY || key == KEY_BEGIN ||
+ key == KEY_UNITCHECK || key == KEY_CHECK ||
+ key == KEY_INIT || key == KEY_END ||
+ key == KEY_my || key == KEY_state ||
+ key == KEY_our);
if (!have_name)
Perl_croak(aTHX_ "Illegal declaration of anonymous subroutine");
else if (*s != ';' && *s != '}')
case KEY_x:
if (PL_expect == XOPERATOR) {
- if (*s == '=' && !PL_lex_allbrackets &&
- PL_lex_fakeeof >= LEX_FAKEEOF_ASSIGN)
+ if (*s == '=' && !PL_lex_allbrackets
+ && PL_lex_fakeeof >= LEX_FAKEEOF_ASSIGN)
+ {
return REPORT(0);
+ }
Mop(OP_REPEAT);
}
check_uni();
and @foo isn't a variable we can find in the symbol
table.
*/
- if (ckWARN(WARN_AMBIGUOUS) &&
- pit == '@' && PL_lex_state != LEX_NORMAL && !PL_lex_brackets) {
+ if (ckWARN(WARN_AMBIGUOUS)
+ && pit == '@'
+ && PL_lex_state != LEX_NORMAL
+ && !PL_lex_brackets)
+ {
GV *const gv = gv_fetchpvn_flags(PL_tokenbuf + 1, tokenbuf_len - 1,
( UTF ? SVf_UTF8 : 0 ), SVt_PVAV);
if ((!gv || ((PL_tokenbuf[0] == '@') ? !GvAV(gv) : !GvHV(gv)))
/* DO NOT warn for @- and @+ */
- && !( PL_tokenbuf[2] == '\0' &&
- ( PL_tokenbuf[1] == '-' || PL_tokenbuf[1] == '+' ))
+ && !( PL_tokenbuf[2] == '\0'
+ && ( PL_tokenbuf[1] == '-' || PL_tokenbuf[1] == '+' ))
)
{
/* Downgraded from fatal to warning 20000522 mjd */
return s;
}
+/* Is the byte 'd' a legal single character identifier name? 'u' is true
+ * iff Unicode semantics are to be used. The legal ones are any of:
+ * a) all ASCII characters except:
+ * 1) control and space-type ones, like NUL, SOH, \t, and SPACE;
+ * 2) '{'
+ * The final case currently doesn't get this far in the program, so we
+ * don't test for it. If that were to change, it would be ok to allow it.
+ * c) When not under Unicode rules, any upper Latin1 character
+ * d) Otherwise, when unicode rules are used, all XIDS characters.
+ *
+ * Because all ASCII characters have the same representation whether
+ * encoded in UTF-8 or not, we can use the foo_A macros below and '\0' and
+ * '{' without knowing if is UTF-8 or not.
+ * EBCDIC already uses the rules that ASCII platforms will use after the
+ * deprecation cycle; see comment below about the deprecation. */
+#ifdef EBCDIC
+# define VALID_LEN_ONE_IDENT(s, is_utf8) \
+ (isGRAPH_A(*(s)) || ((is_utf8) \
+ ? isIDFIRST_utf8((U8*) (s)) \
+ : (isGRAPH_L1(*s) \
+ && LIKELY((U8) *(s) != LATIN1_TO_NATIVE(0xAD)))))
+#else
+# define VALID_LEN_ONE_IDENT(s, is_utf8) \
+ (isGRAPH_A(*(s)) || ((is_utf8) \
+ ? isIDFIRST_utf8((U8*) (s)) \
+ : ! isASCII_utf8((U8*) (s))))
+#endif
+
STATIC char *
S_scan_ident(pTHX_ char *s, char *dest, STRLEN destlen, I32 ck_uni)
{
*d++ = *s++;
}
}
- else {
+ else { /* See if it is a "normal" identifier */
parse_ident(&s, &d, e, 1, is_utf8);
}
*d = '\0';
PL_lex_state = LEX_INTERPENDMAYBE;
return s;
}
- if (*s == '$' && s[1] &&
- (isIDFIRST_lazy_if(s+1,is_utf8)
- || isDIGIT_A((U8)s[1])
- || s[1] == '$'
- || s[1] == '{'
- || strnEQ(s+1,"::",2)) )
+
+ /* Here, it is not a run-of-the-mill identifier name */
+
+ if (*s == '$' && s[1]
+ && (isIDFIRST_lazy_if(s+1,is_utf8)
+ || isDIGIT_A((U8)s[1])
+ || s[1] == '$'
+ || s[1] == '{'
+ || strnEQ(s+1,"::",2)) )
{
/* Dereferencing a value in a scalar variable.
The alternatives are different syntaxes for a scalar variable.
s = skipspace(s);
}
}
-
-/* Is the byte 'd' a legal single character identifier name? 'u' is true
- * iff Unicode semantics are to be used. The legal ones are any of:
- * a) all ASCII characters except:
- * 1) space-type ones, like \t and SPACE;
- 2) NUL;
- * 3) '{'
- * The final case currently doesn't get this far in the program, so we
- * don't test for it. If that were to change, it would be ok to allow it.
- * c) When not under Unicode rules, any upper Latin1 character
- * d) Otherwise, when unicode rules are used, all XIDS characters.
- *
- * Because all ASCII characters have the same representation whether
- * encoded in UTF-8 or not, we can use the foo_A macros below and '\0' and
- * '{' without knowing if is UTF-8 or not.
- * EBCDIC already uses the rules that ASCII platforms will use after the
- * deprecation cycle; see comment below about the deprecation. */
-#ifdef EBCDIC
-# define VALID_LEN_ONE_IDENT(s, is_utf8) \
- (isGRAPH_A(*(s)) || ((is_utf8) \
- ? isIDFIRST_utf8((U8*) (s)) \
- : (isGRAPH_L1(*s) \
- && LIKELY((U8) *(s) != LATIN1_TO_NATIVE(0xAD)))))
-#else
-# define VALID_LEN_ONE_IDENT(s, is_utf8) (! isSPACE_A(*(s)) \
- && LIKELY(*(s) != '\0') \
- && (! is_utf8 \
- || isASCII_utf8((U8*) (s)) \
- || isIDFIRST_utf8((U8*) (s))))
-#endif
if ((s <= PL_bufend - (is_utf8)
? UTF8SKIP(s)
: 1)
: (! isGRAPH_L1( (U8) *s)
|| UNLIKELY((U8) *(s) == LATIN1_TO_NATIVE(0xAD))))
{
- /* Split messages for back compat */
- if (isCNTRL_A( (U8) *s)) {
- deprecate("literal control characters in variable names");
- }
- else {
- deprecate("literal non-graphic characters in variable names");
- }
+ deprecate("literal non-graphic characters in variable names");
}
-
+
if (is_utf8) {
const STRLEN skip = UTF8SKIP(s);
STRLEN i;
/* if it starts as a valid identifier, assume that it is one.
(the later check for } being at the expected point will trap
cases where this doesn't pan out.) */
- d += is_utf8 ? UTF8SKIP(d) : 1;
- parse_ident(&s, &d, e, 1, is_utf8);
+ d += is_utf8 ? UTF8SKIP(d) : 1;
+ parse_ident(&s, &d, e, 1, is_utf8);
*d = '\0';
tmp_copline = CopLINE(PL_curcop);
if (s < PL_bufend && isSPACE(*s)) {
PL_expect = XREF;
}
if (PL_lex_state == LEX_NORMAL) {
- if (ckWARN(WARN_AMBIGUOUS) &&
- (keyword(dest, d - dest, 0)
- || get_cvn_flags(dest, d - dest, is_utf8 ? SVf_UTF8 : 0)))
+ if (ckWARN(WARN_AMBIGUOUS)
+ && (keyword(dest, d - dest, 0)
+ || get_cvn_flags(dest, d - dest, is_utf8
+ ? SVf_UTF8
+ : 0)))
{
SV *tmp = newSVpvn_flags( dest, d - dest,
- SVs_TEMP | (is_utf8 ? SVf_UTF8 : 0) );
+ SVs_TEMP | (is_utf8 ? SVf_UTF8 : 0) );
if (funny == '#')
funny = '@';
orig_copline = CopLINE(PL_curcop);
term = '"';
if (!isWORDCHAR_lazy_if(s,UTF))
deprecate("bare << to mean <<\"\"");
- for (; isWORDCHAR_lazy_if(s,UTF); s++) {
- if (d < e)
- *d++ = *s;
+ peek = s;
+ while (isWORDCHAR_lazy_if(peek,UTF)) {
+ peek += UTF ? UTF8SKIP(peek) : 1;
}
+ len = (peek - s >= e - d) ? (e - d) : (peek - s);
+ Copy(s, d, len, char);
+ s += len;
+ d += len;
}
if (d >= PL_tokenbuf + sizeof PL_tokenbuf - 1)
Perl_croak(aTHX_ "Delimiter for here document is too long");
linestr = shared->ls_linestr;
bufend = SvEND(linestr);
d = s;
- while (s < bufend - len + 1 &&
- memNE(s,PL_tokenbuf,len) ) {
+ while (s < bufend - len + 1
+ && memNE(s,PL_tokenbuf,len) )
+ {
if (*s++ == '\n')
++PL_parser->herelines;
}
bufend - shared->re_eval_start);
shared->re_eval_start -= s-d;
}
- if (cxstack_ix >= 0 && CxTYPE(cx) == CXt_EVAL &&
- CxOLD_OP_TYPE(cx) == OP_ENTEREVAL &&
- cx->blk_eval.cur_text == linestr)
+ if (cxstack_ix >= 0
+ && CxTYPE(cx) == CXt_EVAL
+ && CxOLD_OP_TYPE(cx) == OP_ENTEREVAL
+ && cx->blk_eval.cur_text == linestr)
{
cx->blk_eval.cur_text = newSVsv(linestr);
SvSCREAM_on(cx->blk_eval.cur_text);
PL_last_lop = PL_last_uni = NULL;
#ifndef PERL_STRICT_CR
if (PL_bufend - PL_linestart >= 2) {
- if ((PL_bufend[-2] == '\r' && PL_bufend[-1] == '\n') ||
- (PL_bufend[-2] == '\n' && PL_bufend[-1] == '\r'))
+ if ( (PL_bufend[-2] == '\r' && PL_bufend[-1] == '\n')
+ || (PL_bufend[-2] == '\n' && PL_bufend[-1] == '\r'))
{
PL_bufend[-2] = '\n';
PL_bufend--;
COPLINE_INC_WITH_HERELINES;
/* backslashes can escape the open or closing characters */
if (*s == '\\' && s+1 < PL_bufend) {
- if (!keep_bracketed_quoted &&
- ((s[1] == PL_multi_open) || (s[1] == PL_multi_close)))
+ if (!keep_bracketed_quoted
+ && ((s[1] == PL_multi_open) || (s[1] == PL_multi_close)))
{
s++;
}
#ifndef PERL_STRICT_CR
if (to - SvPVX_const(sv) >= 2) {
- if ((to[-2] == '\r' && to[-1] == '\n') ||
- (to[-2] == '\n' && to[-1] == '\r'))
+ if ( (to[-2] == '\r' && to[-1] == '\n')
+ || (to[-2] == '\n' && to[-1] == '\r'))
{
to[-2] = '\n';
to--;
hexfp_exp *= 10;
hexfp_exp += *h - '0';
#ifdef NV_MIN_EXP
- if (negexp &&
- -hexfp_exp < NV_MIN_EXP - 1) {
+ if (negexp
+ && -hexfp_exp < NV_MIN_EXP - 1) {
Perl_ck_warner(aTHX_ packWARN(WARN_OVERFLOW),
"Hexadecimal float: exponent underflow");
-#endif
break;
}
- else {
+#endif
#ifdef NV_MAX_EXP
- if (!negexp &&
- hexfp_exp > NV_MAX_EXP - 1) {
- Perl_ck_warner(aTHX_ packWARN(WARN_OVERFLOW),
+ if (!negexp
+ && hexfp_exp > NV_MAX_EXP - 1) {
+ Perl_ck_warner(aTHX_ packWARN(WARN_OVERFLOW),
"Hexadecimal float: exponent overflow");
- break;
- }
-#endif
+ break;
}
+#endif
}
h++;
}
}
/* read next group of digits and _ and copy into d */
- while (isDIGIT(*s) || *s == '_' ||
- UNLIKELY(hexfp && isXDIGIT(*s))) {
+ while (isDIGIT(*s)
+ || *s == '_'
+ || UNLIKELY(hexfp && isXDIGIT(*s)))
+ {
/* skip underscores, checking for misplaced ones
if -w is on
*/
/* copy, ignoring underbars, until we run out of digits.
*/
- for (; isDIGIT(*s) || *s == '_' ||
- UNLIKELY(hexfp && isXDIGIT(*s));
- s++) {
+ for (; isDIGIT(*s)
+ || *s == '_'
+ || UNLIKELY(hexfp && isXDIGIT(*s));
+ s++)
+ {
/* fixed length buffer check */
if (d >= e)
Perl_croak(aTHX_ "%s", number_too_long);
*d++ = *s++;
}
else {
- if (((lastub && s == lastub + 1) ||
- (!isDIGIT(s[1]) && s[1] != '_')))
+ if (((lastub && s == lastub + 1)
+ || (!isDIGIT(s[1]) && s[1] != '_')))
Perl_ck_warner(aTHX_ packWARN(WARN_SYNTAX),
"Misplaced _ in number");
lastub = s++;
if (!yychar || (yychar == ';' && !PL_rsfp))
sv_catpvs(where_sv, "at EOF");
- else if (PL_oldoldbufptr && PL_bufptr > PL_oldoldbufptr &&
- PL_bufptr - PL_oldoldbufptr < 200 && PL_oldoldbufptr != PL_oldbufptr &&
- PL_oldbufptr != PL_bufptr) {
+ else if ( PL_oldoldbufptr
+ && PL_bufptr > PL_oldoldbufptr
+ && PL_bufptr - PL_oldoldbufptr < 200
+ && PL_oldoldbufptr != PL_oldbufptr
+ && PL_oldbufptr != PL_bufptr)
+ {
/*
Only for NetWare:
The code below is removed for NetWare because it abends/crashes on NetWare
context = PL_oldoldbufptr;
contlen = PL_bufptr - PL_oldoldbufptr;
}
- else if (PL_oldbufptr && PL_bufptr > PL_oldbufptr &&
- PL_bufptr - PL_oldbufptr < 200 && PL_oldbufptr != PL_bufptr) {
+ else if ( PL_oldbufptr
+ && PL_bufptr > PL_oldbufptr
+ && PL_bufptr - PL_oldbufptr < 200
+ && PL_oldbufptr != PL_bufptr) {
/*
Only for NetWare:
The code below is removed for NetWare because it abends/crashes on NetWare
else if (yychar > 255)
sv_catpvs(where_sv, "next token ???");
else if (yychar == YYEMPTY) {
- if (PL_lex_state == LEX_NORMAL ||
- (PL_lex_state == LEX_KNOWNEXT && PL_lex_defer == LEX_NORMAL))
+ if ( PL_lex_state == LEX_NORMAL
+ || (PL_lex_state == LEX_KNOWNEXT && PL_lex_defer == LEX_NORMAL))
sv_catpvs(where_sv, "at end of line");
else if (PL_lex_inpat)
sv_catpvs(where_sv, "within pattern");
down to the bit shift operators. The expression must be followed (and thus
terminated) either by a comparison or lower-precedence operator or by
something that would normally terminate an expression such as semicolon.
-If I<flags> includes C<PARSE_OPTIONAL> then the expression is optional,
+If C<flags> has the C<PARSE_OPTIONAL> bit set, then the expression is optional,
otherwise it is mandatory. It is up to the caller to ensure that the
dynamic parser state (L</PL_parser> et al) is correctly set to reflect
the source of the code to be parsed and the lexical context for the
down to the assignment operators. The expression must be followed (and thus
terminated) either by a comma or lower-precedence operator or by
something that would normally terminate an expression such as semicolon.
-If I<flags> includes C<PARSE_OPTIONAL> then the expression is optional,
+If C<flags> has the C<PARSE_OPTIONAL> bit set, then the expression is optional,
otherwise it is mandatory. It is up to the caller to ensure that the
dynamic parser state (L</PL_parser> et al) is correctly set to reflect
the source of the code to be parsed and the lexical context for the
down to the comma operator. The expression must be followed (and thus
terminated) either by a low-precedence logic operator such as C<or> or by
something that would normally terminate an expression such as semicolon.
-If I<flags> includes C<PARSE_OPTIONAL> then the expression is optional,
+If C<flags> has the C<PARSE_OPTIONAL> bit set, then the expression is optional,
otherwise it is mandatory. It is up to the caller to ensure that the
dynamic parser state (L</PL_parser> et al) is correctly set to reflect
the source of the code to be parsed and the lexical context for the
as C<or>. The expression must be followed (and thus terminated) by a
token that an expression would normally be terminated by: end-of-file,
closing bracketing punctuation, semicolon, or one of the keywords that
-signals a postfix expression-statement modifier. If I<flags> includes
-C<PARSE_OPTIONAL> then the expression is optional, otherwise it is
+signals a postfix expression-statement modifier. If C<flags> has the
+C<PARSE_OPTIONAL> bit set, then the expression is optional, otherwise it is
mandatory. It is up to the caller to ensure that the dynamic parser
state (L</PL_parser> et al) is correctly set to reflect the source of
the code to be parsed and the lexical context for the expression.
level of parsing which covers all the compilation errors that occurred.
Some compilation errors, however, will throw an exception immediately.
-The I<flags> parameter is reserved for future use, and must always
+The C<flags> parameter is reserved for future use, and must always
be zero.
=cut
level of parsing which covers all the compilation errors that occurred.
Some compilation errors, however, will throw an exception immediately.
-The I<flags> parameter is reserved for future use, and must always
+The C<flags> parameter is reserved for future use, and must always
be zero.
=cut
Parse a single label, possibly optional, of the type that may prefix a
Perl statement. It is up to the caller to ensure that the dynamic parser
state (L</PL_parser> et al) is correctly set to reflect the source of
-the code to be parsed. If I<flags> includes C<PARSE_OPTIONAL> then the
+the code to be parsed. If C<flags> has the C<PARSE_OPTIONAL> bit set, then the
label is optional, otherwise it is mandatory.
The name of the label is returned in the form of a fresh scalar. If an
level of parsing which covers all the compilation errors that occurred.
Some compilation errors, however, will throw an exception immediately.
-The I<flags> parameter is reserved for future use, and must always
+The C<flags> parameter is reserved for future use, and must always
be zero.
=cut
which covers all the compilation errors that occurred. Some compilation
errors, however, will throw an exception immediately.
-The I<flags> parameter is reserved for future use, and must always
+The C<flags> parameter is reserved for future use, and must always
be zero.
=cut
"lacks default expression"));
} else {
OP *defexpr = parse_termexpr(0);
- if (defexpr->op_type == OP_UNDEF &&
- !(defexpr->op_flags & OPf_KIDS)) {
+ if (defexpr->op_type == OP_UNDEF
+ && !(defexpr->op_flags & OPf_KIDS))
+ {
op_free(defexpr);
} else {
OP *ifop =