SvPV_nolen(cSVOPo_sv)));
}
-STATIC U8*
-S_trlist_upgrade(pTHX_ U8** sp, U8** ep)
-{
- U8 *s = *sp;
- U8 *e = *ep;
- U8 *d;
-
- Newz(801, d, (e - s) * 2, U8);
- *sp = d;
-
- while (s < e) {
- if (*s < 0x80 || *s == 0xff)
- *d++ = *s++;
- else {
- U8 c = *s++;
- *d++ = ((c >> 6) | 0xc0);
- *d++ = ((c & 0x3f) | 0x80);
- }
- }
- *ep = d;
- return *sp;
-}
-
-
/* "register" allocation */
PADOFFSET
#endif
}
-STATIC void
-S_op_clear(pTHX_ OP *o)
+void
+Perl_op_clear(pTHX_ OP *o)
{
switch (o->op_type) {
case OP_NULL: /* Was holding old type, if any. */
case OP_MATCH:
case OP_QR:
clear_pmop:
+ {
+ HV *pmstash = PmopSTASH(cPMOPo);
+ if (pmstash && SvREFCNT(pmstash)) {
+ PMOP *pmop = HvPMROOT(pmstash);
+ PMOP *lastpmop = NULL;
+ while (pmop) {
+ if (cPMOPo == pmop) {
+ if (lastpmop)
+ lastpmop->op_pmnext = pmop->op_pmnext;
+ else
+ HvPMROOT(pmstash) = pmop->op_pmnext;
+ break;
+ }
+ lastpmop = pmop;
+ pmop = pmop->op_pmnext;
+ }
+#ifdef USE_ITHREADS
+ Safefree(PmopSTASHPV(cPMOPo));
+#else
+ /* NOTE: PMOP.op_pmstash is not refcounted */
+#endif
+ }
+ }
cPMOPo->op_pmreplroot = Nullop;
ReREFCNT_dec(cPMOPo->op_pmregexp);
cPMOPo->op_pmregexp = (REGEXP*)NULL;
SvREFCNT_dec(cop->cop_io);
}
-STATIC void
-S_null(pTHX_ OP *o)
+void
+Perl_op_null(pTHX_ OP *o)
{
if (o->op_type == OP_NULL)
return;
switch (o->op_type) {
case OP_REPEAT:
- if (o->op_private & OPpREPEAT_DOLIST)
- null(((LISTOP*)cBINOPo->op_first)->op_first);
scalar(cBINOPo->op_first);
break;
case OP_OR:
else {
if (ckWARN(WARN_VOID)) {
useless = "a constant";
+ /* the constants 0 and 1 are permitted as they are
+ conventionally used as dummies in constructs like
+ 1 while some_condition_with_side_effects; */
if (SvNIOK(sv) && (SvNV(sv) == 0.0 || SvNV(sv) == 1.0))
useless = 0;
else if (SvPOK(sv)) {
}
}
}
- null(o); /* don't execute or even remember it */
+ op_null(o); /* don't execute or even remember it */
break;
case OP_POSTINC:
PL_modcount++;
return o;
case OP_CONST:
- if (o->op_private & (OPpCONST_BARE) &&
- !(type == OP_GREPSTART || type == OP_ENTERSUB || type == OP_REFGEN)) {
- SV *sv = ((SVOP*)o)->op_sv;
- GV *gv;
-
- /* Could be a filehandle */
- if ((gv = gv_fetchpv(SvPV_nolen(sv), FALSE, SVt_PVIO))) {
- OP* gvio = newUNOP(OP_RV2GV, 0, newGVOP(OP_GV, 0, gv));
- op_free(o);
- o = gvio;
- } else {
- /* OK, it's a sub */
- OP* enter;
- gv = gv_fetchpv(SvPV_nolen(sv), TRUE, SVt_PVCV);
-
- enter = newUNOP(OP_ENTERSUB,0,
- newUNOP(OP_RV2CV, 0,
- newGVOP(OP_GV, 0, gv)
- ));
- enter->op_private |= OPpLVAL_INTRO;
- op_free(o);
- o = enter;
- }
- break;
- }
if (!(o->op_private & (OPpCONST_ARYBASE)))
goto nomod;
if (PL_eval_start && PL_eval_start->op_type == OP_CONST) {
o->op_type = OP_RV2CV; /* entersub => rv2cv */
o->op_ppaddr = PL_ppaddr[OP_RV2CV];
assert(cUNOPo->op_first->op_type == OP_NULL);
- null(((LISTOP*)cUNOPo->op_first)->op_first);/* disable pushmark */
+ op_null(((LISTOP*)cUNOPo->op_first)->op_first);/* disable pushmark */
break;
}
else { /* lvalue subroutine call */
o->op_type = OP_RV2CV; /* entersub => rv2cv */
o->op_ppaddr = PL_ppaddr[OP_RV2CV];
assert(cUNOPo->op_first->op_type == OP_NULL);
- null(((LISTOP*)cUNOPo->op_first)->op_first); /* disable pushmark */
+ op_null(((LISTOP*)cUNOPo->op_first)->op_first); /* disable pushmark */
o->op_flags |= OPf_SPECIAL;
}
break;
o->op_ppaddr = PL_ppaddr[OP_SCOPE];
kid = ((LISTOP*)o)->op_first;
if (kid->op_type == OP_NEXTSTATE || kid->op_type == OP_DBSTATE)
- null(kid);
+ op_null(kid);
}
else
o = newLISTOP(OP_SCOPE, 0, o, Nullop);
o->op_flags &= ~OPf_WANT;
if (!(PL_opargs[type] & OA_MARK))
- null(cLISTOPo->op_first);
+ op_null(cLISTOPo->op_first);
o->op_type = type;
o->op_ppaddr = PL_ppaddr[type];
{
if (!o || o->op_type != OP_LIST)
o = newLISTOP(OP_LIST, 0, o, Nullop);
- null(o);
+ op_null(o);
return o;
}
}
static int
-utf8compare(const void *a, const void *b)
-{
- int i;
- for (i = 0; i < 10; i++) {
- if ((*(U8**)a)[i] < (*(U8**)b)[i])
- return -1;
- if ((*(U8**)a)[i] > (*(U8**)b)[i])
- return 1;
- }
+uvcompare(const void *a, const void *b)
+{
+ if (*((UV *)a) < (*(UV *)b))
+ return -1;
+ if (*((UV *)a) > (*(UV *)b))
+ return 1;
+ if (*((UV *)a+1) < (*(UV *)b+1))
+ return -1;
+ if (*((UV *)a+1) > (*(UV *)b+1))
+ return 1;
return 0;
}
I32 grows = 0;
register short *tbl;
+ PL_hints |= HINT_BLOCK_SCOPE;
complement = o->op_private & OPpTRANS_COMPLEMENT;
del = o->op_private & OPpTRANS_DELETE;
squash = o->op_private & OPpTRANS_SQUASH;
U32 final;
I32 from_utf = o->op_private & OPpTRANS_FROM_UTF;
I32 to_utf = o->op_private & OPpTRANS_TO_UTF;
- U8* tsave = from_utf ? NULL : trlist_upgrade(&t, &tend);
- U8* rsave = to_utf ? NULL : trlist_upgrade(&r, &rend);
+ U8* tsave = NULL;
+ U8* rsave = NULL;
+
+ if (!from_utf) {
+ STRLEN len = tlen;
+ tsave = t = bytes_to_utf8(t, &len);
+ tend = t + len;
+ }
+ if (!to_utf && rlen) {
+ STRLEN len = rlen;
+ rsave = r = bytes_to_utf8(r, &len);
+ rend = r + len;
+ }
+
+/* There are several snags with this code on EBCDIC:
+ 1. 0xFF is a legal UTF-EBCDIC byte (there are no illegal bytes).
+ 2. scan_const() in toke.c has encoded chars in native encoding which makes
+ ranges at least in EBCDIC 0..255 range the bottom odd.
+*/
if (complement) {
U8 tmpbuf[UTF8_MAXLEN+1];
- U8** cp;
+ UV *cp;
UV nextmin = 0;
- New(1109, cp, tlen, U8*);
+ New(1109, cp, 2*tlen, UV);
i = 0;
transv = newSVpvn("",0);
while (t < tend) {
- cp[i++] = t;
- t += UTF8SKIP(t);
- if (t < tend && *t == 0xff) {
+ cp[2*i] = utf8n_to_uvuni(t, tend-t, &ulen, 0);
+ t += ulen;
+ if (t < tend && NATIVE_TO_UTF(*t) == 0xff) {
t++;
- t += UTF8SKIP(t);
+ cp[2*i+1] = utf8n_to_uvuni(t, tend-t, &ulen, 0);
+ t += ulen;
+ }
+ else {
+ cp[2*i+1] = cp[2*i];
}
+ i++;
}
- qsort(cp, i, sizeof(U8*), utf8compare);
+ qsort(cp, i, 2*sizeof(UV), uvcompare);
for (j = 0; j < i; j++) {
- U8 *s = cp[j];
- I32 cur = j < i - 1 ? cp[j+1] - s : tend - s;
- /* CHECKME: Use unicode code points for ranges - needs more thought ... NI-S */
- UV val = utf8n_to_uvuni(s, cur, &ulen, 0);
- s += ulen;
+ UV val = cp[2*j];
diff = val - nextmin;
if (diff > 0) {
t = uvuni_to_utf8(tmpbuf,nextmin);
sv_catpvn(transv, (char*)tmpbuf, t - tmpbuf);
if (diff > 1) {
+ U8 range_mark = UTF_TO_NATIVE(0xff);
t = uvuni_to_utf8(tmpbuf, val - 1);
- sv_catpvn(transv, "\377", 1);
+ sv_catpvn(transv, (char *)&range_mark, 1);
sv_catpvn(transv, (char*)tmpbuf, t - tmpbuf);
}
}
- if (s < tend && *s == 0xff)
- val = utf8n_to_uvuni(s+1, cur - 1, &ulen, 0);
+ val = cp[2*j+1];
if (val >= nextmin)
nextmin = val + 1;
}
t = uvuni_to_utf8(tmpbuf,nextmin);
sv_catpvn(transv, (char*)tmpbuf, t - tmpbuf);
+ {
+ U8 range_mark = UTF_TO_NATIVE(0xff);
+ sv_catpvn(transv, (char *)&range_mark, 1);
+ }
t = uvuni_to_utf8(tmpbuf, 0x7fffffff);
- sv_catpvn(transv, "\377", 1);
sv_catpvn(transv, (char*)tmpbuf, t - tmpbuf);
t = (U8*)SvPVX(transv);
tlen = SvCUR(transv);
r = t; rlen = tlen; rend = tend;
}
if (!squash) {
- if (t == r ||
+ if ((!rlen && !del) || t == r ||
(tlen == rlen && memEQ((char *)t, (char *)r, tlen)))
{
o->op_private |= OPpTRANS_IDENTICAL;
if (tfirst > tlast) {
tfirst = (I32)utf8n_to_uvuni(t, tend - t, &ulen, 0);
t += ulen;
- if (t < tend && *t == 0xff) { /* illegal utf8 val indicates range */
+ if (t < tend && NATIVE_TO_UTF(*t) == 0xff) { /* illegal utf8 val indicates range */
t++;
tlast = (I32)utf8n_to_uvuni(t, tend - t, &ulen, 0);
t += ulen;
if (r < rend) {
rfirst = (I32)utf8n_to_uvuni(r, rend - r, &ulen, 0);
r += ulen;
- if (r < rend && *r == 0xff) { /* illegal utf8 val indicates range */
+ if (r < rend && NATIVE_TO_UTF(*r) == 0xff) { /* illegal utf8 val indicates range */
r++;
rlast = (I32)utf8n_to_uvuni(r, rend - r, &ulen, 0);
r += ulen;
if (rfirst + diff > max)
max = rfirst + diff;
- rfirst += diff + 1;
if (!grows)
- grows = (UNISKIP(tfirst) < UNISKIP(rfirst));
+ grows = (tfirst < rfirst &&
+ UNISKIP(tfirst) < UNISKIP(rfirst + diff));
+ rfirst += diff + 1;
}
tfirst += diff + 1;
}
if (transv)
SvREFCNT_dec(transv);
- if (!del && havefinal)
+ if (!del && havefinal && rlen)
(void)hv_store((HV*)SvRV((cSVOPo->op_sv)), "FINAL", 5,
newSVuv((UV)final), 0);
}
}
}
- if (!del && rlen >= j) {
- cPVOPo->op_pv = (char*)Renew(tbl, 0x101+rlen-j, short);
+ if (!del) {
+ if (!rlen) {
+ j = rlen;
+ if (!squash)
+ o->op_private |= OPpTRANS_IDENTICAL;
+ }
+ else if (j >= rlen)
+ j = rlen - 1;
+ else
+ cPVOPo->op_pv = (char*)Renew(tbl, 0x101+rlen-j, short);
tbl[0x100] = rlen - j;
for (i=0; i < rlen - j; i++)
tbl[0x101+i] = r[j+i];
if (type != OP_TRANS && PL_curstash) {
pmop->op_pmnext = HvPMROOT(PL_curstash);
HvPMROOT(PL_curstash) = pmop;
+ PmopSTASH_set(pmop,PL_curstash);
}
return (OP*)pmop;
PL_expect = XSTATE;
}
+/*
+=for apidoc load_module
+
+Loads the module whose name is pointed to by the string part of name.
+Note that the actual module name, not its filename, should be given.
+Eg, "Foo::Bar" instead of "Foo/Bar.pm". flags can be any of
+PERL_LOADMOD_DENY, PERL_LOADMOD_NOIMPORT, or PERL_LOADMOD_IMPORT_OPS
+(or 0 for no flags). ver, if specified, provides version semantics
+similar to C<use Foo::Bar VERSION>. The optional trailing SV*
+arguments can be used to specify arguments to the module's import()
+method, similar to C<use Foo::Bar VERSION LIST>.
+
+=cut */
+
void
Perl_load_module(pTHX_ U32 flags, SV *name, SV *ver, ...)
{
cop->op_ppaddr = PL_ppaddr[ OP_NEXTSTATE ];
}
cop->op_flags = flags;
- cop->op_private = (PL_hints & HINT_BYTE);
+ cop->op_private = (PL_hints & HINT_PRIVATE_MASK);
#ifdef NATIVE_HINTS
cop->op_private |= NATIVE_HINTS;
#endif
op_free(expr);
expr = (OP*)(listop);
- null(expr);
+ op_null(expr);
iterflags |= OPf_STACKED;
}
else {
}
CvPADLIST(cv) = Nullav;
}
+ if (CvXSUB(cv)) {
+ CvXSUB(cv) = 0;
+ }
CvFLAGS(cv) = 0;
}
o->op_ppaddr = PL_ppaddr[OP_PADAV];
return o;
}
+ else if ((o->op_type == OP_RV2AV || o->op_type == OP_PADAV)
+ && ckWARN(WARN_DEPRECATED)) {
+ Perl_warner(aTHX_ WARN_DEPRECATED,
+ "Using an array as a reference is deprecated");
+ }
return newUNOP(OP_RV2AV, 0, scalar(o));
}
o->op_ppaddr = PL_ppaddr[OP_PADHV];
return o;
}
+ else if ((o->op_type == OP_RV2HV || o->op_type == OP_PADHV)
+ && ckWARN(WARN_DEPRECATED)) {
+ Perl_warner(aTHX_ WARN_DEPRECATED,
+ "Using a hash as a reference is deprecated");
+ }
return newUNOP(OP_RV2HV, 0, scalar(o));
}
Perl_croak(aTHX_ "%s argument is not a HASH or ARRAY element or slice",
PL_op_desc[o->op_type]);
}
- null(kid);
+ op_null(kid);
}
return o;
}
if (!kid) {
o->op_flags &= ~OPf_KIDS;
- null(o);
+ op_null(o);
}
else if (kid->op_type == OP_LINESEQ) {
LOGOP *enter;
o = ck_fun(o);
kid = cUNOPo->op_first->op_sibling;
if (kid->op_type == OP_RV2GV)
- null(kid);
+ op_null(kid);
}
else
o = listkids(o);
else if (kid->op_type != OP_HELEM)
Perl_croak(aTHX_ "%s argument is not a HASH or ARRAY element",
PL_op_desc[o->op_type]);
- null(kid);
+ op_null(kid);
}
return o;
}
list(kid);
break;
case OA_AVREF:
+ if ((type == OP_PUSH || type == OP_UNSHIFT)
+ && !kid->op_sibling && ckWARN(WARN_SYNTAX))
+ Perl_warner(aTHX_ WARN_SYNTAX,
+ "Useless use of %s with no values",
+ PL_op_desc[type]);
+
if (kid->op_type == OP_CONST &&
(kid->op_private & OPpCONST_BARE))
{
#if !defined(PERL_EXTERNAL_GLOB)
/* XXX this can be tightened up and made more failsafe. */
if (!gv) {
+ GV *glob_gv;
ENTER;
- Perl_load_module(aTHX_ 0, newSVpvn("File::Glob", 10), Nullsv,
- /* null-terminated import list */
- newSVpvn(":globally", 9), Nullsv);
+ Perl_load_module(aTHX_ PERL_LOADMOD_NOIMPORT, newSVpvn("File::Glob", 10), Nullsv,
+ Nullsv, Nullsv);
gv = gv_fetchpv("CORE::GLOBAL::glob", FALSE, SVt_PVCV);
+ glob_gv = gv_fetchpv("File::Glob::csh_glob", FALSE, SVt_PVCV);
+ GvCV(gv) = GvCV(glob_gv);
+ SvREFCNT_inc((SV*)GvCV(gv));
+ GvIMPORTED_CV_on(gv);
LEAVE;
}
#endif /* PERL_EXTERNAL_GLOB */
}
else if (kid->op_type == OP_LEAVE) {
if (o->op_type == OP_SORT) {
- null(kid); /* wipe out leave */
+ op_null(kid); /* wipe out leave */
kid->op_next = kid;
for (k = kLISTOP->op_first->op_next; k; k = k->op_next) {
o->op_flags |= OPf_SPECIAL;
}
else if (kid->op_type == OP_RV2SV || kid->op_type == OP_PADSV)
- null(firstkid);
+ op_null(firstkid);
firstkid = firstkid->op_sibling;
}
if (cvop->op_type == OP_RV2CV) {
SVOP* tmpop;
o->op_private |= (cvop->op_private & OPpENTERSUB_AMPER);
- null(cvop); /* disable rv2cv */
+ op_null(cvop); /* disable rv2cv */
tmpop = (SVOP*)((UNOP*)cvop)->op_first;
if (tmpop->op_type == OP_GV && !(o->op_private & OPpENTERSUB_AMPER)) {
GV *gv = cGVOPx_gv(tmpop);
o->op_private |= OPpTARGET_MY;
}
}
- null(o->op_next);
+ op_null(o->op_next);
}
ignore_optimization:
o->op_seq = PL_op_seqmax++;
case OP_GV:
if (o->op_next->op_type == OP_RV2SV) {
if (!(o->op_next->op_private & OPpDEREF)) {
- null(o->op_next);
+ op_null(o->op_next);
o->op_private |= o->op_next->op_private & (OPpLVAL_INTRO
| OPpOUR_INTRO);
o->op_next = o->op_next->op_next;
pop->op_next->op_type == OP_AELEM &&
!(pop->op_next->op_private &
(OPpLVAL_INTRO|OPpLVAL_DEFER|OPpDEREF|OPpMAYBE_LVSUB)) &&
- (i = SvIV(((SVOP*)pop)->op_sv) - PL_compiling.cop_arybase)
+ (i = SvIV(((SVOP*)pop)->op_sv) - PL_curcop->cop_arybase)
<= 255 &&
i >= 0)
{
GV *gv;
- null(o->op_next);
- null(pop->op_next);
- null(pop);
+ op_null(o->op_next);
+ op_null(pop->op_next);
+ op_null(pop);
o->op_flags |= pop->op_next->op_flags & OPf_MOD;
o->op_next = pop->op_next->op_next;
o->op_type = OP_AELEMFAST;
break;
case OP_ENTERLOOP:
+ case OP_ENTERITER:
o->op_seq = PL_op_seqmax++;
while (cLOOP->op_redoop->op_type == OP_NULL)
cLOOP->op_redoop = cLOOP->op_redoop->op_next;
ST(0) = (SV*)XSANY.any_ptr;
XSRETURN(1);
}
+
https://perl5.git.perl.org / perl5.git / blobdiff