/* 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);
}
}
}
/* XXX see note in pp_entereval() for why we forgo typo
warnings if the symbol must be introduced in an eval.
GSAR 96-10-12 */
- gv_fetchpv(s, PL_in_eval ? (GV_ADDMULTI | GV_ADDINEVAL) : TRUE,
+ gv_fetchpv(s, PL_in_eval ? (GV_ADDMULTI | GV_ADDINEVAL) : GV_ADD,
kind == '$' ? SVt_PV :
kind == '@' ? SVt_PVAV :
kind == '%' ? SVt_PVHV :
{
dVAR;
if (!PL_lex_starts++) {
- SV * const sv = newSVpvn("",0);
+ SV * const sv = newSVpvs("");
if (SvUTF8(PL_linestr))
SvUTF8_on(sv);
PL_expect = XOPERATOR;
weight -= seen[un_char] * 10;
if (isALNUM_lazy_if(s+1,UTF)) {
scan_ident(s, send, tmpbuf, sizeof tmpbuf, FALSE);
- if ((int)strlen(tmpbuf) > 1 && gv_fetchpv(tmpbuf,FALSE, SVt_PV))
+ if ((int)strlen(tmpbuf) > 1
+ && gv_fetchpv(tmpbuf, 0, SVt_PV))
weight -= 100;
else
weight -= 10;
*/
STATIC int
-S_intuit_method(pTHX_ char *start, GV *gv)
+S_intuit_method(pTHX_ char *start, GV *gv, CV *cv)
{
char *s = start + (*start == '$');
char tmpbuf[sizeof PL_tokenbuf];
GV* indirgv;
if (gv) {
- CV *cv;
- if (GvIO(gv))
+ if (SvTYPE(gv) == SVt_PVGV && GvIO(gv))
return 0;
- if ((cv = GvCVu(gv))) {
- const char *proto = SvPVX_const(cv);
- if (proto) {
- if (*proto == ';')
- proto++;
- if (*proto == '*')
- return 0;
+ if (cv) {
+ if (SvPOK(cv)) {
+ const char *proto = SvPVX_const(cv);
+ if (proto) {
+ if (*proto == ';')
+ proto++;
+ if (*proto == '*')
+ return 0;
+ }
}
} else
gv = 0;
tmpbuf[len] = '\0';
goto bare_package;
}
- indirgv = gv_fetchpv(tmpbuf, FALSE, SVt_PVCV);
+ indirgv = gv_fetchpv(tmpbuf, 0, SVt_PVCV);
if (indirgv && GvCVu(indirgv))
return 0;
/* filehandle or package name makes it a method */
if (len > 2 &&
(pkgname[len - 2] == ':' && pkgname[len - 1] == ':') &&
- (gv = gv_fetchpv(pkgname, FALSE, SVt_PVHV)))
+ (gv = gv_fetchpv(pkgname, 0, SVt_PVHV)))
{
return GvHV(gv); /* Foo:: */
}
/* use constant CLASS => 'MyClass' */
- if ((gv = gv_fetchpv(pkgname, FALSE, SVt_PVCV))) {
+ if ((gv = gv_fetchpv(pkgname, 0, SVt_PVCV))) {
SV *sv;
if (GvCV(gv) && (sv = cv_const_sv(GvCV(gv)))) {
pkgname = SvPV_nolen_const(sv);
register char *s = PL_bufptr;
register char *d;
STRLEN len;
- GV *gv = Nullgv;
- GV **gvp = 0;
bool bof = FALSE;
- I32 orig_keyword = 0;
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;
* at least, set argv[0] to the basename of the Perl
* interpreter. So, having found "#!", we'll set it right.
*/
- SV * const x = GvSV(gv_fetchpv("\030", TRUE, SVt_PV)); /* $^X */
+ SV * const x
+ = GvSV(gv_fetchpv("\030", GV_ADD, SVt_PV)); /* $^X */
assert(SvPOK(x) || SvGMAGICAL(x));
if (sv_eq(x, CopFILESV(PL_curcop))) {
sv_setpvn(x, ipath, ipathend - ipath);
(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 'T': ftst = OP_FTTEXT; break;
case 'B': ftst = OP_FTBINARY; break;
case 'M': case 'A': case 'C':
- gv_fetchpv("\024",TRUE, SVt_PV);
+ gv_fetchpv("\024",GV_ADD, SVt_PV);
switch (tmp) {
case 'M': ftst = OP_FTMTIME; break;
case 'A': ftst = OP_FTATIME; break;
case '~':
if (s[1] == '~'
&& (PL_expect == XOPERATOR || PL_expect == XTERMORDORDOR)
- && FEATURE_IS_ENABLED("~~", 2))
+ && FEATURE_IS_ENABLED("~~"))
{
s += 2;
Eop(OP_SMARTMATCH);
case ':':
if (s[1] == ':') {
len = 0;
- goto just_a_word;
+ goto just_a_word_zero_gv;
}
s++;
switch (PL_expect) {
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
const char c = *start;
GV *gv;
*start = '\0';
- gv = gv_fetchpv(s, FALSE, SVt_PVCV);
+ gv = gv_fetchpv(s, 0, SVt_PVCV);
*start = c;
if (!gv) {
s = scan_num(s, &yylval);
keylookup: {
I32 tmp;
- assert (orig_keyword == 0);
- assert (gv == 0);
- assert (gvp == 0);
- orig_keyword = 0;
- gv = Nullgv;
- gvp = 0;
+ I32 orig_keyword = 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, FALSE, SVt_PVCV)) &&
+ if ((gv = gv_fetchpv(PL_tokenbuf, 0, SVt_PVCV)) &&
(cv = GvCVu(gv)))
{
if (GvIMPORTED_CV(gv))
{
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)) {
switch (tmp) {
default: /* not a keyword */
+ /* Trade off - by using this evil construction we can pull the
+ variable gv into the block labelled keylookup. If not, then
+ we have to give it function scope so that the goto from the
+ earlier ':' case doesn't bypass the initialisation. */
+ if (0) {
+ just_a_word_zero_gv:
+ gv = NULL;
+ gvp = NULL;
+ }
just_a_word: {
SV *sv;
int pkgname = 0;
const char lastchar = (PL_bufptr == PL_oldoldbufptr ? 0 : PL_bufptr[-1]);
+ CV *cv;
/* Get the rest if it looks like a package qualifier */
if (len > 2 &&
PL_tokenbuf[len - 2] == ':' && PL_tokenbuf[len - 1] == ':')
{
- if (ckWARN(WARN_BAREWORD) && ! gv_fetchpv(PL_tokenbuf, FALSE, SVt_PVHV))
+ if (ckWARN(WARN_BAREWORD)
+ && ! gv_fetchpv(PL_tokenbuf, 0, SVt_PVHV))
Perl_warner(aTHX_ packWARN(WARN_BAREWORD),
"Bareword \"%s\" refers to nonexistent package",
PL_tokenbuf);
}
else {
len = 0;
- if (!gv)
- gv = gv_fetchpv(PL_tokenbuf, FALSE, SVt_PVCV);
+ if (!gv) {
+ /* Mustn't actually add anything to a symbol table.
+ But also don't want to "initialise" any placeholder
+ constants that might already be there into full
+ blown PVGVs with attached PVCV. */
+ gv = gv_fetchpv(PL_tokenbuf, GV_NOADD_NOINIT,
+ SVt_PVCV);
+ }
}
/* 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 {
if (len)
goto safe_bareword;
+ /* Do the explicit type check so that we don't need to force
+ the initialisation of the symbol table to have a real GV.
+ Beware - gv may not really be a PVGV, cv may not really be
+ a PVCV, (because of the space optimisations that gv_init
+ understands) But they're true if for this symbol there is
+ respectively a typeglob and a subroutine.
+ */
+ cv = gv ? ((SvTYPE(gv) == SVt_PVGV)
+ /* Real typeglob, so get the real subroutine: */
+ ? GvCVu(gv)
+ /* A proxy for a subroutine in this package? */
+ : SvOK(gv) ? (CV *) gv : NULL)
+ : NULL;
+
/* See if it's the indirect object for a list operator. */
if (PL_oldoldbufptr &&
/* Two barewords in a row may indicate method call. */
- if ((isIDFIRST_lazy_if(s,UTF) || *s == '$') && (tmp=intuit_method(s,gv)))
+ if ((isIDFIRST_lazy_if(s,UTF) || *s == '$') &&
+ (tmp = intuit_method(s, gv, cv)))
return REPORT(tmp);
/* If not a declared subroutine, it's an indirect object. */
if (
( !immediate_paren && (PL_last_lop_op == OP_SORT ||
- ((!gv || !GvCVu(gv)) &&
+ ((!gv || !cv) &&
(PL_last_lop_op != OP_MAPSTART &&
PL_last_lop_op != OP_GREPSTART))))
|| (PL_tokenbuf[0] == '_' && PL_tokenbuf[1] == '\0'
/* If followed by a paren, it's certainly a subroutine. */
if (*s == '(') {
CLINE;
- if (gv && GvCVu(gv)) {
+ if (cv) {
for (d = s + 1; SPACE_OR_TAB(*d); d++) ;
- if (*d == ')' && (sv = cv_const_sv(GvCV(gv)))) {
+ if (*d == ')' && (sv = gv_const_sv(gv))) {
s = d + 1;
goto its_constant;
}
/* If followed by var or block, call it a method (unless sub) */
- if ((*s == '$' || *s == '{') && (!gv || !GvCVu(gv))) {
+ if ((*s == '$' || *s == '{') && (!gv || !cv)) {
PL_last_lop = PL_oldbufptr;
PL_last_lop_op = OP_METHOD;
PREBLOCK(METHOD);
if (!orig_keyword
&& (isIDFIRST_lazy_if(s,UTF) || *s == '$')
- && (tmp = intuit_method(s,gv)))
+ && (tmp = intuit_method(s, gv, cv)))
return REPORT(tmp);
/* Not a method, so call it a subroutine (if defined) */
- if (gv && GvCVu(gv)) {
- CV* cv;
+ if (cv) {
if (lastchar == '-' && ckWARN_d(WARN_AMBIGUOUS))
Perl_warner(aTHX_ packWARN(WARN_AMBIGUOUS),
"Ambiguous use of -%s resolved as -&%s()",
PL_tokenbuf, PL_tokenbuf);
/* Check for a constant sub */
- cv = GvCV(gv);
- if ((sv = cv_const_sv(cv))) {
+ if ((sv = gv_const_sv(gv))) {
its_constant:
SvREFCNT_dec(((SVOP*)yylval.opval)->op_sv);
((SVOP*)yylval.opval)->op_sv = SvREFCNT_inc(sv);
}
/* Resolve to GV now. */
+ if (SvTYPE(gv) != SVt_PVGV) {
+ gv = gv_fetchpv(PL_tokenbuf, 0, SVt_PVCV);
+ assert (SvTYPE(gv) == SVt_PVGV);
+ /* cv must have been some sort of placeholder, so
+ now needs replacing with a real code reference. */
+ cv = GvCV(gv);
+ }
+
op_free(yylval.opval);
yylval.opval = newCVREF(0, newGVOP(OP_GV, 0, gv));
yylval.opval->op_private |= OPpENTERSUB_NOPAREN;
const char *pname = "main";
if (PL_tokenbuf[2] == 'D')
pname = HvNAME_get(PL_curstash ? PL_curstash : PL_defstash);
- gv = gv_fetchpv(Perl_form(aTHX_ "%s::DATA", pname), TRUE, SVt_PVIO);
+ gv = gv_fetchpv(Perl_form(aTHX_ "%s::DATA", pname), GV_ADD,
+ SVt_PVIO);
GvMULTI_on(gv);
if (!GvIO(gv))
GvIOp(gv) = newIO();
/* 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
}
case KEY_chdir:
- (void)gv_fetchpv("ENV",TRUE, SVt_PVHV); /* may use HOME */
+ (void)gv_fetchpv("ENV", GV_ADD, SVt_PVHV); /* may use HOME */
UNI(OP_CHDIR);
case KEY_close:
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);
char ctl_l[2];
ctl_l[0] = toCTRL('L');
ctl_l[1] = '\0';
- gv_fetchpv(ctl_l,TRUE, SVt_PV);
+ gv_fetchpv(ctl_l, GV_ADD, SVt_PV);
}
#else
- gv_fetchpv("\f",TRUE, SVt_PV); /* Make sure $^L is defined */
+ gv_fetchpv("\f", GV_ADD, SVt_PV); /* Make sure $^L is defined */
#endif
UNI(OP_ENTERWRITE);
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;
table.
*/
if (pit == '@' && PL_lex_state != LEX_NORMAL && !PL_lex_brackets) {
- GV *gv = gv_fetchpv(PL_tokenbuf+1, FALSE, SVt_PVAV);
+ GV *gv = gv_fetchpv(PL_tokenbuf+1, 0, SVt_PVAV);
if ((!gv || ((PL_tokenbuf[0] == '@') ? !GvAV(gv) : !GvHV(gv)))
&& ckWARN(WARN_AMBIGUOUS))
{
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);
Copy("ARGV",d,5,char);
/* Check whether readline() is overriden */
- if (((gv_readline = gv_fetchpv("readline", FALSE, SVt_PVCV))
+ if (((gv_readline = gv_fetchpv("readline", 0, SVt_PVCV))
&& GvCVu(gv_readline) && GvIMPORTED_CV(gv_readline))
||
((gvp = (GV**)hv_fetch(PL_globalstash, "readline", 8, FALSE))
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;
/* If it's none of the above, it must be a literal filehandle
(<Foo::BAR> or <FOO>) so build a simple readline OP */
else {
- GV *gv = gv_fetchpv(d,TRUE, SVt_PVIO);
+ GV *gv = gv_fetchpv(d, GV_ADD, SVt_PVIO);
PL_lex_op = readline_overriden
? (OP*)newUNOP(OP_ENTERSUB, OPf_STACKED,
append_elem(OP_LIST,
/* 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))
https://perl5.git.perl.org / perl5.git / blobdiff