#define PERL_IN_TOKE_C
#include "perl.h"
-#define yylval (PL_parser->yylval)
+#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
#define PL_rsfp_filters (PL_parser->rsfp_filters)
#define PL_in_my (PL_parser->in_my)
#define PL_in_my_stash (PL_parser->in_my_stash)
+#define PL_tokenbuf (PL_parser->tokenbuf)
+#define PL_multi_end (PL_parser->multi_end)
+#define PL_error_count (PL_parser->error_count)
#ifdef PERL_MAD
# define PL_endwhite (PL_parser->endwhite)
#define PRETERMBLOCK(retval) return (PL_expect = XTERMBLOCK,PL_bufptr = s, REPORT(retval))
#define PREREF(retval) return (PL_expect = XREF,PL_bufptr = s, REPORT(retval))
#define TERM(retval) return (CLINE, PL_expect = XOPERATOR, PL_bufptr = s, REPORT(retval))
-#define LOOPX(f) return (yylval.ival=f, PL_expect=XTERM, PL_bufptr=s, REPORT((int)LOOPEX))
-#define FTST(f) return (yylval.ival=f, PL_expect=XTERMORDORDOR, PL_bufptr=s, REPORT((int)UNIOP))
-#define FUN0(f) return (yylval.ival=f, PL_expect=XOPERATOR, PL_bufptr=s, REPORT((int)FUNC0))
-#define FUN1(f) return (yylval.ival=f, PL_expect=XOPERATOR, PL_bufptr=s, REPORT((int)FUNC1))
-#define BOop(f) return ao((yylval.ival=f, PL_expect=XTERM, PL_bufptr=s, REPORT((int)BITOROP)))
-#define BAop(f) return ao((yylval.ival=f, PL_expect=XTERM, PL_bufptr=s, REPORT((int)BITANDOP)))
-#define SHop(f) return ao((yylval.ival=f, PL_expect=XTERM, PL_bufptr=s, REPORT((int)SHIFTOP)))
-#define PWop(f) return ao((yylval.ival=f, PL_expect=XTERM, PL_bufptr=s, REPORT((int)POWOP)))
-#define PMop(f) return(yylval.ival=f, PL_expect=XTERM, PL_bufptr=s, REPORT((int)MATCHOP))
-#define Aop(f) return ao((yylval.ival=f, PL_expect=XTERM, PL_bufptr=s, REPORT((int)ADDOP)))
-#define Mop(f) return ao((yylval.ival=f, PL_expect=XTERM, PL_bufptr=s, REPORT((int)MULOP)))
-#define Eop(f) return (yylval.ival=f, PL_expect=XTERM, PL_bufptr=s, REPORT((int)EQOP))
-#define Rop(f) return (yylval.ival=f, PL_expect=XTERM, PL_bufptr=s, REPORT((int)RELOP))
+#define LOOPX(f) return (pl_yylval.ival=f, PL_expect=XTERM, PL_bufptr=s, REPORT((int)LOOPEX))
+#define FTST(f) return (pl_yylval.ival=f, PL_expect=XTERMORDORDOR, PL_bufptr=s, REPORT((int)UNIOP))
+#define FUN0(f) return (pl_yylval.ival=f, PL_expect=XOPERATOR, PL_bufptr=s, REPORT((int)FUNC0))
+#define FUN1(f) return (pl_yylval.ival=f, PL_expect=XOPERATOR, PL_bufptr=s, REPORT((int)FUNC1))
+#define BOop(f) return ao((pl_yylval.ival=f, PL_expect=XTERM, PL_bufptr=s, REPORT((int)BITOROP)))
+#define BAop(f) return ao((pl_yylval.ival=f, PL_expect=XTERM, PL_bufptr=s, REPORT((int)BITANDOP)))
+#define SHop(f) return ao((pl_yylval.ival=f, PL_expect=XTERM, PL_bufptr=s, REPORT((int)SHIFTOP)))
+#define PWop(f) return ao((pl_yylval.ival=f, PL_expect=XTERM, PL_bufptr=s, REPORT((int)POWOP)))
+#define PMop(f) return(pl_yylval.ival=f, PL_expect=XTERM, PL_bufptr=s, REPORT((int)MATCHOP))
+#define Aop(f) return ao((pl_yylval.ival=f, PL_expect=XTERM, PL_bufptr=s, REPORT((int)ADDOP)))
+#define Mop(f) return ao((pl_yylval.ival=f, PL_expect=XTERM, PL_bufptr=s, REPORT((int)MULOP)))
+#define Eop(f) return (pl_yylval.ival=f, PL_expect=XTERM, PL_bufptr=s, REPORT((int)EQOP))
+#define Rop(f) return (pl_yylval.ival=f, PL_expect=XTERM, PL_bufptr=s, REPORT((int)RELOP))
/* This bit of chicanery makes a unary function followed by
* a parenthesis into a function with one argument, highest precedence.
* operator (such as C<shift // 0>).
*/
#define UNI2(f,x) { \
- yylval.ival = f; \
+ pl_yylval.ival = f; \
PL_expect = x; \
PL_bufptr = s; \
PL_last_uni = PL_oldbufptr; \
#define UNIDOR(f) UNI2(f,XTERMORDORDOR)
#define UNIBRACK(f) { \
- yylval.ival = f; \
+ pl_yylval.ival = f; \
PL_bufptr = s; \
PL_last_uni = PL_oldbufptr; \
if (*s == '(') \
}
/* grandfather return to old style */
-#define OLDLOP(f) return(yylval.ival=f,PL_expect = XTERM,PL_bufptr = s,(int)LSTOP)
+#define OLDLOP(f) return(pl_yylval.ival=f,PL_expect = XTERM,PL_bufptr = s,(int)LSTOP)
#ifdef DEBUGGING
-/* how to interpret the yylval associated with the token */
+/* how to interpret the pl_yylval associated with the token */
enum token_type {
TOKENTYPE_NONE,
TOKENTYPE_IVAL,
- TOKENTYPE_OPNUM, /* yylval.ival contains an opcode number */
+ TOKENTYPE_OPNUM, /* pl_yylval.ival contains an opcode number */
TOKENTYPE_PVAL,
TOKENTYPE_OPVAL,
TOKENTYPE_GVVAL
{ 0, TOKENTYPE_NONE, NULL }
};
-/* dump the returned token in rv, plus any optional arg in yylval */
+/* dump the returned token in rv, plus any optional arg in pl_yylval */
STATIC int
S_tokereport(pTHX_ I32 rv)
case TOKENTYPE_GVVAL: /* doesn't appear to be used */
break;
case TOKENTYPE_IVAL:
- Perl_sv_catpvf(aTHX_ report, "(ival=%"IVdf")", (IV)yylval.ival);
+ Perl_sv_catpvf(aTHX_ report, "(ival=%"IVdf")", (IV)pl_yylval.ival);
break;
case TOKENTYPE_OPNUM:
Perl_sv_catpvf(aTHX_ report, "(ival=op_%s)",
- PL_op_name[yylval.ival]);
+ PL_op_name[pl_yylval.ival]);
break;
case TOKENTYPE_PVAL:
- Perl_sv_catpvf(aTHX_ report, "(pval=\"%s\")", yylval.pval);
+ Perl_sv_catpvf(aTHX_ report, "(pval=\"%s\")", pl_yylval.pval);
break;
case TOKENTYPE_OPVAL:
- if (yylval.opval) {
+ if (pl_yylval.opval) {
Perl_sv_catpvf(aTHX_ report, "(opval=op_%s)",
- PL_op_name[yylval.opval->op_type]);
- if (yylval.opval->op_type == OP_CONST) {
+ PL_op_name[pl_yylval.opval->op_type]);
+ if (pl_yylval.opval->op_type == OP_CONST) {
Perl_sv_catpvf(aTHX_ report, " %s",
- SvPEEK(cSVOPx_sv(yylval.opval)));
+ SvPEEK(cSVOPx_sv(pl_yylval.opval)));
}
}
if (*PL_bufptr == '=') {
PL_bufptr++;
if (toketype == ANDAND)
- yylval.ival = OP_ANDASSIGN;
+ pl_yylval.ival = OP_ANDASSIGN;
else if (toketype == OROR)
- yylval.ival = OP_ORASSIGN;
+ pl_yylval.ival = OP_ORASSIGN;
else if (toketype == DORDOR)
- yylval.ival = OP_DORASSIGN;
+ pl_yylval.ival = OP_DORASSIGN;
toketype = ASSIGNOP;
}
return toketype;
#define FEATURE_IS_ENABLED(name) \
((0 != (PL_hints & HINT_LOCALIZE_HH)) \
&& S_feature_is_enabled(aTHX_ STR_WITH_LEN(name)))
+/* The longest string we pass in. */
+#define MAX_FEATURE_LEN (sizeof("switch")-1)
+
/*
* S_feature_is_enabled
* Check whether the named feature is enabled.
{
dVAR;
HV * const hinthv = GvHV(PL_hintgv);
- char he_name[32] = "feature_";
- (void) my_strlcpy(&he_name[8], name, 24);
+ char he_name[8 + MAX_FEATURE_LEN] = "feature_";
+ assert(namelen <= MAX_FEATURE_LEN);
+ memcpy(&he_name[8], name, namelen);
return (hinthv && hv_exists(hinthv, he_name, 8 + namelen));
}
if (t - s > 0) {
const STRLEN len = t - s;
#ifndef USE_ITHREADS
- const char * const cf = CopFILE(PL_curcop);
- STRLEN tmplen = cf ? strlen(cf) : 0;
+ SV *const temp_sv = CopFILESV(PL_curcop);
+ const char *cf;
+ STRLEN tmplen;
+
+ if (temp_sv) {
+ cf = SvPVX(temp_sv);
+ tmplen = SvCUR(temp_sv);
+ } else {
+ cf = NULL;
+ tmplen = 0;
+ }
+
if (tmplen > 7 && strnEQ(cf, "(eval ", 6)) {
/* must copy *{"::_<(eval N)[oldfilename:L]"}
* to *{"::_<newfilename"} */
S_lop(pTHX_ I32 f, int x, char *s)
{
dVAR;
- yylval.ival = f;
+ pl_yylval.ival = f;
CLINE;
PL_expect = x;
PL_bufptr = s;
S_newSV_maybe_utf8(pTHX_ const char *start, STRLEN len)
{
dVAR;
- SV * const sv = newSVpvn(start,len);
- if (UTF && !IN_BYTES && is_utf8_string((const U8*)start, len))
- SvUTF8_on(sv);
+ SV * const sv = newSVpvn_utf8(start, len,
+ UTF && !IN_BYTES
+ && is_utf8_string((const U8*)start, len));
return sv;
}
#endif
if (*d == ';' || isSPACE(*d) || *d == '}' || !*d) {
SV *ver;
- s = scan_num(s, &yylval);
- version = yylval.opval;
+ s = scan_num(s, &pl_yylval);
+ version = pl_yylval.opval;
ver = cSVOPx(version)->op_sv;
if (SvPOK(ver) && !SvNIOK(ver)) {
SvUPGRADE(ver, SVt_PVNV);
goto finish;
d = s;
if ( PL_hints & HINT_NEW_STRING ) {
- pv = sv_2mortal(newSVpvn(SvPVX_const(pv), len));
- if (SvUTF8(sv))
- SvUTF8_on(pv);
+ pv = newSVpvn_flags(SvPVX_const(pv), len, SVs_TEMP | SvUTF8(sv));
}
while (s < send) {
if (*s == '\\') {
SvCUR_set(sv, d - SvPVX_const(sv));
finish:
if ( PL_hints & HINT_NEW_STRING )
- return new_constant(NULL, 0, "q", sv, pv, "q");
+ return new_constant(NULL, 0, "q", sv, pv, "q", 1);
return sv;
}
/*
* S_sublex_start
- * Assumes that yylval.ival is the op we're creating (e.g. OP_LCFIRST).
+ * Assumes that pl_yylval.ival is the op we're creating (e.g. OP_LCFIRST).
*
* Pattern matching will set PL_lex_op to the pattern-matching op to
- * make (we return THING if yylval.ival is OP_NULL, PMFUNC otherwise).
+ * make (we return THING if pl_yylval.ival is OP_NULL, PMFUNC otherwise).
*
* OP_CONST and OP_READLINE are easy--just make the new op and return.
*
S_sublex_start(pTHX)
{
dVAR;
- register const I32 op_type = yylval.ival;
+ register const I32 op_type = pl_yylval.ival;
if (op_type == OP_NULL) {
- yylval.opval = PL_lex_op;
+ pl_yylval.opval = PL_lex_op;
PL_lex_op = NULL;
return THING;
}
/* Overloaded constants, nothing fancy: Convert to SVt_PV: */
STRLEN len;
const char * const p = SvPV_const(sv, len);
- SV * const nsv = newSVpvn(p, len);
- if (SvUTF8(sv))
- SvUTF8_on(nsv);
+ SV * const nsv = newSVpvn_flags(p, len, SvUTF8(sv));
SvREFCNT_dec(sv);
sv = nsv;
}
- yylval.opval = (OP*)newSVOP(op_type, 0, sv);
+ pl_yylval.opval = (OP*)newSVOP(op_type, 0, sv);
PL_lex_stuff = NULL;
/* Allow <FH> // "foo" */
if (op_type == OP_READLINE)
else if (op_type == OP_BACKTICK && PL_lex_op) {
/* readpipe() vas overriden */
cSVOPx(cLISTOPx(cUNOPx(PL_lex_op)->op_first)->op_first->op_sibling)->op_sv = tokeq(PL_lex_stuff);
- yylval.opval = PL_lex_op;
+ pl_yylval.opval = PL_lex_op;
PL_lex_op = NULL;
PL_lex_stuff = NULL;
return THING;
PL_expect = XTERM;
if (PL_lex_op) {
- yylval.opval = PL_lex_op;
+ pl_yylval.opval = PL_lex_op;
PL_lex_op = NULL;
return PMFUNC;
}
if (SvUTF8(PL_linestr))
SvUTF8_on(sv);
PL_expect = XOPERATOR;
- yylval.opval = (OP*)newSVOP(OP_CONST, 0, sv);
+ pl_yylval.opval = (OP*)newSVOP(OP_CONST, 0, sv);
return THING;
}
Returns a pointer to the character scanned up to. If this is
advanced from the start pointer supplied (i.e. if anything was
successfully parsed), will leave an OP for the substring scanned
- in yylval. Caller must intuit reason for not parsing further
+ in pl_yylval. Caller must intuit reason for not parsing further
by looking at the next characters herself.
In patterns:
SV *res;
STRLEN len;
const char *str;
- SV *type;
if (!e) {
yyerror("Missing right brace on \\N{}");
goto NUM_ESCAPE_INSERT;
}
res = newSVpvn(s + 1, e - s - 1);
- type = newSVpvn(s - 2,e - s + 3);
res = new_constant( NULL, 0, "charnames",
- res, NULL, SvPVX(type) );
- SvREFCNT_dec(type);
+ res, NULL, s - 2, e - s + 3 );
if (has_utf8)
sv_utf8_upgrade(res);
str = SvPV_const(res,len);
SvPV_shrink_to_cur(sv);
}
- /* return the substring (via yylval) only if we parsed anything */
+ /* return the substring (via pl_yylval) only if we parsed anything */
if (s > PL_bufptr) {
- if ( PL_hints & ( PL_lex_inpat ? HINT_NEW_RE : HINT_NEW_STRING ) )
- sv = new_constant(start, s - start,
- (const char *)(PL_lex_inpat ? "qr" : "q"),
- sv, NULL,
- (const char *)
- (( PL_lex_inwhat == OP_TRANS
- ? "tr"
- : ( (PL_lex_inwhat == OP_SUBST && !PL_lex_inpat)
- ? "s"
- : "qq"))));
- yylval.opval = (OP*)newSVOP(OP_CONST, 0, sv);
+ if ( PL_hints & ( PL_lex_inpat ? HINT_NEW_RE : HINT_NEW_STRING ) ) {
+ const char *const key = PL_lex_inpat ? "qr" : "q";
+ const STRLEN keylen = PL_lex_inpat ? 2 : 1;
+ const char *type;
+ STRLEN typelen;
+
+ if (PL_lex_inwhat == OP_TRANS) {
+ type = "tr";
+ typelen = 2;
+ } else if (PL_lex_inwhat == OP_SUBST && !PL_lex_inpat) {
+ type = "s";
+ typelen = 1;
+ } else {
+ type = "qq";
+ typelen = 2;
+ }
+
+ sv = S_new_constant(aTHX_ start, s - start, key, keylen, sv, NULL,
+ type, typelen);
+ }
+ pl_yylval.opval = (OP*)newSVOP(OP_CONST, 0, sv);
} else
SvREFCNT_dec(sv);
return s;
return 0;
}
-/*
- * S_incl_perldb
- * Return a string of Perl code to load the debugger. If PERL5DB
- * is set, it will return the contents of that, otherwise a
- * compile-time require of perl5db.pl.
- */
-
-STATIC const char*
-S_incl_perldb(pTHX)
-{
- dVAR;
- if (PL_perldb) {
- const char * const pdb = PerlEnv_getenv("PERL5DB");
-
- if (pdb)
- return pdb;
- SETERRNO(0,SS_NORMAL);
- return "BEGIN { require 'perl5db.pl' }";
- }
- return "";
-}
-
-
/* Encoded script support. filter_add() effectively inserts a
* 'pre-processing' function into the current source input stream.
* Note that the filter function only applies to the current source file
}
STATIC HV *
-S_find_in_my_stash(pTHX_ const char *pkgname, I32 len)
+S_find_in_my_stash(pTHX_ const char *pkgname, STRLEN len)
{
dVAR;
GV *gv;
if (gv && GvCV(gv)) {
SV * const sv = cv_const_sv(GvCV(gv));
if (sv)
- pkgname = SvPV_nolen_const(sv);
+ pkgname = SvPV_const(sv, len);
}
- return gv_stashpv(pkgname, 0);
+ return gv_stashpvn(pkgname, len, 0);
}
/*
{
GV **gvp;
GV *gv_readpipe = gv_fetchpvs("readpipe", GV_NOTQUAL, SVt_PVCV);
- yylval.ival = OP_BACKTICK;
+ pl_yylval.ival = OP_BACKTICK;
if ((gv_readpipe
&& GvCVu(gv_readpipe) && GvIMPORTED_CV(gv_readpipe))
||
newSVOP(OP_CONST, 0, &PL_sv_undef), /* value will be read later */
newCVREF(0, newGVOP(OP_GV, 0, gv_readpipe))));
}
- else {
- set_csh();
- }
}
#ifdef PERL_MAD
case FUNC0SUB:
case UNIOPSUB:
case LSTOPSUB:
- if (yylval.opval)
- append_madprops(PL_thismad, yylval.opval, 0);
+ if (pl_yylval.opval)
+ append_madprops(PL_thismad, pl_yylval.opval, 0);
PL_thismad = 0;
return optype;
}
/* Create new token struct. Note: opvals return early above. */
- yylval.tkval = newTOKEN(optype, yylval, PL_thismad);
+ pl_yylval.tkval = newTOKEN(optype, pl_yylval, PL_thismad);
PL_thismad = 0;
return optype;
}
s = force_word(s,WORD,FALSE,TRUE,FALSE);
s = force_version(s, FALSE);
}
- yylval.ival = is_use;
+ pl_yylval.ival = is_use;
return s;
}
#ifdef DEBUGGING
case LEX_KNOWNEXT:
#ifdef PERL_MAD
PL_lasttoke--;
- yylval = PL_nexttoke[PL_lasttoke].next_val;
+ pl_yylval = PL_nexttoke[PL_lasttoke].next_val;
if (PL_madskills) {
PL_thismad = PL_nexttoke[PL_lasttoke].next_mad;
PL_nexttoke[PL_lasttoke].next_mad = 0;
}
#else
PL_nexttoke--;
- yylval = PL_nextval[PL_nexttoke];
+ pl_yylval = PL_nextval[PL_nexttoke];
if (!PL_nexttoke) {
PL_lex_state = PL_lex_defer;
PL_expect = PL_lex_expect;
else
Perl_croak(aTHX_ "panic: yylex");
if (PL_madskills) {
- SV* const tmpsv = newSVpvs("");
- Perl_sv_catpvf(aTHX_ tmpsv, "\\%c", *s);
+ SV* const tmpsv = newSVpvs("\\ ");
+ /* replace the space with the character we want to escape
+ */
+ SvPVX(tmpsv)[1] = *s;
curmad('_', tmpsv);
}
PL_bufptr = s + 1;
if (!PL_lex_inpat)
sv = tokeq(sv);
else if ( PL_hints & HINT_NEW_RE )
- sv = new_constant(NULL, 0, "qr", sv, sv, "q");
- yylval.opval = (OP*)newSVOP(OP_CONST, 0, sv);
+ sv = new_constant(NULL, 0, "qr", sv, sv, "q", 1);
+ pl_yylval.opval = (OP*)newSVOP(OP_CONST, 0, sv);
s = PL_bufend;
}
else {
if (PL_madskills) {
curmad('X', newSVpvn(PL_bufptr,s-PL_bufptr));
}
- NEXTVAL_NEXTTOKE = yylval;
+ NEXTVAL_NEXTTOKE = pl_yylval;
PL_expect = XTERM;
force_next(THING);
if (PL_lex_starts++) {
default:
if (isIDFIRST_lazy_if(s,UTF))
goto keylookup;
- Perl_croak(aTHX_ "Unrecognized character \\x%02X", *s & 255);
+ len = UTF ? Perl_utf8_length(aTHX_ (U8 *) PL_linestart, (U8 *) s) : (STRLEN) (s - PL_linestart);
+ Perl_croak(aTHX_ "Unrecognized character \\x%02X in column %d", *s & 255, (int) len + 1);
case 4:
case 26:
goto fake_eof; /* emulate EOF on ^D or ^Z */
if (PL_madskills)
PL_faketokens = 1;
#endif
- sv_setpv(PL_linestr,incl_perldb());
- if (SvCUR(PL_linestr))
- sv_catpvs(PL_linestr,";");
- if (PL_preambleav){
- while(AvFILLp(PL_preambleav) >= 0) {
- SV *tmpsv = av_shift(PL_preambleav);
- sv_catsv(PL_linestr, tmpsv);
+ if (PL_perldb) {
+ /* Generate a string of Perl code to load the debugger.
+ * If PERL5DB is set, it will return the contents of that,
+ * otherwise a compile-time require of perl5db.pl. */
+
+ const char * const pdb = PerlEnv_getenv("PERL5DB");
+
+ if (pdb) {
+ sv_setpv(PL_linestr, pdb);
+ sv_catpvs(PL_linestr,";");
+ } else {
+ SETERRNO(0,SS_NORMAL);
+ sv_setpvs(PL_linestr, "BEGIN { require 'perl5db.pl' };");
+ }
+ } else
+ sv_setpvs(PL_linestr,"");
+ if (PL_preambleav) {
+ SV **svp = AvARRAY(PL_preambleav);
+ SV **const end = svp + AvFILLp(PL_preambleav);
+ while(svp <= end) {
+ sv_catsv(PL_linestr, *svp);
+ ++svp;
sv_catpvs(PL_linestr, ";");
- sv_free(tmpsv);
}
sv_free((SV*)PL_preambleav);
PL_preambleav = NULL;
}
}
if (PL_minus_E)
- sv_catpvs(PL_linestr,"use feature ':5.10';");
+ sv_catpvs(PL_linestr,
+ "use feature ':5." STRINGIFY(PERL_VERSION) "';");
sv_catpvs(PL_linestr, "\n");
PL_oldoldbufptr = PL_oldbufptr = s = PL_linestart = SvPVX(PL_linestr);
PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr);
if (PL_madskills)
PL_faketokens = 1;
#endif
- sv_setpv(PL_linestr,
- (const char *)
- (PL_minus_p
- ? ";}continue{print;}" : ";}"));
+ if (PL_minus_p)
+ sv_setpvs(PL_linestr, ";}continue{print;}");
+ else
+ sv_setpvs(PL_linestr, ";}");
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;
const U32 oldpdb = PL_perldb;
const bool oldn = PL_minus_n;
const bool oldp = PL_minus_p;
+ const char *d1 = d;
do {
- if (*d == 'M' || *d == 'm' || *d == 'C') {
- const char * const m = d;
- while (*d && !isSPACE(*d))
- d++;
+ if (*d1 == 'M' || *d1 == 'm' || *d1 == 'C') {
+ const char * const m = d1;
+ while (*d1 && !isSPACE(*d1))
+ d1++;
Perl_croak(aTHX_ "Too late for \"-%.*s\" option",
- (int)(d - m), m);
+ (int)(d1 - m), m);
}
- d = moreswitches(d);
- } while (d);
+ d1 = moreswitches(d1);
+ } while (d1);
if (PL_doswitches && !switches_done) {
int argc = PL_origargc;
char **argv = PL_origargv;
switch (tmp) {
case KEY_or:
case KEY_and:
- case KEY_err:
case KEY_for:
case KEY_unless:
case KEY_if:
sv_free(sv);
if (PL_in_my == KEY_our) {
#ifdef USE_ITHREADS
- GvUNIQUE_on(cGVOPx_gv(yylval.opval));
+ GvUNIQUE_on(cGVOPx_gv(pl_yylval.opval));
#else
/* skip to avoid loading attributes.pm */
#endif
sv_free(sv);
CvMETHOD_on(PL_compcv);
}
- else if (!PL_in_my && len == 9 && strnEQ(SvPVX(sv), "assertion", len)) {
- sv_free(sv);
- CvASSERTION_on(PL_compcv);
- }
/* After we've set the flags, it could be argued that
we don't need to do the attributes.pm-based setting
process, and shouldn't bother appending recognized
--PL_lex_brackets;
if (PL_lex_state == LEX_INTERPNORMAL) {
if (PL_lex_brackets == 0) {
- if (*s != '[' && *s != '{' && (*s != '-' || s[1] != '>'))
+ if (*s == '-' && s[1] == '>')
+ PL_lex_state = LEX_INTERPENDMAYBE;
+ else if (*s != '[' && *s != '{')
PL_lex_state = LEX_INTERPEND;
}
}
}
break;
}
- yylval.ival = CopLINE(PL_curcop);
+ pl_yylval.ival = CopLINE(PL_curcop);
if (isSPACE(*s) || *s == '#')
PL_copline = NOLINE; /* invalidate current command line number */
TOKEN('{');
}
else
PREREF('&');
- yylval.ival = (OPpENTERSUB_AMPER<<8);
+ pl_yylval.ival = (OPpENTERSUB_AMPER<<8);
TERM('&');
case '|':
goto leftbracket;
}
}
- yylval.ival = 0;
+ pl_yylval.ival = 0;
OPERATOR(ASSIGNOP);
case '!':
s++;
/* This kludge not intended to be bulletproof. */
if (PL_tokenbuf[1] == '[' && !PL_tokenbuf[2]) {
- yylval.opval = newSVOP(OP_CONST, 0,
+ pl_yylval.opval = newSVOP(OP_CONST, 0,
newSViv(CopARYBASE_get(&PL_compiling)));
- yylval.opval->op_private = OPpCONST_ARYBASE;
+ pl_yylval.opval->op_private = OPpCONST_ARYBASE;
TERM(THING);
}
s++;
if (*s == tmp) {
s++;
- yylval.ival = OPf_SPECIAL;
+ pl_yylval.ival = OPf_SPECIAL;
}
else
- yylval.ival = 0;
+ pl_yylval.ival = 0;
OPERATOR(DOTDOT);
}
if (PL_expect != XOPERATOR)
/* FALL THROUGH */
case '0': case '1': case '2': case '3': case '4':
case '5': case '6': case '7': case '8': case '9':
- s = scan_num(s, &yylval);
+ s = scan_num(s, &pl_yylval);
DEBUG_T( { printbuf("### Saw number in %s\n", s); } );
if (PL_expect == XOPERATOR)
no_op("Number",s);
}
if (!s)
missingterm(NULL);
- yylval.ival = OP_CONST;
+ pl_yylval.ival = OP_CONST;
TERM(sublex_start());
case '"':
}
if (!s)
missingterm(NULL);
- yylval.ival = OP_CONST;
+ pl_yylval.ival = OP_CONST;
/* FIXME. I think that this can be const if char *d is replaced by
more localised variables. */
for (d = SvPV(PL_lex_stuff, len); len; len--, d++) {
if (*d == '$' || *d == '@' || *d == '\\' || !UTF8_IS_INVARIANT((U8)*d)) {
- yylval.ival = OP_STRINGIFY;
+ pl_yylval.ival = OP_STRINGIFY;
break;
}
}
while (isDIGIT(*start) || *start == '_')
start++;
if (*start == '.' && isDIGIT(start[1])) {
- s = scan_num(s, &yylval);
+ s = scan_num(s, &pl_yylval);
TERM(THING);
}
/* avoid v123abc() or $h{v1}, allow C<print v10;> */
else if (!isALPHA(*start) && (PL_expect == XTERM
|| PL_expect == XREF || PL_expect == XSTATE
|| PL_expect == XTERMORDORDOR)) {
- /* XXX Use gv_fetchpvn rather than stomping on a const string */
- const char c = *start;
- GV *gv;
- *start = '\0';
- gv = gv_fetchpv(s, 0, SVt_PVCV);
- *start = c;
+ GV *const gv = gv_fetchpvn_flags(s, start - s, 0, SVt_PVCV);
if (!gv) {
- s = scan_num(s, &yylval);
+ s = scan_num(s, &pl_yylval);
TERM(THING);
}
}
if (!tmp && PL_expect == XSTATE
&& d < PL_bufend && *d == ':' && *(d + 1) != ':') {
s = d + 1;
- yylval.pval = CopLABEL_alloc(PL_tokenbuf);
+ pl_yylval.pval = CopLABEL_alloc(PL_tokenbuf);
CLINE;
TOKEN(LABEL);
}
/* Is this a word before a => operator? */
if (*d == '=' && d[1] == '>') {
CLINE;
- yylval.opval
+ pl_yylval.opval
= (OP*)newSVOP(OP_CONST, 0,
S_newSV_maybe_utf8(aTHX_ PL_tokenbuf, len));
- yylval.opval->op_private = OPpCONST_BARE;
+ pl_yylval.opval->op_private = OPpCONST_BARE;
TERM(WORD);
}
#ifdef PERL_MAD
if (PL_madskills && !PL_thistoken) {
char *start = SvPVX(PL_linestr) + PL_realtokenstart;
- PL_thistoken = newSVpv(start,s - start);
+ PL_thistoken = newSVpvn(start,s - start);
PL_realtokenstart = s - SvPVX(PL_linestr);
}
#endif
/* Presume this is going to be a bareword of some sort. */
CLINE;
- yylval.opval = (OP*)newSVOP(OP_CONST, 0, sv);
- yylval.opval->op_private = OPpCONST_BARE;
+ 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)))
/* Is this a word before a => operator? */
if (*s == '=' && s[1] == '>' && !pkgname) {
CLINE;
- sv_setpv(((SVOP*)yylval.opval)->op_sv, PL_tokenbuf);
+ sv_setpv(((SVOP*)pl_yylval.opval)->op_sv, PL_tokenbuf);
if (UTF && !IN_BYTES && is_utf8_string((U8*)PL_tokenbuf, len))
- SvUTF8_on(((SVOP*)yylval.opval)->op_sv);
+ SvUTF8_on(((SVOP*)pl_yylval.opval)->op_sv);
TERM(WORD);
}
d++;
if (*d == ')' && (sv = gv_const_sv(gv))) {
s = d + 1;
-#ifdef PERL_MAD
- if (PL_madskills) {
- char *par = SvPVX(PL_linestr) + PL_realtokenstart;
- sv_catpvn(PL_thistoken, par, s - par);
- if (PL_nextwhite) {
- sv_free(PL_nextwhite);
- PL_nextwhite = 0;
- }
- }
- else
-#endif
- goto its_constant;
+ goto its_constant;
}
}
#ifdef PERL_MAD
}
start_force(PL_curforce);
#endif
- NEXTVAL_NEXTTOKE.opval = yylval.opval;
+ NEXTVAL_NEXTTOKE.opval = pl_yylval.opval;
PL_expect = XOPERATOR;
#ifdef PERL_MAD
if (PL_madskills) {
}
#endif
force_next(WORD);
- yylval.ival = 0;
+ pl_yylval.ival = 0;
TOKEN('&');
}
"Ambiguous use of -%s resolved as -&%s()",
PL_tokenbuf, PL_tokenbuf);
/* Check for a constant sub */
- if ((sv = gv_const_sv(gv)) && !PL_madskills) {
+ if ((sv = gv_const_sv(gv))) {
its_constant:
- SvREFCNT_dec(((SVOP*)yylval.opval)->op_sv);
- ((SVOP*)yylval.opval)->op_sv = SvREFCNT_inc_simple(sv);
- yylval.opval->op_private = 0;
+ SvREFCNT_dec(((SVOP*)pl_yylval.opval)->op_sv);
+ ((SVOP*)pl_yylval.opval)->op_sv = SvREFCNT_inc_simple(sv);
+ pl_yylval.opval->op_private = 0;
TOKEN(WORD);
}
cv = GvCV(gv);
}
- op_free(yylval.opval);
- yylval.opval = newCVREF(0, newGVOP(OP_GV, 0, gv));
- yylval.opval->op_private |= OPpENTERSUB_NOPAREN;
+ op_free(pl_yylval.opval);
+ pl_yylval.opval = newCVREF(0, newGVOP(OP_GV, 0, gv));
+ pl_yylval.opval->op_private |= OPpENTERSUB_NOPAREN;
PL_last_lop = PL_oldbufptr;
PL_last_lop_op = OP_ENTERSUB;
/* Is there a prototype? */
while (*proto == ';')
proto++;
if (*proto == '&' && *s == '{') {
- sv_setpv(PL_subname,
- (const char *)
- (PL_curstash ?
- "__ANON__" : "__ANON__::__ANON__"));
+ if (PL_curstash)
+ sv_setpvs(PL_subname, "__ANON__");
+ else
+ sv_setpvs(PL_subname, "__ANON__::__ANON__");
PREBLOCK(LSTOPSUB);
}
}
PL_thiswhite = 0;
}
start_force(PL_curforce);
- NEXTVAL_NEXTTOKE.opval = yylval.opval;
+ NEXTVAL_NEXTTOKE.opval = pl_yylval.opval;
PL_expect = XTERM;
if (PL_madskills) {
PL_nextwhite = nextPL_nextwhite;
}
if (probable_sub) {
gv = gv_fetchpv(PL_tokenbuf, GV_ADD, SVt_PVCV);
- op_free(yylval.opval);
- yylval.opval = newCVREF(0, newGVOP(OP_GV, 0, gv));
- yylval.opval->op_private |= OPpENTERSUB_NOPAREN;
+ op_free(pl_yylval.opval);
+ pl_yylval.opval = newCVREF(0, newGVOP(OP_GV, 0, gv));
+ pl_yylval.opval->op_private |= OPpENTERSUB_NOPAREN;
PL_last_lop = PL_oldbufptr;
PL_last_lop_op = OP_ENTERSUB;
PL_nextwhite = PL_thiswhite;
PL_thiswhite = 0;
start_force(PL_curforce);
- NEXTVAL_NEXTTOKE.opval = yylval.opval;
+ NEXTVAL_NEXTTOKE.opval = pl_yylval.opval;
PL_expect = XTERM;
PL_nextwhite = nextPL_nextwhite;
curmad('X', PL_thistoken);
TOKEN(NOAMP);
}
#else
- NEXTVAL_NEXTTOKE.opval = yylval.opval;
+ NEXTVAL_NEXTTOKE.opval = pl_yylval.opval;
PL_expect = XTERM;
force_next(WORD);
TOKEN(NOAMP);
/* Call it a bare word */
if (PL_hints & HINT_STRICT_SUBS)
- yylval.opval->op_private |= OPpCONST_STRICT;
+ pl_yylval.opval->op_private |= OPpCONST_STRICT;
else {
bareword:
if (lastchar != '-') {
}
case KEY___FILE__:
- yylval.opval = (OP*)newSVOP(OP_CONST, 0,
+ pl_yylval.opval = (OP*)newSVOP(OP_CONST, 0,
newSVpv(CopFILE(PL_curcop),0));
TERM(THING);
case KEY___LINE__:
- yylval.opval = (OP*)newSVOP(OP_CONST, 0,
+ pl_yylval.opval = (OP*)newSVOP(OP_CONST, 0,
Perl_newSVpvf(aTHX_ "%"IVdf, (IV)CopLINE(PL_curcop)));
TERM(THING);
case KEY___PACKAGE__:
- yylval.opval = (OP*)newSVOP(OP_CONST, 0,
+ pl_yylval.opval = (OP*)newSVOP(OP_CONST, 0,
(PL_curstash
? newSVhek(HvNAME_HEK(PL_curstash))
: &PL_sv_undef));
PL_realtokenstart = -1;
}
while ((s = filter_gets(PL_endwhite, PL_rsfp,
- SvCUR(PL_endwhite))) != Nullch) ;
+ SvCUR(PL_endwhite))) != NULL) ;
}
#endif
PL_rsfp = NULL;
s = force_word(s,WORD,TRUE,TRUE,FALSE);
if (orig_keyword == KEY_do) {
orig_keyword = 0;
- yylval.ival = 1;
+ pl_yylval.ival = 1;
}
else
- yylval.ival = 0;
+ pl_yylval.ival = 0;
OPERATOR(DO);
case KEY_die:
PREBLOCK(ELSE);
case KEY_elsif:
- yylval.ival = CopLINE(PL_curcop);
+ pl_yylval.ival = CopLINE(PL_curcop);
OPERATOR(ELSIF);
case KEY_eq:
case KEY_eof:
UNI(OP_EOF);
- case KEY_err:
- OPERATOR(DOROP);
-
case KEY_exp:
UNI(OP_EXP);
UNI(OP_EACH);
case KEY_exec:
- set_csh();
LOP(OP_EXEC,XREF);
case KEY_endhostent:
case KEY_for:
case KEY_foreach:
- yylval.ival = CopLINE(PL_curcop);
+ pl_yylval.ival = CopLINE(PL_curcop);
s = SKIPSPACE1(s);
if (PL_expect == XSTATE && isIDFIRST_lazy_if(s,UTF)) {
char *p = s;
FUN0(OP_GETLOGIN);
case KEY_given:
- yylval.ival = CopLINE(PL_curcop);
+ pl_yylval.ival = CopLINE(PL_curcop);
OPERATOR(GIVEN);
case KEY_glob:
- set_csh();
LOP(OP_GLOB,XTERM);
case KEY_hex:
UNI(OP_HEX);
case KEY_if:
- yylval.ival = CopLINE(PL_curcop);
+ pl_yylval.ival = CopLINE(PL_curcop);
OPERATOR(IF);
case KEY_index:
UNI(OP_LCFIRST);
case KEY_local:
- yylval.ival = 0;
+ pl_yylval.ival = 0;
OPERATOR(LOCAL);
case KEY_length:
}
#endif
}
- yylval.ival = 1;
+ pl_yylval.ival = 1;
OPERATOR(MY);
case KEY_next:
LOP(OP_OPEN,XTERM);
case KEY_or:
- yylval.ival = OP_OR;
+ pl_yylval.ival = OP_OR;
OPERATOR(OROP);
case KEY_ord:
s = scan_str(s,!!PL_madskills,FALSE);
if (!s)
missingterm(NULL);
- yylval.ival = OP_CONST;
+ pl_yylval.ival = OP_CONST;
TERM(sublex_start());
case KEY_quotemeta:
for (; !isSPACE(*d) && len; --len, ++d)
/**/;
}
- sv = newSVpvn(b, d-b);
- if (DO_UTF8(PL_lex_stuff))
- SvUTF8_on(sv);
+ sv = newSVpvn_utf8(b, d-b, DO_UTF8(PL_lex_stuff));
words = append_elem(OP_LIST, words,
newSVOP(OP_CONST, 0, tokeq(sv)));
}
s = scan_str(s,!!PL_madskills,FALSE);
if (!s)
missingterm(NULL);
- yylval.ival = OP_STRINGIFY;
+ pl_yylval.ival = OP_STRINGIFY;
if (SvIVX(PL_lex_stuff) == '\'')
SvIV_set(PL_lex_stuff, 0); /* qq'$foo' should intepolate */
TERM(sublex_start());
}
if (orig_keyword == KEY_require) {
orig_keyword = 0;
- yylval.ival = 1;
+ pl_yylval.ival = 1;
}
else
- yylval.ival = 0;
+ pl_yylval.ival = 0;
PL_expect = XTERM;
PL_bufptr = s;
PL_last_uni = PL_oldbufptr;
UNI(OP_READDIR);
case KEY_readline:
- set_csh();
UNIDOR(OP_READLINE);
case KEY_readpipe:
- set_csh();
UNIDOR(OP_BACKTICK);
case KEY_rewinddir:
case KEY_s:
s = scan_subst(s);
- if (yylval.opval)
+ if (pl_yylval.opval)
TERM(sublex_start());
else
TOKEN(1); /* force error */
CURMAD('Q', PL_thisclose);
NEXTVAL_NEXTTOKE.opval =
(OP*)newSVOP(OP_CONST, 0, PL_lex_stuff);
- PL_lex_stuff = Nullsv;
+ PL_lex_stuff = NULL;
force_next(THING);
s = SKIPSPACE2(s,tmpwhite);
}
#endif
if (!have_name) {
- sv_setpv(PL_subname,
- (const char *)
- (PL_curstash ? "__ANON__" : "__ANON__::__ANON__"));
+ if (PL_curstash)
+ sv_setpvs(PL_subname, "__ANON__");
+ else
+ sv_setpvs(PL_subname, "__ANON__::__ANON__");
TOKEN(ANONSUB);
}
#ifndef PERL_MAD
}
case KEY_system:
- set_csh();
LOP(OP_SYSTEM,XREF);
case KEY_symlink:
UNI(OP_UNTIE);
case KEY_until:
- yylval.ival = CopLINE(PL_curcop);
+ pl_yylval.ival = CopLINE(PL_curcop);
OPERATOR(UNTIL);
case KEY_unless:
- yylval.ival = CopLINE(PL_curcop);
+ pl_yylval.ival = CopLINE(PL_curcop);
OPERATOR(UNLESS);
case KEY_unlink:
LOP(OP_VEC,XTERM);
case KEY_when:
- yylval.ival = CopLINE(PL_curcop);
+ pl_yylval.ival = CopLINE(PL_curcop);
OPERATOR(WHEN);
case KEY_while:
- yylval.ival = CopLINE(PL_curcop);
+ pl_yylval.ival = CopLINE(PL_curcop);
OPERATOR(WHILE);
case KEY_warn:
goto just_a_word;
case KEY_xor:
- yylval.ival = OP_XOR;
+ pl_yylval.ival = OP_XOR;
OPERATOR(OROP);
case KEY_y:
PADOFFSET tmp = 0;
/* pit holds the identifier we read and pending_ident is reset */
char pit = PL_pending_ident;
+ const STRLEN tokenbuf_len = strlen(PL_tokenbuf);
+ /* All routes through this function want to know if there is a colon. */
+ const char *const has_colon = (const char*) memchr (PL_tokenbuf, ':', tokenbuf_len);
PL_pending_ident = 0;
/* PL_realtokenstart = realtokenend = PL_bufptr - SvPVX(PL_linestr); */
*/
if (PL_in_my) {
if (PL_in_my == KEY_our) { /* "our" is merely analogous to "my" */
- if (strchr(PL_tokenbuf,':'))
+ if (has_colon)
yyerror(Perl_form(aTHX_ "No package name allowed for "
"variable %s in \"our\"",
PL_tokenbuf));
tmp = allocmy(PL_tokenbuf);
}
else {
- if (strchr(PL_tokenbuf,':'))
+ if (has_colon)
yyerror(Perl_form(aTHX_ PL_no_myglob,
PL_in_my == KEY_my ? "my" : "state", PL_tokenbuf));
- yylval.opval = newOP(OP_PADANY, 0);
- yylval.opval->op_targ = allocmy(PL_tokenbuf);
+ pl_yylval.opval = newOP(OP_PADANY, 0);
+ pl_yylval.opval->op_targ = allocmy(PL_tokenbuf);
return PRIVATEREF;
}
}
(although why you'd do that is anyone's guess).
*/
- if (!strchr(PL_tokenbuf,':')) {
+ if (!has_colon) {
if (!PL_in_my)
tmp = pad_findmy(PL_tokenbuf);
if (tmp != NOT_IN_PAD) {
HEK * const stashname = HvNAME_HEK(stash);
SV * const sym = newSVhek(stashname);
sv_catpvs(sym, "::");
- sv_catpv(sym, PL_tokenbuf+1);
- yylval.opval = (OP*)newSVOP(OP_CONST, 0, sym);
- yylval.opval->op_private = OPpCONST_ENTERED;
+ sv_catpvn(sym, PL_tokenbuf+1, tokenbuf_len - 1);
+ pl_yylval.opval = (OP*)newSVOP(OP_CONST, 0, sym);
+ pl_yylval.opval->op_private = OPpCONST_ENTERED;
gv_fetchsv(sym,
(PL_in_eval
? (GV_ADDMULTI | GV_ADDINEVAL)
}
}
- yylval.opval = newOP(OP_PADANY, 0);
- yylval.opval->op_targ = tmp;
+ pl_yylval.opval = newOP(OP_PADANY, 0);
+ pl_yylval.opval->op_targ = tmp;
return PRIVATEREF;
}
}
table.
*/
if (pit == '@' && PL_lex_state != LEX_NORMAL && !PL_lex_brackets) {
- GV *gv = gv_fetchpv(PL_tokenbuf+1, 0, SVt_PVAV);
+ GV *const gv = gv_fetchpvn_flags(PL_tokenbuf + 1, tokenbuf_len - 1, 0,
+ SVt_PVAV);
if ((!gv || ((PL_tokenbuf[0] == '@') ? !GvAV(gv) : !GvHV(gv)))
&& ckWARN(WARN_AMBIGUOUS)
/* DO NOT warn for @- and @+ */
}
/* build ops for a bareword */
- yylval.opval = (OP*)newSVOP(OP_CONST, 0, newSVpv(PL_tokenbuf+1, 0));
- yylval.opval->op_private = OPpCONST_ENTERED;
- gv_fetchpv(
- PL_tokenbuf+1,
+ 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
* tests still give the expected answers, even though what
* they're actually testing has now changed subtly.
*/
- (*PL_tokenbuf == '%' && *(d = PL_tokenbuf + strlen(PL_tokenbuf) - 1) == ':' && d[-1] == ':'
+ (*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
goto unknown;
- case 'r':
- if (name[2] == 'r')
- { /* err */
- return (all_keywords || FEATURE_IS_ENABLED("err") ? -KEY_err : 0);
- }
-
- goto unknown;
-
case 'x':
if (name[2] == 'p')
{ /* exp */
and type is used with error messages only. */
STATIC SV *
-S_new_constant(pTHX_ const char *s, STRLEN len, const char *key, SV *sv, SV *pv,
- const char *type)
+S_new_constant(pTHX_ const char *s, STRLEN len, const char *key, STRLEN keylen,
+ SV *sv, SV *pv, const char *type, STRLEN typelen)
{
dVAR; dSP;
HV * const table = GvHV(PL_hintgv); /* ^H */
SvREFCNT_dec(msg);
return sv;
}
- cvp = hv_fetch(table, key, strlen(key), FALSE);
+ cvp = hv_fetch(table, key, keylen, FALSE);
if (!cvp || !SvOK(*cvp)) {
why1 = "$^H{";
why2 = key;
sv_2mortal(sv); /* Parent created it permanently */
cv = *cvp;
if (!pv && s)
- pv = sv_2mortal(newSVpvn(s, len));
+ pv = newSVpvn_flags(s, len, SVs_TEMP);
if (type && pv)
- typesv = sv_2mortal(newSVpv(type, 0));
+ typesv = newSVpvn_flags(type, typelen, SVs_TEMP);
else
typesv = &PL_sv_undef;
}
PL_lex_op = (OP*)pm;
- yylval.ival = OP_MATCH;
+ pl_yylval.ival = OP_MATCH;
return s;
}
char *modstart;
#endif
- yylval.ival = OP_NULL;
+ pl_yylval.ival = OP_NULL;
s = scan_str(start,!!PL_madskills,FALSE);
PL_sublex_info.super_bufend = PL_bufend;
PL_multi_end = 0;
pm->op_pmflags |= PMf_EVAL;
- while (es-- > 0)
- sv_catpv(repl, (const char *)(es ? "eval " : "do "));
+ while (es-- > 0) {
+ if (es)
+ sv_catpvs(repl, "eval ");
+ else
+ sv_catpvs(repl, "do ");
+ }
sv_catpvs(repl, "{");
sv_catsv(repl, PL_lex_repl);
if (strchr(SvPVX(PL_lex_repl), '#'))
}
PL_lex_op = (OP*)pm;
- yylval.ival = OP_SUBST;
+ pl_yylval.ival = OP_SUBST;
return s;
}
char *modstart;
#endif
- yylval.ival = OP_NULL;
+ pl_yylval.ival = OP_NULL;
s = scan_str(start,!!PL_madskills,FALSE);
if (!s)
(DO_UTF8(PL_lex_repl) ? OPpTRANS_TO_UTF : 0);
PL_lex_op = o;
- yylval.ival = OP_TRANS;
+ pl_yylval.ival = OP_TRANS;
#ifdef PERL_MAD
if (PL_madskills) {
sv_recode_to_utf8(tmpstr, PL_encoding);
}
PL_lex_stuff = tmpstr;
- yylval.ival = op_type;
+ pl_yylval.ival = op_type;
return s;
}
/* scan_inputsymbol
takes: current position in input buffer
returns: new position in input buffer
- side-effects: yylval and lex_op are set.
+ side-effects: pl_yylval and lex_op are set.
This code handles:
*/
if (d - PL_tokenbuf != len) {
- yylval.ival = OP_GLOB;
- set_csh();
+ pl_yylval.ival = OP_GLOB;
s = scan_str(start,!!PL_madskills,FALSE);
if (!s)
Perl_croak(aTHX_ "Glob not terminated");
}
if (!readline_overriden)
PL_lex_op->op_flags |= OPf_SPECIAL;
- /* we created the ops in PL_lex_op, so make yylval.ival a null op */
- yylval.ival = OP_NULL;
+ /* we created the ops in PL_lex_op, so make pl_yylval.ival a null op */
+ pl_yylval.ival = OP_NULL;
}
/* If it's none of the above, it must be a literal filehandle
newGVOP(OP_GV, 0, gv),
newCVREF(0, newGVOP(OP_GV, 0, gv_readline))))
: (OP*)newUNOP(OP_READLINE, 0, newGVOP(OP_GV, 0, gv));
- yylval.ival = OP_NULL;
+ pl_yylval.ival = OP_NULL;
}
}
scan_num
takes: pointer to position in buffer
returns: pointer to new position in buffer
- side-effects: builds ops for the constant in yylval.op
+ side-effects: builds ops for the constant in pl_yylval.op
Read a number in any of the formats that Perl accepts:
}
if (just_zero && (PL_hints & HINT_NEW_INTEGER))
sv = new_constant(start, s - start, "integer",
- sv, NULL, NULL);
+ sv, NULL, NULL, 0);
else if (PL_hints & HINT_NEW_BINARY)
- sv = new_constant(start, s - start, "binary", sv, NULL, NULL);
+ sv = new_constant(start, s - start, "binary", sv, NULL, NULL, 0);
}
break;
sv_setnv(sv, nv);
}
- if ( floatit ? (PL_hints & HINT_NEW_FLOAT) :
- (PL_hints & HINT_NEW_INTEGER) )
- sv = new_constant(PL_tokenbuf,
- d - PL_tokenbuf,
- (const char *)
- (floatit ? "float" : "integer"),
- sv, NULL, NULL);
+ if ( floatit
+ ? (PL_hints & HINT_NEW_FLOAT) : (PL_hints & HINT_NEW_INTEGER) ) {
+ const char *const key = floatit ? "float" : "integer";
+ const STRLEN keylen = floatit ? 5 : 7;
+ sv = S_new_constant(aTHX_ PL_tokenbuf, d - PL_tokenbuf,
+ key, keylen, sv, NULL, NULL, 0);
+ }
break;
/* if it starts with a v, it could be a v-string */
return s;
}
-STATIC void
-S_set_csh(pTHX)
-{
-#ifdef CSH
- dVAR;
- if (!PL_cshlen)
- PL_cshlen = strlen(PL_cshname);
-#else
-#if defined(USE_ITHREADS)
- PERL_UNUSED_CONTEXT;
-#endif
-#endif
-}
-
I32
Perl_start_subparse(pTHX_ I32 is_format, U32 flags)
{
where = "within string";
}
else {
- SV * const where_sv = sv_2mortal(newSVpvs("next char "));
+ SV * const where_sv = newSVpvs_flags("next char ", SVs_TEMP);
if (yychar < 32)
Perl_sv_catpvf(aTHX_ where_sv, "^%c", toCTRL(yychar));
- else if (isPRINT_LC(yychar))
- Perl_sv_catpvf(aTHX_ where_sv, "%c", yychar);
+ else if (isPRINT_LC(yychar)) {
+ const char string = yychar;
+ sv_catpvn(where_sv, &string, 1);
+ }
else
Perl_sv_catpvf(aTHX_ where_sv, "\\%03o", yychar & 255);
where = SvPVX_const(where_sv);
(int)PL_multi_open,(int)PL_multi_close,(IV)PL_multi_start);
PL_multi_end = 0;
}
- if (PL_in_eval & EVAL_WARNONLY && ckWARN_d(WARN_SYNTAX))
- Perl_warner(aTHX_ packWARN(WARN_SYNTAX), "%"SVf, SVfARG(msg));
+ if (PL_in_eval & EVAL_WARNONLY) {
+ if (ckWARN_d(WARN_SYNTAX))
+ Perl_warner(aTHX_ packWARN(WARN_SYNTAX), "%"SVf, SVfARG(msg));
+ }
else
qerror(msg);
if (PL_error_count >= 10) {
https://perl5.git.perl.org / perl5.git / blobdiff