#include "EXTERN.h"
#define PERL_IN_TOKE_C
#include "perl.h"
+#include "dquote_static.c"
#define new_constant(a,b,c,d,e,f,g) \
S_new_constant(aTHX_ a,b,STR_WITH_LEN(c),d,e,f, g)
#define pl_yylval (PL_parser->yylval)
-/* YYINITDEPTH -- initial size of the parser's stacks. */
-#define YYINITDEPTH 200
-
/* XXX temporary backwards compatibility */
#define PL_lex_brackets (PL_parser->lex_brackets)
#define PL_lex_brackstack (PL_parser->lex_brackstack)
# define NEXTVAL_NEXTTOKE PL_nextval[PL_nexttoke]
#endif
-#define XFAKEBRACK 128
-#define XENUMMASK 127
+#define XENUMMASK 0x3f
+#define XFAKEEOF 0x40
+#define XFAKEBRACK 0x80
#ifdef USE_UTF8_SCRIPTS
# define UTF (!IN_BYTES)
}
#endif
-
-
/*
- * Perl_lex_start
- *
- * Create a parser object and initialise its parser and lexer fields
- *
- * rsfp is the opened file handle to read from (if any),
- *
- * line holds any initial content already read from the file (or in
- * the case of no file, such as an eval, the whole contents);
- *
- * new_filter indicates that this is a new file and it shouldn't inherit
- * the filters from the current parser (ie require).
- */
+=for apidoc Amx|void|lex_start|SV *line|PerlIO *rsfp|U32 flags
+
+Creates and initialises a new lexer/parser state object, supplying
+a context in which to lex and parse from a new source of Perl code.
+A pointer to the new state object is placed in L</PL_parser>. An entry
+is made on the save stack so that upon unwinding the new state object
+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
+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
+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.
+
+The I<flags> parameter is reserved for future use, and must always
+be zero.
+
+=cut
+*/
void
-Perl_lex_start(pTHX_ SV *line, PerlIO *rsfp, bool new_filter)
+Perl_lex_start(pTHX_ SV *line, PerlIO *rsfp, U32 flags)
{
dVAR;
const char *s = NULL;
STRLEN len;
yy_parser *parser, *oparser;
+ if (flags)
+ Perl_croak(aTHX_ "Lexing code internal error (%s)", "lex_start");
/* create and initialise a parser */
parser->old_parser = oparser = PL_parser;
PL_parser = parser;
- Newx(parser->stack, YYINITDEPTH, yy_stack_frame);
- parser->ps = parser->stack;
- parser->stack_size = YYINITDEPTH;
-
- parser->stack->state = 0;
- parser->yyerrstatus = 0;
- parser->yychar = YYEMPTY; /* Cause a token to be read. */
+ parser->stack = NULL;
+ parser->ps = NULL;
+ parser->stack_size = 0;
/* on scope exit, free this parser and restore any outer one */
SAVEPARSER(parser);
parser->lex_state = LEX_NORMAL;
parser->expect = XSTATE;
parser->rsfp = rsfp;
- parser->rsfp_filters = (new_filter || !oparser) ? newAV()
- : MUTABLE_AV(SvREFCNT_inc(oparser->rsfp_filters));
+ parser->rsfp_filters = newAV();
Newx(parser->lex_brackstack, 120, char);
Newx(parser->lex_casestack, 12, char);
if (!len) {
parser->linestr = newSVpvs("\n;");
- } else if (SvREADONLY(line) || s[len-1] != ';') {
- parser->linestr = newSVsv(line);
+ } else {
+ parser->linestr = newSVpvn_flags(s, len, SvUTF8(line));
if (s[len-1] != ';')
sv_catpvs(parser->linestr, "\n;");
- } else {
- SvTEMP_off(line);
- SvREFCNT_inc_simple_void_NN(line);
- parser->linestr = line;
}
parser->oldoldbufptr =
parser->oldbufptr =
parser->linestart = SvPVX(parser->linestr);
parser->bufend = parser->bufptr + SvCUR(parser->linestr);
parser->last_lop = parser->last_uni = NULL;
+
+ parser->in_pod = 0;
}
PerlIO_close(parser->rsfp);
SvREFCNT_dec(parser->rsfp_filters);
- Safefree(parser->stack);
Safefree(parser->lex_brackstack);
Safefree(parser->lex_casestack);
PL_parser = parser->old_parser;
/*
- * Perl_lex_end
- * Finalizer for lexing operations. Must be called when the parser is
- * done with the lexer.
- */
-
-void
-Perl_lex_end(pTHX)
-{
- dVAR;
- PL_doextract = FALSE;
-}
-
-/*
=for apidoc AmxU|SV *|PL_parser-E<gt>linestr
Buffer scalar containing the chunk currently under consideration of the
}
/*
-=for apidoc Amx|void|lex_stuff_pvn|char *pv|STRLEN len|U32 flags
+=for apidoc Amx|void|lex_stuff_pvn|const char *pv|STRLEN len|U32 flags
Insert characters into the lexer buffer (L</PL_parser-E<gt>linestr>),
immediately after the current lexing point (L</PL_parser-E<gt>bufptr>),
according to whether the C<LEX_STUFF_UTF8> flag is set in I<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 interpreted is available as a Perl scalar, the L</lex_stuff_sv>
+to be inserted is available as a Perl scalar, the L</lex_stuff_sv>
function is more convenient.
=cut
*/
void
-Perl_lex_stuff_pvn(pTHX_ char *pv, STRLEN len, U32 flags)
+Perl_lex_stuff_pvn(pTHX_ const char *pv, STRLEN len, U32 flags)
{
dVAR;
char *bufptr;
goto plain_copy;
} else {
STRLEN highhalf = 0;
- char *p, *e = pv+len;
+ const char *p, *e = pv+len;
for (p = pv; p != e; p++)
highhalf += !!(((U8)*p) & 0x80);
if (!highhalf)
} else {
if (flags & LEX_STUFF_UTF8) {
STRLEN highhalf = 0;
- char *p, *e = pv+len;
+ const char *p, *e = pv+len;
for (p = pv; p != e; p++) {
U8 c = (U8)*p;
if (c >= 0xc4) {
}
/*
+=for apidoc Amx|void|lex_stuff_pv|const char *pv|U32 flags
+
+Insert characters into the lexer buffer (L</PL_parser-E<gt>linestr>),
+immediately after the current lexing point (L</PL_parser-E<gt>bufptr>),
+reallocating the buffer if necessary. This means that lexing code that
+runs later will see the characters as if they had appeared in the input.
+It is not recommended to do this as part of normal parsing, and most
+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>
+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
+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.
+
+=cut
+*/
+
+void
+Perl_lex_stuff_pv(pTHX_ const char *pv, U32 flags)
+{
+ PERL_ARGS_ASSERT_LEX_STUFF_PV;
+ lex_stuff_pvn(pv, strlen(pv), flags);
+}
+
+/*
=for apidoc Amx|void|lex_stuff_sv|SV *sv|U32 flags
Insert characters into the lexer buffer (L</PL_parser-E<gt>linestr>),
The string to be inserted is the string value of I<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 interpreted is
+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
need to construct a scalar.
else if (PL_parser->rsfp)
(void)PerlIO_close(PL_parser->rsfp);
PL_parser->rsfp = NULL;
- PL_doextract = FALSE;
+ PL_parser->in_pod = 0;
#ifdef PERL_MAD
if (PL_madskills && !PL_in_eval && (PL_minus_p || PL_minus_n))
PL_faketokens = 1;
#endif
}
+void
+Perl_yyunlex(pTHX)
+{
+ int yyc = PL_parser->yychar;
+ if (yyc != YYEMPTY) {
+ if (yyc) {
+ start_force(-1);
+ NEXTVAL_NEXTTOKE = PL_parser->yylval;
+ if (yyc == '{'/*}*/ || yyc == HASHBRACK || yyc == '['/*]*/) {
+ PL_lex_brackets--;
+ yyc |= (1<<24) | (PL_lex_brackstack[PL_lex_brackets] << 16);
+ }
+ force_next(yyc);
+ }
+ PL_parser->yychar = YYEMPTY;
+ }
+}
+
STATIC SV *
S_newSV_maybe_utf8(pTHX_ const char *const start, STRLEN len)
{
curmad('X', newSVpvn(s,d-s));
}
#endif
- if (*d == ';' || isSPACE(*d) || *d == '}' || !*d) {
+ if (*d == ';' || isSPACE(*d) || *d == '{' || *d == '}' || !*d) {
SV *ver;
#ifdef USE_LOCALE_NUMERIC
char *loc = setlocale(LC_NUMERIC, "C");
s = (char *)scan_version(s, ver, 0);
version = newSVOP(OP_CONST, 0, ver);
}
- else if ( (*s != ';' && *s != '}' ) && (s = SKIPSPACE1(s), (*s != ';' && *s !='}' ))) {
+ else if ( (*s != ';' && *s != '{' && *s != '}' ) &&
+ (s = SKIPSPACE1(s), (*s != ';' && *s != '{' && *s != '}' )))
+ {
PL_bufptr = s;
if (errstr)
yyerror(errstr); /* version required */
if (SvTYPE(sv) >= SVt_PVIV && SvIVX(sv) == -1)
goto finish;
send = s + len;
- while (s < send && *s != '\\')
+ /* This is relying on the SV being "well formed" with a trailing '\0' */
+ while (s < send && !(*s == '\\' && s[1] == '\\'))
s++;
if (s == send)
goto finish;
CopLINE_set(PL_curcop, (line_t)PL_multi_start);
PL_lex_inwhat = PL_sublex_info.sub_inwhat;
+ if (PL_lex_inwhat == OP_TRANSR) PL_lex_inwhat = OP_TRANS;
if (PL_lex_inwhat == OP_MATCH || PL_lex_inwhat == OP_QR || PL_lex_inwhat == OP_SUBST)
PL_lex_inpat = PL_sublex_info.sub_op;
else
}
/* Is there a right-hand side to take care of? (s//RHS/ or tr//RHS/) */
+ assert(PL_lex_inwhat != OP_TRANSR);
if (PL_lex_repl && (PL_lex_inwhat == OP_SUBST || PL_lex_inwhat == OP_TRANS)) {
PL_linestr = PL_lex_repl;
PL_lex_inpat = 0;
PERL_ARGS_ASSERT_SCAN_CONST;
+ assert(PL_lex_inwhat != OP_TRANSR);
if (PL_lex_inwhat == OP_TRANS && PL_sublex_info.sub_op) {
/* If we are doing a trans and we know we want UTF8 set expectation */
has_utf8 = PL_sublex_info.sub_op->op_private & (OPpTRANS_FROM_UTF|OPpTRANS_TO_UTF);
s++;
- /* deprecate \1 in strings and substitution replacements */
+ /* 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]))
{
goto default_action;
}
- /* eg. \132 indicates the octal constant 0x132 */
+ /* eg. \132 indicates the octal constant 0132 */
case '0': case '1': case '2': case '3':
case '4': case '5': case '6': case '7':
{
}
goto NUM_ESCAPE_INSERT;
+ /* eg. \o{24} indicates the octal constant \024 */
+ case 'o':
+ {
+ STRLEN len;
+ const char* error;
+
+ bool valid = grok_bslash_o(s, &uv, &len, &error, 1);
+ s += len;
+ if (! valid) {
+ yyerror(error);
+ continue;
+ }
+ goto NUM_ESCAPE_INSERT;
+ }
+
/* eg. \x24 indicates the hex constant 0x24 */
case 'x':
++s;
/* Convert first code point to hex, including the
* boiler plate before it */
- sprintf(hex_string, "\\N{U+%X", (unsigned int) uv);
- output_length = strlen(hex_string);
+ output_length =
+ my_snprintf(hex_string, sizeof(hex_string),
+ "\\N{U+%X", (unsigned int) uv);
/* Make sure there is enough space to hold it */
d = off + SvGROW(sv, off
uv = UNICODE_REPLACEMENT;
}
- sprintf(hex_string, ".%X", (unsigned int) uv);
- output_length = strlen(hex_string);
+ output_length =
+ my_snprintf(hex_string, sizeof(hex_string),
+ ".%X", (unsigned int) uv);
d = off + SvGROW(sv, off
+ output_length
}
}
if (problematic) {
- char *string;
- Newx(string, e - i + 1, char);
- Copy(i, string, e - i, char);
- string[e - i] = '\0';
+ /* The e-i passed to the final %.*s makes sure that
+ * should the trailing NUL be missing that this
+ * print won't run off the end of the string */
Perl_warner(aTHX_ packWARN(WARN_DEPRECATED),
- "Deprecated character(s) in \\N{...} starting at '%s'",
- string);
- Safefree(string);
+ "Deprecated character in \\N{...}; marked by <-- HERE in \\N{%.*s<-- HERE %.*s",
+ (int)(i - s + 1), s, (int)(e - i), i + 1);
}
}
} /* End \N{NAME} */
case 'c':
s++;
if (s < send) {
- U8 c = *s++;
-#ifdef EBCDIC
- if (isLOWER(c))
- c = toUPPER(c);
-#endif
- *d++ = NATIVE_TO_NEED(has_utf8,toCTRL(c));
+ *d++ = grok_bslash_c(*s++, 1);
}
else {
yyerror("Missing control char name in \\c");
/* In a pattern, so maybe we have {n,m}. */
if (*s == '{') {
- s++;
- if (!isDIGIT(*s))
- return TRUE;
- while (isDIGIT(*s))
- s++;
- if (*s == ',')
- s++;
- while (isDIGIT(*s))
- s++;
- if (*s == '}')
+ if (regcurly(s)) {
return FALSE;
+ }
return TRUE;
-
}
/* On the other hand, maybe we have a character class */
/* if filter is on top of stack (usual case) just pop it off */
datasv = FILTER_DATA(AvFILLp(PL_rsfp_filters));
if (IoANY(datasv) == FPTR2DPTR(void *, funcp)) {
- IoFLAGS(datasv) &= ~IOf_FAKE_DIRP;
- IoANY(datasv) = (void *)NULL;
sv_free(av_pop(PL_rsfp_filters));
return;
&& GvCVu(gv_readpipe) && GvIMPORTED_CV(gv_readpipe)))
{
PL_lex_op = (OP*)newUNOP(OP_ENTERSUB, OPf_STACKED,
- append_elem(OP_LIST,
+ op_append_elem(OP_LIST,
newSVOP(OP_CONST, 0, &PL_sv_undef), /* value will be read later */
newCVREF(0, newGVOP(OP_GV, 0, gv_readpipe))));
}
PL_thismad = 0;
/* just do what yylex would do on pending identifier; leave PL_thiswhite alone */
- if (PL_pending_ident)
+ if (PL_lex_state != LEX_KNOWNEXT && PL_pending_ident)
return S_pending_ident(aTHX);
/* previous token ate up our whitespace? */
};
#endif
+#define word_takes_any_delimeter(p,l) S_word_takes_any_delimeter(p,l)
+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]))));
+}
+
/*
yylex
SvREFCNT_dec(tmp);
} );
/* check if there's an identifier for us to look at */
- if (PL_pending_ident)
+ if (PL_lex_state != LEX_KNOWNEXT && PL_pending_ident)
return REPORT(S_pending_ident(aTHX));
/* no identifier pending identification */
PL_lex_defer = LEX_NORMAL;
}
#endif
+ {
+ I32 next_type;
+#ifdef PERL_MAD
+ next_type = PL_nexttoke[PL_lasttoke].next_type;
+#else
+ next_type = PL_nexttype[PL_nexttoke];
+#endif
+ if (next_type & (1<<24)) {
+ if (PL_lex_brackets > 100)
+ Renew(PL_lex_brackstack, PL_lex_brackets + 10, char);
+ PL_lex_brackstack[PL_lex_brackets++] = (next_type >> 16) & 0xff;
+ next_type &= 0xffff;
+ }
#ifdef PERL_MAD
- /* FIXME - can these be merged? */
- return(PL_nexttoke[PL_lasttoke].next_type);
+ /* FIXME - can these be merged? */
+ return next_type;
#else
- return REPORT(PL_nexttype[PL_nexttoke]);
+ return REPORT(next_type);
#endif
+ }
/* interpolated case modifiers like \L \U, including \Q and \E.
when we get here, PL_bufptr is at the \
if (!PL_rsfp) {
PL_last_uni = 0;
PL_last_lop = 0;
- if (PL_lex_brackets) {
+ if (PL_lex_brackets &&
+ PL_lex_brackstack[PL_lex_brackets-1] != XFAKEEOF) {
yyerror((const char *)
(PL_lex_formbrack
? "Format not terminated"
s = swallow_bom((U8*)s);
}
}
- if (PL_doextract) {
+ if (PL_parser->in_pod) {
/* Incest with pod. */
#ifdef PERL_MAD
if (PL_madskills)
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;
- PL_doextract = FALSE;
+ PL_parser->in_pod = 0;
}
}
if (PL_rsfp)
incline(s);
- } while (PL_doextract);
+ } while (PL_parser->in_pod);
PL_oldoldbufptr = PL_oldbufptr = PL_bufptr = PL_linestart = s;
PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr);
PL_last_lop = PL_last_uni = NULL;
s++;
BOop(OP_BIT_XOR);
case '[':
- PL_lex_brackets++;
+ if (PL_lex_brackets > 100)
+ Renew(PL_lex_brackstack, PL_lex_brackets + 10, char);
+ PL_lex_brackstack[PL_lex_brackets++] = 0;
{
const char tmp = *s++;
OPERATOR(tmp);
break;
PL_bufptr = s; /* update in case we back off */
if (*s == '=') {
- deprecate(":= for an empty attribute list");
+ Perl_croak(aTHX_
+ "Use of := for an empty attribute list is not allowed");
}
goto grabattrs;
case XATTRBLOCK:
}
if (PL_lex_stuff) {
sv_catsv(sv, PL_lex_stuff);
- attrs = append_elem(OP_LIST, attrs,
+ attrs = op_append_elem(OP_LIST, attrs,
newSVOP(OP_CONST, 0, sv));
SvREFCNT_dec(PL_lex_stuff);
PL_lex_stuff = NULL;
justified by the performance win for the common case
of applying only built-in attributes.) */
else
- attrs = append_elem(OP_LIST, attrs,
+ attrs = op_append_elem(OP_LIST, attrs,
newSVOP(OP_CONST, 0,
sv));
}
TERM(tmp);
}
case ']':
+ if (PL_lex_brackets && PL_lex_brackstack[PL_lex_brackets-1] == XFAKEEOF)
+ TOKEN(0);
s++;
if (PL_lex_brackets <= 0)
yyerror("Unmatched right square bracket");
PL_copline = NOLINE; /* invalidate current command line number */
TOKEN('{');
case '}':
+ if (PL_lex_brackets && PL_lex_brackstack[PL_lex_brackets-1] == XFAKEEOF)
+ TOKEN(0);
rightbracket:
s++;
if (PL_lex_brackets <= 0)
}
#endif
s = PL_bufend;
- PL_doextract = TRUE;
+ PL_parser->in_pod = 1;
goto retry;
}
}
}
}
- if (s[1] == '#' && (isIDFIRST_lazy_if(s+2,UTF) || strchr("{$:+-", s[2]))) {
+ if (s[1] == '#' && (isIDFIRST_lazy_if(s+2,UTF) || strchr("{$:+-@", s[2]))) {
PL_tokenbuf[0] = '@';
s = scan_ident(s + 1, PL_bufend, PL_tokenbuf + 1,
sizeof PL_tokenbuf - 1, FALSE);
|| isALNUM_lazy_if(PL_last_uni+5,UTF)
))
check_uni();
+ if (*s == '?')
+ deprecate("?PATTERN? without explicit operator");
s = scan_pat(s,OP_MATCH);
TERM(sublex_start());
}
s = scan_word(s, PL_tokenbuf, sizeof PL_tokenbuf, FALSE, &len);
/* Some keywords can be followed by any delimiter, including ':' */
- anydelim = ((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])))));
+ anydelim = word_takes_any_delimeter(PL_tokenbuf, len);
/* x::* is just a word, unless x is "CORE" */
if (!anydelim && *s == ':' && s[1] == ':' && strNE(PL_tokenbuf, "CORE"))
int result;
char *saved_bufptr = PL_bufptr;
PL_bufptr = s;
- result = CALL_FPTR(PL_keyword_plugin)(aTHX_ PL_tokenbuf, len, &o);
+ result = PL_keyword_plugin(aTHX_ PL_tokenbuf, len, &o);
s = PL_bufptr;
if (result == KEYWORD_PLUGIN_DECLINE) {
/* not a plugged-in keyword */
gvp = 0;
if (hgv && tmp != KEY_x && tmp != KEY_CORE) /* never ambiguous */
Perl_ck_warner(aTHX_ packWARN(WARN_AMBIGUOUS),
- "Ambiguous call resolved as CORE::%s(), %s",
- GvENAME(hgv), "qualify as such or use &");
+ "Ambiguous call resolved as CORE::%s(), "
+ "qualify as such or use &",
+ GvENAME(hgv));
}
}
/* if we saw a global override before, get the right name */
+ sv = S_newSV_maybe_utf8(aTHX_ PL_tokenbuf,
+ len ? len : strlen(PL_tokenbuf));
if (gvp) {
+ SV * const tmp_sv = sv;
sv = newSVpvs("CORE::GLOBAL::");
- sv_catpv(sv,PL_tokenbuf);
- }
- else {
- /* If len is 0, newSVpv does strlen(), which is correct.
- If len is non-zero, then it will be the true length,
- and so the scalar will be created correctly. */
- sv = newSVpv(PL_tokenbuf,len);
+ sv_catsv(sv, tmp_sv);
+ SvREFCNT_dec(tmp_sv);
}
+
#ifdef PERL_MAD
if (PL_madskills && !PL_thistoken) {
char *start = SvPVX(PL_linestr) + PL_realtokenstart;
#endif
/* Presume this is going to be a bareword of some sort. */
-
CLINE;
pl_yylval.opval = (OP*)newSVOP(OP_CONST, 0, sv);
pl_yylval.opval->op_private = OPpCONST_BARE;
- /* UTF-8 package name? */
- if (UTF && !IN_BYTES &&
- is_utf8_string((U8*)SvPVX_const(sv), SvCUR(sv)))
- SvUTF8_on(sv);
/* And if "Foo::", then that's what it certainly is. */
-
if (len)
goto safe_bareword;
- cv = NULL;
{
OP *const_op = newSVOP(OP_CONST, 0, SvREFCNT_inc(sv));
const_op->op_private = OPpCONST_BARE;
rv2cv_op = newCVREF(0, const_op);
}
- if (rv2cv_op->op_type == OP_RV2CV &&
- (rv2cv_op->op_flags & OPf_KIDS)) {
- OP *rv_op = cUNOPx(rv2cv_op)->op_first;
- switch (rv_op->op_type) {
- case OP_CONST: {
- SV *sv = cSVOPx_sv(rv_op);
- if (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVCV)
- cv = (CV*)SvRV(sv);
- } break;
- case OP_GV: {
- GV *gv = cGVOPx_gv(rv_op);
- CV *maybe_cv = GvCVu(gv);
- if (maybe_cv && SvTYPE((SV*)maybe_cv) == SVt_PVCV)
- cv = maybe_cv;
- } break;
- }
- }
+ cv = rv2cv_op_cv(rv2cv_op, 0);
/* See if it's the indirect object for a list operator. */
SvREFCNT_dec(((SVOP*)pl_yylval.opval)->op_sv);
((SVOP*)pl_yylval.opval)->op_sv = SvREFCNT_inc_simple(sv);
pl_yylval.opval->op_private = 0;
+ pl_yylval.opval->op_flags |= OPf_SPECIAL;
TOKEN(WORD);
}
const char *proto = SvPV_const(MUTABLE_SV(cv), protolen);
if (!protolen)
TERM(FUNC0SUB);
- if ((*proto == '$' || *proto == '_') && proto[1] == '\0')
- OPERATOR(UNIOPSUB);
while (*proto == ';')
proto++;
+ if (
+ (
+ (
+ *proto == '$' || *proto == '_'
+ || *proto == '*' || *proto == '+'
+ )
+ && proto[1] == '\0'
+ )
+ || (
+ *proto == '\\' && proto[1] && proto[2] == '\0'
+ )
+ )
+ OPERATOR(UNIOPSUB);
+ if (*proto == '\\' && proto[1] == '[') {
+ const char *p = proto + 2;
+ while(*p && *p != ']')
+ ++p;
+ if(*p == ']' && !p[1]) OPERATOR(UNIOPSUB);
+ }
if (*proto == '&' && *s == '{') {
if (PL_curstash)
sv_setpvs(PL_subname, "__ANON__");
UNI(OP_DELETE);
case KEY_dbmopen:
- gv_fetchpvs("AnyDBM_File::ISA", GV_ADDMULTI, SVt_PVAV);
+ Perl_populate_isa(aTHX_ STR_WITH_LEN("AnyDBM_File::ISA"),
+ STR_WITH_LEN("NDBM_File::"),
+ STR_WITH_LEN("DB_File::"),
+ STR_WITH_LEN("GDBM_File::"),
+ STR_WITH_LEN("SDBM_File::"),
+ STR_WITH_LEN("ODBM_File::"),
+ NULL);
LOP(OP_DBMOPEN,XTERM);
case KEY_dbmclose:
s = force_word(s,WORD,FALSE,TRUE,FALSE);
s = SKIPSPACE1(s);
s = force_strict_version(s);
+ PL_lex_expect = XBLOCK;
OPERATOR(PACKAGE);
case KEY_pipe:
case KEY_quotemeta:
UNI(OP_QUOTEMETA);
- case KEY_qw:
+ case KEY_qw: {
+ OP *words = NULL;
s = scan_str(s,!!PL_madskills,FALSE);
if (!s)
missingterm(NULL);
PL_expect = XOPERATOR;
- force_next(')');
if (SvCUR(PL_lex_stuff)) {
- OP *words = NULL;
int warned = 0;
d = SvPV_force(PL_lex_stuff, len);
while (len) {
/**/;
}
sv = newSVpvn_utf8(b, d-b, DO_UTF8(PL_lex_stuff));
- words = append_elem(OP_LIST, words,
+ words = op_append_elem(OP_LIST, words,
newSVOP(OP_CONST, 0, tokeq(sv)));
}
}
- if (words) {
- start_force(PL_curforce);
- NEXTVAL_NEXTTOKE.opval = words;
- force_next(THING);
- }
}
+ if (!words)
+ words = newNULLLIST();
if (PL_lex_stuff) {
SvREFCNT_dec(PL_lex_stuff);
PL_lex_stuff = NULL;
}
- PL_expect = XTERM;
- TOKEN('(');
+ PL_expect = XOPERATOR;
+ pl_yylval.opval = sawparens(words);
+ TOKEN(QWLIST);
+ }
case KEY_qq:
s = scan_str(s,!!PL_madskills,FALSE);
if (warnillegalproto) {
if (must_be_last)
proto_after_greedy_proto = TRUE;
- if (!strchr("$@%*;[]&\\_", *p)) {
+ if (!strchr("$@%*;[]&\\_+", *p)) {
bad_proto = TRUE;
}
else {
pl_yylval.opval = (OP*)newSVOP(OP_CONST, 0, newSVpvn(PL_tokenbuf + 1,
tokenbuf_len - 1));
pl_yylval.opval->op_private = OPpCONST_ENTERED;
- gv_fetchpvn_flags(
- PL_tokenbuf + 1, tokenbuf_len - 1,
- /* If the identifier refers to a stash, don't autovivify it.
- * Change 24660 had the side effect of causing symbol table
- * hashes to always be defined, even if they were freshly
- * created and the only reference in the entire program was
- * the single statement with the defined %foo::bar:: test.
- * It appears that all code in the wild doing this actually
- * wants to know whether sub-packages have been loaded, so
- * by avoiding auto-vivifying symbol tables, we ensure that
- * defined %foo::bar:: continues to be false, and the existing
- * tests still give the expected answers, even though what
- * they're actually testing has now changed subtly.
- */
- (*PL_tokenbuf == '%'
- && *(d = PL_tokenbuf + tokenbuf_len - 1) == ':'
- && d[-1] == ':'
- ? 0
- : PL_in_eval ? (GV_ADDMULTI | GV_ADDINEVAL) : GV_ADD),
- ((PL_tokenbuf[0] == '$') ? SVt_PV
- : (PL_tokenbuf[0] == '@') ? SVt_PVAV
- : SVt_PVHV));
+ gv_fetchpvn_flags(PL_tokenbuf+1, tokenbuf_len - 1,
+ PL_in_eval ? (GV_ADDMULTI | GV_ADDINEVAL) : GV_ADD,
+ ((PL_tokenbuf[0] == '$') ? SVt_PV
+ : (PL_tokenbuf[0] == '@') ? SVt_PVAV
+ : SVt_PVHV));
return WORD;
}
if (name[1] == 'i' &&
name[2] == 'e')
{ /* tie */
- return KEY_tie;
+ return -KEY_tie;
}
goto unknown;
case 'e':
if (name[3] == 'd')
{ /* tied */
- return KEY_tied;
+ return -KEY_tied;
}
goto unknown;
{
case 'e':
{ /* untie */
- return KEY_untie;
+ return -KEY_untie;
}
case 'l':
S_pmflag(U32 pmfl, const char ch) {
switch (ch) {
CASE_STD_PMMOD_FLAGS_PARSE_SET(&pmfl);
- case GLOBAL_PAT_MOD: pmfl |= PMf_GLOBAL; break;
- case CONTINUE_PAT_MOD: pmfl |= PMf_CONTINUE; break;
- case ONCE_PAT_MOD: pmfl |= PMf_KEEP; break;
- case KEEPCOPY_PAT_MOD: pmfl |= PMf_KEEPCOPY; break;
+ case GLOBAL_PAT_MOD: pmfl |= PMf_GLOBAL; break;
+ case CONTINUE_PAT_MOD: pmfl |= PMf_CONTINUE; break;
+ case ONCE_PAT_MOD: pmfl |= PMf_KEEP; break;
+ case KEEPCOPY_PAT_MOD: pmfl |= PMf_KEEPCOPY; break;
+ case NONDESTRUCT_PAT_MOD: pmfl |= PMf_NONDESTRUCT; break;
}
return pmfl;
}
-void
-Perl_pmflag(pTHX_ U32* pmfl, int ch)
-{
- PERL_ARGS_ASSERT_PMFLAG;
-
- Perl_ck_warner_d(aTHX_ packWARN(WARN_DEPRECATED),
- "Perl_pmflag() is deprecated, and will be removed from the XS API");
-
- if (ch<256) {
- *pmfl = S_pmflag(*pmfl, (char)ch);
- }
-}
-
STATIC char *
S_scan_pat(pTHX_ char *start, I32 type)
{
#endif
while (*s && strchr(valid_flags, *s))
pm->op_pmflags = S_pmflag(pm->op_pmflags, *s++);
+
+ if (isALNUM(*s)) {
+ Perl_ck_warner_d(aTHX_ packWARN(WARN_SYNTAX),
+ "Having no space between pattern and following word is deprecated");
+
+ }
#ifdef PERL_MAD
if (PL_madskills && modstart != s) {
SV* tmptoken = newSVpvn(modstart, s - modstart);
}
else if (strchr(S_PAT_MODS, *s))
pm->op_pmflags = S_pmflag(pm->op_pmflags, *s++);
- else
+ else {
+ if (isALNUM(*s)) {
+ Perl_ck_warner_d(aTHX_ packWARN(WARN_SYNTAX),
+ "Having no space between pattern and following word is deprecated");
+
+ }
break;
+ }
}
#ifdef PERL_MAD
U8 squash;
U8 del;
U8 complement;
+ bool nondestruct = 0;
#ifdef PERL_MAD
char *modstart;
#endif
case 's':
squash = OPpTRANS_SQUASH;
break;
+ case 'r':
+ nondestruct = 1;
+ break;
default:
goto no_more;
}
no_more:
tbl = (short *)PerlMemShared_calloc(complement&&!del?258:256, sizeof(short));
- o = newPVOP(OP_TRANS, 0, (char*)tbl);
+ o = newPVOP(nondestruct ? OP_TRANSR : OP_TRANS, 0, (char*)tbl);
o->op_private &= ~OPpTRANS_ALL;
o->op_private |= del|squash|complement|
(DO_UTF8(PL_lex_stuff)? OPpTRANS_FROM_UTF : 0)|
(DO_UTF8(PL_lex_repl) ? OPpTRANS_TO_UTF : 0);
PL_lex_op = o;
- pl_yylval.ival = OP_TRANS;
+ pl_yylval.ival = nondestruct ? OP_TRANSR : OP_TRANS;
#ifdef PERL_MAD
if (PL_madskills) {
o->op_targ = tmp;
PL_lex_op = readline_overriden
? (OP*)newUNOP(OP_ENTERSUB, OPf_STACKED,
- append_elem(OP_LIST, o,
+ op_append_elem(OP_LIST, o,
newCVREF(0, newGVOP(OP_GV,0,gv_readline))))
: (OP*)newUNOP(OP_READLINE, 0, o);
}
SVt_PV);
PL_lex_op = readline_overriden
? (OP*)newUNOP(OP_ENTERSUB, OPf_STACKED,
- append_elem(OP_LIST,
+ op_append_elem(OP_LIST,
newUNOP(OP_RV2SV, 0, newGVOP(OP_GV, 0, gv)),
newCVREF(0, newGVOP(OP_GV, 0, gv_readline))))
: (OP*)newUNOP(OP_READLINE, 0,
GV * const gv = gv_fetchpv(d, GV_ADD, SVt_PVIO);
PL_lex_op = readline_overriden
? (OP*)newUNOP(OP_ENTERSUB, OPf_STACKED,
- append_elem(OP_LIST,
+ op_append_elem(OP_LIST,
newGVOP(OP_GV, 0, gv),
newCVREF(0, newGVOP(OP_GV, 0, gv_readline))))
: (OP*)newUNOP(OP_READLINE, 0, newGVOP(OP_GV, 0, gv));
const char *base, *Base, *max;
/* check for hex */
- if (s[1] == 'x') {
+ if (s[1] == 'x' || s[1] == 'X') {
shift = 4;
s += 2;
just_zero = FALSE;
- } else if (s[1] == 'b') {
+ } else if (s[1] == 'b' || s[1] == 'B') {
shift = 1;
s += 2;
just_zero = FALSE;
Perl_ck_warner(aTHX_ packWARN(WARN_SYNTAX), "Misplaced _ in number");
}
- /* Dot here is historically concat, not a radix point.
- Deprecate that; it's confusing, and gets in the way of
- hex(ish) fractions... but '..' is OK. */
- if (s[0] == '.' &&
- s[1] != '.') {
- Perl_ck_warner(aTHX_ packWARN(WARN_DEPRECATED),
- "Dot after %s literal is concatenation", base);
- }
-
- sv = newSV(0);
if (overflowed) {
if (n > 4294967295.0)
Perl_ck_warner(aTHX_ packWARN(WARN_PORTABLE),
"%s number > %s non-portable",
Base, max);
- sv_setnv(sv, n);
+ sv = newSVnv(n);
}
else {
#if UVSIZE > 4
"%s number > %s non-portable",
Base, max);
#endif
- sv_setuv(sv, u);
+ sv = newSVuv(u);
}
if (just_zero && (PL_hints & HINT_NEW_INTEGER))
sv = new_constant(start, s - start, "integer",
}
- /* make an sv from the string */
- sv = newSV(0);
-
/*
We try to do an integer conversion first if no characters
indicating "float" have been found.
if (flags == IS_NUMBER_IN_UV) {
if (uv <= IV_MAX)
- sv_setiv(sv, uv); /* Prefer IVs over UVs. */
+ sv = newSViv(uv); /* Prefer IVs over UVs. */
else
- sv_setuv(sv, uv);
+ sv = newSVuv(uv);
} else if (flags == (IS_NUMBER_IN_UV | IS_NUMBER_NEG)) {
if (uv <= (UV) IV_MIN)
- sv_setiv(sv, -(IV)uv);
+ sv = newSViv(-(IV)uv);
else
floatit = TRUE;
} else
/* terminate the string */
*d = '\0';
nv = Atof(PL_tokenbuf);
- sv_setnv(sv, nv);
+ sv = newSVnv(nv);
}
if ( floatit
const bool reverse = cBOOL(IoLINES(filter));
I32 retval;
+ PERL_ARGS_ASSERT_UTF16_TEXTFILTER;
+
/* As we're automatically added, at the lowest level, and hence only called
from this file, we can be sure that we're not called in block mode. Hence
don't bother writing code to deal with block mode. */
{
SV *filter = filter_add(S_utf16_textfilter, NULL);
+ PERL_ARGS_ASSERT_ADD_UTF16_TEXTFILTER;
+
IoTOP_GV(filter) = MUTABLE_GV(newSVpvn((char *)s, PL_bufend - (char*)s));
sv_setpvs(filter, "");
IoLINES(filter) = reversed;
return KEYWORD_PLUGIN_DECLINE;
}
+#define parse_recdescent(g) S_parse_recdescent(aTHX_ g)
+static void
+S_parse_recdescent(pTHX_ int gramtype)
+{
+ SAVEI32(PL_lex_brackets);
+ if (PL_lex_brackets > 100)
+ Renew(PL_lex_brackstack, PL_lex_brackets + 10, char);
+ PL_lex_brackstack[PL_lex_brackets++] = XFAKEEOF;
+ if(yyparse(gramtype) && !PL_parser->error_count)
+ qerror(Perl_mess(aTHX_ "Parse error"));
+}
+
+#define parse_recdescent_for_op(g) S_parse_recdescent_for_op(aTHX_ g)
+static OP *
+S_parse_recdescent_for_op(pTHX_ int gramtype)
+{
+ OP *o;
+ ENTER;
+ SAVEVPTR(PL_eval_root);
+ PL_eval_root = NULL;
+ parse_recdescent(gramtype);
+ o = PL_eval_root;
+ LEAVE;
+ return o;
+}
+
+/*
+=for apidoc Amx|OP *|parse_block|U32 flags
+
+Parse a single complete Perl code block. This consists of an opening
+brace, a sequence of statements, and a closing brace. The block
+constitutes a lexical scope, so C<my> variables and various compile-time
+effects can be contained within it. 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 statement.
+
+The op tree representing the code block is returned. This is always a
+real op, never a null pointer. It will normally be a C<lineseq> list,
+including C<nextstate> or equivalent ops. No ops to construct any kind
+of runtime scope are included by virtue of it being a block.
+
+If an error occurs in parsing or compilation, in most cases a valid op
+tree (most likely null) is returned anyway. The error is reflected in
+the parser state, normally resulting in a single exception at the top
+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
+be zero.
+
+=cut
+*/
+
+OP *
+Perl_parse_block(pTHX_ U32 flags)
+{
+ if (flags)
+ Perl_croak(aTHX_ "Parsing code internal error (%s)", "parse_block");
+ return parse_recdescent_for_op(GRAMBLOCK);
+}
+
+/*
+=for apidoc Amx|OP *|parse_barestmt|U32 flags
+
+Parse a single unadorned Perl statement. This may be a normal imperative
+statement or a declaration that has compile-time effect. It does not
+include any label or other affixture. 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 statement.
+
+The op tree representing the statement is returned. This may be a
+null pointer if the statement is null, for example if it was actually
+a subroutine definition (which has compile-time side effects). If not
+null, it will be ops directly implementing the statement, suitable to
+pass to L</newSTATEOP>. It will not normally include a C<nextstate> or
+equivalent op (except for those embedded in a scope contained entirely
+within the statement).
+
+If an error occurs in parsing or compilation, in most cases a valid op
+tree (most likely null) is returned anyway. The error is reflected in
+the parser state, normally resulting in a single exception at the top
+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
+be zero.
+
+=cut
+*/
+
+OP *
+Perl_parse_barestmt(pTHX_ U32 flags)
+{
+ if (flags)
+ Perl_croak(aTHX_ "Parsing code internal error (%s)", "parse_barestmt");
+ return parse_recdescent_for_op(GRAMBARESTMT);
+}
+
+/*
+=for apidoc Amx|SV *|parse_label|U32 flags
+
+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
+label is optional, otherwise it is mandatory.
+
+The name of the label is returned in the form of a fresh scalar. If an
+optional label is absent, a null pointer is returned.
+
+If an error occurs in parsing, which can only occur if the label is
+mandatory, a valid label is returned anyway. The error is reflected in
+the parser state, normally resulting in a single exception at the top
+level of parsing which covers all the compilation errors that occurred.
+
+=cut
+*/
+
+SV *
+Perl_parse_label(pTHX_ U32 flags)
+{
+ if (flags & ~PARSE_OPTIONAL)
+ Perl_croak(aTHX_ "Parsing code internal error (%s)", "parse_label");
+ if (PL_lex_state == LEX_KNOWNEXT) {
+ PL_parser->yychar = yylex();
+ if (PL_parser->yychar == LABEL) {
+ char *lpv = pl_yylval.pval;
+ STRLEN llen = strlen(lpv);
+ SV *lsv;
+ PL_parser->yychar = YYEMPTY;
+ lsv = newSV_type(SVt_PV);
+ SvPV_set(lsv, lpv);
+ SvCUR_set(lsv, llen);
+ SvLEN_set(lsv, llen+1);
+ SvPOK_on(lsv);
+ return lsv;
+ } else {
+ yyunlex();
+ goto no_label;
+ }
+ } else {
+ char *s, *t;
+ U8 c;
+ STRLEN wlen, bufptr_pos;
+ lex_read_space(0);
+ t = s = PL_bufptr;
+ c = (U8)*s;
+ if (!isIDFIRST_A(c))
+ goto no_label;
+ do {
+ c = (U8)*++t;
+ } while(isWORDCHAR_A(c));
+ wlen = t - s;
+ if (word_takes_any_delimeter(s, wlen))
+ goto no_label;
+ bufptr_pos = s - SvPVX(PL_linestr);
+ PL_bufptr = t;
+ lex_read_space(LEX_KEEP_PREVIOUS);
+ t = PL_bufptr;
+ s = SvPVX(PL_linestr) + bufptr_pos;
+ if (t[0] == ':' && t[1] != ':') {
+ PL_oldoldbufptr = PL_oldbufptr;
+ PL_oldbufptr = s;
+ PL_bufptr = t+1;
+ return newSVpvn(s, wlen);
+ } else {
+ PL_bufptr = s;
+ no_label:
+ if (flags & PARSE_OPTIONAL) {
+ return NULL;
+ } else {
+ qerror(Perl_mess(aTHX_ "Parse error"));
+ return newSVpvs("x");
+ }
+ }
+ }
+}
+
+/*
+=for apidoc Amx|OP *|parse_fullstmt|U32 flags
+
+Parse a single complete Perl statement. This may be a normal imperative
+statement or a declaration that has compile-time effect, and may include
+an optional label. 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 statement.
+
+The op tree representing the statement is returned. This may be a
+null pointer if the statement is null, for example if it was actually
+a subroutine definition (which has compile-time side effects). If not
+null, it will be the result of a L</newSTATEOP> call, normally including
+a C<nextstate> or equivalent op.
+
+If an error occurs in parsing or compilation, in most cases a valid op
+tree (most likely null) is returned anyway. The error is reflected in
+the parser state, normally resulting in a single exception at the top
+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
+be zero.
+
+=cut
+*/
+
+OP *
+Perl_parse_fullstmt(pTHX_ U32 flags)
+{
+ if (flags)
+ Perl_croak(aTHX_ "Parsing code internal error (%s)", "parse_fullstmt");
+ return parse_recdescent_for_op(GRAMFULLSTMT);
+}
+
+/*
+=for apidoc Amx|OP *|parse_stmtseq|U32 flags
+
+Parse a sequence of zero or more Perl statements. These may be normal
+imperative statements, including optional labels, or declarations
+that have compile-time effect, or any mixture thereof. The statement
+sequence ends when a closing brace or end-of-file is encountered in a
+place where a new statement could have validly started. 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 statements.
+
+The op tree representing the statement sequence is returned. This may
+be a null pointer if the statements were all null, for example if there
+were no statements or if there were only subroutine definitions (which
+have compile-time side effects). If not null, it will be a C<lineseq>
+list, normally including C<nextstate> or equivalent ops.
+
+If an error occurs in parsing or compilation, in most cases a valid op
+tree is returned anyway. The error is reflected in the parser state,
+normally resulting in a single exception at the top 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
+be zero.
+
+=cut
+*/
+
+OP *
+Perl_parse_stmtseq(pTHX_ U32 flags)
+{
+ OP *stmtseqop;
+ I32 c;
+ if (flags)
+ Perl_croak(aTHX_ "Parsing code internal error (%s)", "parse_fullstmt");
+ stmtseqop = parse_recdescent_for_op(GRAMSTMTSEQ);
+ c = lex_peek_unichar(0);
+ if (c != -1 && c != /*{*/'}')
+ qerror(Perl_mess(aTHX_ "Parse error"));
+ return stmtseqop;
+}
+
+void
+Perl_munge_qwlist_to_paren_list(pTHX_ OP *qwlist)
+{
+ PERL_ARGS_ASSERT_MUNGE_QWLIST_TO_PAREN_LIST;
+ deprecate("qw(...) as parentheses");
+ force_next(')');
+ if (qwlist->op_type == OP_STUB) {
+ op_free(qwlist);
+ }
+ else {
+ start_force(PL_curforce);
+ NEXTVAL_NEXTTOKE.opval = qwlist;
+ force_next(THING);
+ }
+ force_next('(');
+}
+
/*
* Local variables:
* c-indentation-style: bsd
https://perl5.git.perl.org / perl5.git / blobdiff