*/
STATIC void
-S_incline(pTHX_ char *s)
+S_incline(pTHX_ const char *s)
{
dVAR;
- char *t;
- char *n;
- char *e;
- char ch;
+ const char *t;
+ const char *n;
+ const char *e;
CopLINE_inc(PL_curcop);
if (*s++ != '#')
if (*e != '\n' && *e != '\0')
return; /* false alarm */
- ch = *t;
- *t = '\0';
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;
if (tmplen > 7 && strnEQ(cf, "(eval ", 6)) {
/* must copy *{"::_<(eval N)[oldfilename:L]"}
* to *{"::_<newfilename"} */
- char smallbuf[256], smallbuf2[256];
- char *tmpbuf, *tmpbuf2;
- GV **gvp, *gv2;
- STRLEN tmplen2 = strlen(s);
- if (tmplen + 3 < sizeof smallbuf)
+ /* However, the long form of evals is only turned on by the
+ debugger - usually they're "(eval %lu)" */
+ char smallbuf[128];
+ char *tmpbuf;
+ GV **gvp;
+ STRLEN tmplen2 = len;
+ if (tmplen + 2 <= sizeof smallbuf)
tmpbuf = smallbuf;
else
- Newx(tmpbuf, tmplen + 3, char);
- if (tmplen2 + 3 < sizeof smallbuf2)
- tmpbuf2 = smallbuf2;
- else
- Newx(tmpbuf2, tmplen2 + 3, char);
- tmpbuf[0] = tmpbuf2[0] = '_';
- tmpbuf[1] = tmpbuf2[1] = '<';
- memcpy(tmpbuf + 2, cf, ++tmplen);
- memcpy(tmpbuf2 + 2, s, ++tmplen2);
- ++tmplen; ++tmplen2;
+ Newx(tmpbuf, tmplen + 2, char);
+ tmpbuf[0] = '_';
+ tmpbuf[1] = '<';
+ memcpy(tmpbuf + 2, cf, tmplen);
+ tmplen += 2;
gvp = (GV**)hv_fetch(PL_defstash, tmpbuf, tmplen, FALSE);
if (gvp) {
+ char *tmpbuf2;
+ GV *gv2;
+
+ if (tmplen2 + 2 <= sizeof smallbuf)
+ tmpbuf2 = smallbuf;
+ else
+ Newx(tmpbuf2, tmplen2 + 2, char);
+
+ if (tmpbuf2 != smallbuf || tmpbuf != smallbuf) {
+ /* Either they malloc'd it, or we malloc'd it,
+ so no prefix is present in ours. */
+ tmpbuf2[0] = '_';
+ tmpbuf2[1] = '<';
+ }
+
+ memcpy(tmpbuf2 + 2, s, tmplen2);
+ tmplen2 += 2;
+
gv2 = *(GV**)hv_fetch(PL_defstash, tmpbuf2, tmplen2, TRUE);
if (!isGV(gv2)) {
gv_init(gv2, PL_defstash, tmpbuf2, tmplen2, FALSE);
GvHV(gv2) = (HV*)SvREFCNT_inc(GvHV(*gvp));
GvAV(gv2) = (AV*)SvREFCNT_inc(GvAV(*gvp));
}
+
+ if (tmpbuf2 != smallbuf) Safefree(tmpbuf2);
}
if (tmpbuf != smallbuf) Safefree(tmpbuf);
- if (tmpbuf2 != smallbuf2) Safefree(tmpbuf2);
}
#endif
CopFILE_free(PL_curcop);
- CopFILE_set(PL_curcop, s);
+ CopFILE_setn(PL_curcop, s, len);
}
- *t = ch;
CopLINE_set(PL_curcop, atoi(n)-1);
}
if (indirgv && GvCVu(indirgv))
return 0;
/* filehandle or package name makes it a method */
- if (!gv || GvIO(indirgv) || gv_stashpvn(tmpbuf, len, FALSE)) {
+ if (!gv || GvIO(indirgv) || gv_stashpvn(tmpbuf, len, 0)) {
#ifdef PERL_MAD
soff = s - SvPVX(PL_linestr);
#endif
pkgname = SvPV_nolen_const(sv);
}
- return gv_stashpv(pkgname, FALSE);
+ return gv_stashpv(pkgname, 0);
}
/*
/* FALL THROUGH */
case '~':
if (s[1] == '~'
- && (PL_expect == XOPERATOR || PL_expect == XTERMORDORDOR)
- && FEATURE_IS_ENABLED("~~"))
+ && (PL_expect == XOPERATOR || PL_expect == XTERMORDORDOR))
{
s += 2;
Eop(OP_SMARTMATCH);
}
}
if (probable_sub) {
- gv = gv_fetchpv(PL_tokenbuf, TRUE, SVt_PVCV);
+ 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;
d = PL_tokenbuf;
while (isLOWER(*d))
d++;
- if (!*d && !gv_stashpv(PL_tokenbuf,FALSE))
+ if (!*d && !gv_stashpv(PL_tokenbuf, 0))
Perl_warner(aTHX_ packWARN(WARN_RESERVED), PL_warn_reserved,
PL_tokenbuf);
}
*PL_tokenbuf = '\0';
s = force_word(s,WORD,TRUE,TRUE,FALSE);
if (isIDFIRST_lazy_if(PL_tokenbuf,UTF))
- gv_stashpvn(PL_tokenbuf, strlen(PL_tokenbuf), TRUE);
+ gv_stashpvn(PL_tokenbuf, strlen(PL_tokenbuf), GV_ADD);
else if (*s == '<')
yyerror("<> should be quotes");
}
Perl_pmflag(pTHX_ U32* pmfl, int ch)
{
PERL_UNUSED_CONTEXT;
- if (ch == 'i')
- *pmfl |= PMf_FOLD;
- else if (ch == 'g')
- *pmfl |= PMf_GLOBAL;
- else if (ch == 'c')
- *pmfl |= PMf_CONTINUE;
- else if (ch == 'o')
- *pmfl |= PMf_KEEP;
- else if (ch == 'm')
- *pmfl |= PMf_MULTILINE;
- else if (ch == 's')
- *pmfl |= PMf_SINGLELINE;
- else if (ch == 'x')
- *pmfl |= PMf_EXTENDED;
+ if (ch<256) {
+ char c = (char)ch;
+ switch (c) {
+ 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;
+ }
+ }
}
STATIC char *
PMOP *pm;
char *s = scan_str(start,!!PL_madskills,FALSE);
const char * const valid_flags =
- (const char *)((type == OP_QR) ? "iomsx" : "iogcmsx");
+ (const char *)((type == OP_QR) ? QR_PAT_MODS : M_PAT_MODS);
#ifdef PERL_MAD
char *modstart;
#endif
if ((pm->op_pmflags & PMf_CONTINUE) && !(pm->op_pmflags & PMf_GLOBAL)
&& ckWARN(WARN_REGEXP))
{
- Perl_warner(aTHX_ packWARN(WARN_REGEXP), "Use of /c modifier is meaningless without /g" );
+ Perl_warner(aTHX_ packWARN(WARN_REGEXP),
+ "Use of /c modifier is meaningless without /g" );
}
pm->op_pmpermflags = pm->op_pmflags;
#endif
while (*s) {
- if (*s == 'e') {
+ if (*s == EXEC_PAT_MOD) {
s++;
es++;
}
- else if (strchr("iogcmsx", *s))
+ else if (strchr(S_PAT_MODS, *s))
pmflag(&pm->op_pmflags,*s++);
else
break;