/* toke.c
*
* Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
- * 2000, 2001, 2002, 2003, 2004, 2005, by Larry Wall and others
+ * 2000, 2001, 2002, 2003, 2004, 2005, 2006, by Larry Wall and others
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
#define yylval (*PL_yylvalp)
static const char ident_too_long[] = "Identifier too long";
+static const char commaless_variable_list[] = "comma-less variable list";
static void restore_rsfp(pTHX_ void *f);
#ifndef PERL_NO_UTF16_FILTER
const char *name = Nullch;
enum token_type type = TOKENTYPE_NONE;
const struct debug_tokens *p;
- SV* const report = newSVpvn("<== ", 4);
+ SV* const report = newSVpvs("<== ");
for (p = debug_tokens; p->token; p++) {
if (p->token == (int)rv) {
else if ((char)rv > ' ' && (char)rv < '~')
Perl_sv_catpvf(aTHX_ report, "'%c'", (char)rv);
else if (!rv)
- Perl_sv_catpv(aTHX_ report, "EOF");
+ sv_catpvs(report, "EOF");
else
Perl_sv_catpvf(aTHX_ report, "?? %"IVdf, (IV)rv);
switch (type) {
}
else
- Perl_sv_catpv(aTHX_ report, "(opval=null)");
+ sv_catpvs(report, "(opval=null)");
break;
}
PerlIO_printf(Perl_debug_log, "### %s\n\n", SvPV_nolen_const(report));
STATIC void
S_printbuf(pTHX_ const char* fmt, const char* s)
{
- SV* const tmp = newSVpvn("", 0);
+ SV* const tmp = newSVpvs("");
PerlIO_printf(Perl_debug_log, fmt, pv_display(tmp, s, strlen(s), 0, 60));
SvREFCNT_dec(tmp);
}
Perl_croak(aTHX_ "Can't find string terminator %c%s%c anywhere before EOF",q,s,q);
}
-#define FEATURE_IS_ENABLED(name, namelen) \
+#define FEATURE_IS_ENABLED(name) \
((0 != (PL_hints & HINT_LOCALIZE_HH)) \
- && feature_is_enabled(name, namelen))
+ && S_feature_is_enabled(aTHX_ STR_WITH_LEN(name)))
/*
* S_feature_is_enabled
* Check whether the named feature is enabled.
}
/*
- * depcom
- * Deprecate a comma-less variable list.
- */
-
-STATIC void
-S_depcom(pTHX)
-{
- deprecate_old("comma-less variable list");
-}
-
-/*
* experimental text filters for win32 carriage-returns, utf16-to-utf8 and
* utf16-to-utf8-reversed.
*/
if (!len || s[len-1] != ';') {
if (!(SvFLAGS(PL_linestr) & SVs_TEMP))
PL_linestr = sv_2mortal(newSVsv(PL_linestr));
- sv_catpvn(PL_linestr, "\n;", 2);
+ sv_catpvs(PL_linestr, "\n;");
}
SvTEMP_off(PL_linestr);
PL_oldoldbufptr = PL_oldbufptr = PL_bufptr = PL_linestart = SvPVX(PL_linestr);
sv_setpvn(sv,PL_bufptr,PL_bufend-PL_bufptr);
(void)SvIOK_on(sv);
SvIV_set(sv, 0);
- av_store(CopFILEAV(PL_curcop),(I32)CopLINE(PL_curcop),sv);
+ av_store(CopFILEAVx(PL_curcop),(I32)CopLINE(PL_curcop),sv);
}
}
}
{
dVAR;
if (!PL_lex_starts++) {
- SV * const sv = newSVpvn("",0);
+ SV * const sv = newSVpvs("");
if (SvUTF8(PL_linestr))
SvUTF8_on(sv);
PL_expect = XOPERATOR;
bool bof = FALSE;
DEBUG_T( {
- SV* tmp = newSVpvn("", 0);
+ SV* tmp = newSVpvs("");
PerlIO_printf(Perl_debug_log, "### %"IVdf":LEX_%s/X%s %s\n",
(IV)CopLINE(PL_curcop),
lex_state_names[PL_lex_state],
PL_preambled = TRUE;
sv_setpv(PL_linestr,incl_perldb());
if (SvCUR(PL_linestr))
- sv_catpvn(PL_linestr,";", 1);
+ sv_catpvs(PL_linestr,";");
if (PL_preambleav){
while(AvFILLp(PL_preambleav) >= 0) {
SV *tmpsv = av_shift(PL_preambleav);
sv_catsv(PL_linestr, tmpsv);
- sv_catpvn(PL_linestr, ";", 1);
+ sv_catpvs(PL_linestr, ";");
sv_free(tmpsv);
}
sv_free((SV*)PL_preambleav);
PL_preambleav = NULL;
}
if (PL_minus_n || PL_minus_p) {
- sv_catpv(PL_linestr, "LINE: while (<>) {");
+ sv_catpvs(PL_linestr, "LINE: while (<>) {");
if (PL_minus_l)
- sv_catpv(PL_linestr,"chomp;");
+ sv_catpvs(PL_linestr,"chomp;");
if (PL_minus_a) {
if (PL_minus_F) {
if ((*PL_splitstr == '/' || *PL_splitstr == '\''
else {
/* "q\0${splitstr}\0" is legal perl. Yes, even NUL
bytes can be used as quoting characters. :-) */
- /* The count here deliberately includes the NUL
- that terminates the C string constant. This
- embeds the opening NUL into the string. */
const char *splits = PL_splitstr;
- sv_catpvn(PL_linestr, "our @F=split(q", 15);
+ sv_catpvs(PL_linestr, "our @F=split(q\0");
do {
/* Need to \ \s */
if (*splits == '\\')
/* This loop will embed the trailing NUL of
PL_linestr as the last thing it does before
terminating. */
- sv_catpvn(PL_linestr, ");", 2);
+ sv_catpvs(PL_linestr, ");");
}
}
else
- sv_catpv(PL_linestr,"our @F=split(' ');");
+ sv_catpvs(PL_linestr,"our @F=split(' ');");
}
}
- sv_catpvn(PL_linestr, "\n", 1);
+ if (PL_minus_E)
+ sv_catpvs(PL_linestr,"use feature ':5.10';");
+ sv_catpvs(PL_linestr, "\n");
PL_oldoldbufptr = PL_oldbufptr = s = PL_linestart = SvPVX(PL_linestr);
PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr);
PL_last_lop = PL_last_uni = Nullch;
sv_setsv(sv,PL_linestr);
(void)SvIOK_on(sv);
SvIV_set(sv, 0);
- av_store(CopFILEAV(PL_curcop),(I32)CopLINE(PL_curcop),sv);
+ av_store(CopFILEAVx(PL_curcop),(I32)CopLINE(PL_curcop),sv);
}
goto retry;
}
sv_setsv(sv,PL_linestr);
(void)SvIOK_on(sv);
SvIV_set(sv, 0);
- av_store(CopFILEAV(PL_curcop),(I32)CopLINE(PL_curcop),sv);
+ av_store(CopFILEAVx(PL_curcop),(I32)CopLINE(PL_curcop),sv);
}
PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr);
PL_last_lop = PL_last_uni = Nullch;
(void)gv_fetchfile(PL_origfilename);
goto retry;
}
- if (PL_doswitches && !switches_done) {
- int argc = PL_origargc;
- char **argv = PL_origargv;
- do {
- argc--,argv++;
- } while (argc && argv[0][0] == '-' && argv[0][1]);
- init_argv_symbols(argc,argv);
- }
}
}
}
case '~':
if (s[1] == '~'
&& (PL_expect == XOPERATOR || PL_expect == XTERMORDORDOR)
- && FEATURE_IS_ENABLED("~~", 2))
+ && FEATURE_IS_ENABLED("~~"))
{
s += 2;
Eop(OP_SMARTMATCH);
if (PL_expect == XOPERATOR) {
if (PL_lex_formbrack && PL_lex_brackets == PL_lex_formbrack) {
PL_expect = XTERM;
- depcom();
+ deprecate_old(commaless_variable_list);
return REPORT(','); /* grandfather non-comma-format format */
}
}
t++;
Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
"Multidimensional syntax %.*s not supported",
- (t - PL_bufptr) + 1, PL_bufptr);
+ (int)((t - PL_bufptr) + 1), PL_bufptr);
}
}
}
PL_bufptr = skipspace(PL_bufptr);
Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
"Scalar value %.*s better written as $%.*s",
- t-PL_bufptr, PL_bufptr, t-PL_bufptr-1, PL_bufptr+1);
+ (int)(t-PL_bufptr), PL_bufptr,
+ (int)(t-PL_bufptr-1), PL_bufptr+1);
}
}
}
if (PL_expect == XOPERATOR) {
if (PL_lex_formbrack && PL_lex_brackets == PL_lex_formbrack) {
PL_expect = XTERM;
- depcom();
+ deprecate_old(commaless_variable_list);
return REPORT(','); /* grandfather non-comma-format format */
}
else
if (PL_expect == XOPERATOR) {
if (PL_lex_formbrack && PL_lex_brackets == PL_lex_formbrack) {
PL_expect = XTERM;
- depcom();
+ deprecate_old(commaless_variable_list);
return REPORT(','); /* grandfather non-comma-format format */
}
else
keylookup: {
I32 tmp;
I32 orig_keyword = 0;
- GV *gv = Nullgv;
- GV **gvp = 0;
+ GV *gv = NULL;
+ GV **gvp = NULL;
PL_bufptr = s;
s = scan_word(s, PL_tokenbuf, sizeof PL_tokenbuf, FALSE, &len);
}
if (tmp < 0) { /* second-class keyword? */
- GV *ogv = Nullgv; /* override (winner) */
- GV *hgv = Nullgv; /* hidden (loser) */
+ GV *ogv = NULL; /* override (winner) */
+ GV *hgv = NULL; /* hidden (loser) */
if (PL_expect != XOPERATOR && (*s != ':' || s[1] != ':')) {
CV *cv;
if ((gv = gv_fetchpv(PL_tokenbuf, 0, SVt_PVCV)) &&
{
tmp = 0; /* any sub overrides "weak" keyword */
}
- else if (gv && !gvp
- && tmp == -KEY_err
- && GvCVu(gv)
- && PL_expect != XOPERATOR
- && PL_expect != XTERMORDORDOR)
- {
- /* any sub overrides the "err" keyword, except when really an
- * operator is expected */
- tmp = 0;
- }
else { /* no override */
tmp = -tmp;
if (tmp == KEY_dump && ckWARN(WARN_MISC)) {
/* if we saw a global override before, get the right name */
if (gvp) {
- sv = newSVpvn("CORE::GLOBAL::",14);
+ sv = newSVpvs("CORE::GLOBAL::");
sv_catpv(sv,PL_tokenbuf);
}
else {
/* When 'use switch' is in effect, continue has a dual
life as a control operator. */
{
- if (!FEATURE_IS_ENABLED("switch", 6))
+ if (!FEATURE_IS_ENABLED("switch"))
PREBLOCK(CONTINUE);
else {
/* We have to disambiguate the two senses of
sv_setpv(PL_subname, tmpbuf);
else {
sv_setsv(PL_subname,PL_curstname);
- sv_catpvn(PL_subname,"::",2);
+ sv_catpvs(PL_subname,"::");
sv_catpvn(PL_subname,tmpbuf,len);
}
s = skipspace(d);
HV * const stash = PAD_COMPNAME_OURSTASH(tmp);
HEK * const stashname = HvNAME_HEK(stash);
SV * const sym = newSVhek(stashname);
- sv_catpvn(sym, "::", 2);
+ sv_catpvs(sym, "::");
sv_catpv(sym, PL_tokenbuf+1);
yylval.opval = (OP*)newSVOP(OP_CONST, 0, sym);
yylval.opval->op_private = OPpCONST_ENTERED;
case 'r':
if (name[2] == 'r')
{ /* err */
- return -KEY_err;
+ return (FEATURE_IS_ENABLED("err") ? -KEY_err : 0);
}
goto unknown;
case 'a':
if (name[2] == 'y')
{ /* say */
- return (FEATURE_IS_ENABLED("say", 3) ? -KEY_say : 0);
+ return (FEATURE_IS_ENABLED("say") ? -KEY_say : 0);
}
goto unknown;
if (name[2] == 'e' &&
name[3] == 'n')
{ /* when */
- return (FEATURE_IS_ENABLED("switch", 6) ? KEY_when : 0);
+ return (FEATURE_IS_ENABLED("switch") ? KEY_when : 0);
}
goto unknown;
name[3] == 'a' &&
name[4] == 'k')
{ /* break */
- return (FEATURE_IS_ENABLED("switch", 6) ? -KEY_break : 0);
+ return (FEATURE_IS_ENABLED("switch") ? -KEY_break : 0);
}
goto unknown;
name[3] == 'e' &&
name[4] == 'n')
{ /* given */
- return (FEATURE_IS_ENABLED("switch", 6) ? KEY_given : 0);
+ return (FEATURE_IS_ENABLED("switch") ? KEY_given : 0);
}
goto unknown;
name[5] == 'l' &&
name[6] == 't')
{ /* default */
- return (FEATURE_IS_ENABLED("switch", 6) ? KEY_default : 0);
+ return (FEATURE_IS_ENABLED("switch") ? KEY_default : 0);
}
goto unknown;
/* Check the eval first */
if (!PL_in_eval && SvTRUE(ERRSV)) {
- sv_catpv(ERRSV, "Propagated");
+ sv_catpvs(ERRSV, "Propagated");
yyerror(SvPV_nolen_const(ERRSV)); /* Duplicates the message inside eval */
(void)POPs;
res = SvREFCNT_inc(sv);
PL_sublex_info.super_bufend = PL_bufend;
PL_multi_end = 0;
pm->op_pmflags |= PMf_EVAL;
- repl = newSVpvn("",0);
+ repl = newSVpvs("");
while (es-- > 0)
sv_catpv(repl, es ? "eval " : "do ");
- sv_catpvn(repl, "{ ", 2);
+ sv_catpvs(repl, "{ ");
sv_catsv(repl, PL_lex_repl);
- sv_catpvn(repl, " };", 2);
+ sv_catpvs(repl, " }");
SvEVALED_on(repl);
SvREFCNT_dec(PL_lex_repl);
PL_lex_repl = repl;
I32 len;
SV *tmpstr;
char term;
- const char newline[] = "\n";
const char *found_newline;
register char *d;
register char *e;
s = olds;
}
#endif
- if ( outer || !(found_newline = ninstr(s,PL_bufend,newline,newline+1)) ) {
+ if ( outer || !(found_newline = memchr(s, '\n', PL_bufend - s)) ) {
herewas = newSVpvn(s,PL_bufend-s);
}
else {
sv_setsv(sv,PL_linestr);
(void)SvIOK_on(sv);
SvIV_set(sv, 0);
- av_store(CopFILEAV(PL_curcop), (I32)CopLINE(PL_curcop),sv);
+ av_store(CopFILEAVx(PL_curcop), (I32)CopLINE(PL_curcop),sv);
}
if (*s == term && memEQ(s,PL_tokenbuf,len)) {
STRLEN off = PL_bufend - 1 - SvPVX_const(PL_linestr);
HV *stash = PAD_COMPNAME_OURSTASH(tmp);
HEK *stashname = HvNAME_HEK(stash);
SV *sym = sv_2mortal(newSVhek(stashname));
- sv_catpvn(sym, "::", 2);
+ sv_catpvs(sym, "::");
sv_catpv(sym, d+1);
d = SvPVX(sym);
goto intro_sym;
/* update debugger info */
if (PERLDB_LINE && PL_curstash != PL_debstash) {
- SV *sv = NEWSV(88,0);
+ SV * const sv = NEWSV(88,0);
sv_upgrade(sv, SVt_PVMG);
sv_setsv(sv,PL_linestr);
(void)SvIOK_on(sv);
SvIV_set(sv, 0);
- av_store(CopFILEAV(PL_curcop), (I32)CopLINE(PL_curcop), sv);
+ av_store(CopFILEAVx(PL_curcop), (I32)CopLINE(PL_curcop), sv);
}
/* having changed the buffer, we must update PL_bufend */
NV nv; /* number read, as a double */
SV *sv = Nullsv; /* place to put the converted number */
bool floatit; /* boolean: int or float? */
- const char *lastub = 0; /* position of last underbar */
+ const char *lastub = NULL; /* position of last underbar */
static char const number_too_long[] = "Number too long";
/* We use the first character to decide what type of number this is */
{
register char *eol;
register char *t;
- SV *stuff = newSVpvn("",0);
+ SV *stuff = newSVpvs("");
bool needargs = FALSE;
bool eofmt = FALSE;
where = "within string";
}
else {
- SV *where_sv = sv_2mortal(newSVpvn("next char ", 10));
+ SV *where_sv = sv_2mortal(newSVpvs("next char "));
if (yychar < 32)
Perl_sv_catpvf(aTHX_ where_sv, "^%c", toCTRL(yychar));
else if (isPRINT_LC(yychar))