/* op.c
*
* Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
- * 2000, 2001, 2002, 2003, 2004, by Larry Wall and others
+ * 2000, 2001, 2002, 2003, 2004, 2005, 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.
off = pad_add_name(name,
PL_in_my_stash,
(PL_in_my == KEY_our
- ? (PL_curstash ? PL_curstash : PL_defstash)
+ /* $_ is always in main::, even with our */
+ ? (PL_curstash && !strEQ(name,"$_") ? PL_curstash : PL_defstash)
: Nullhv
),
0 /* not fake */
*/
if (complement) {
- U8 tmpbuf[UTF8_MAXLEN+1];
+ U8 tmpbuf[UTF8_MAXBYTES+1];
UV *cp;
UV nextmin = 0;
New(1109, cp, 2*tlen, UV);
STRLEN plen;
SV *pat = ((SVOP*)expr)->op_sv;
char *p = SvPV(pat, plen);
- if ((o->op_flags & OPf_SPECIAL) && strEQ(p, " ")) {
+ if ((o->op_flags & OPf_SPECIAL) && (*p == ' ' && p[1] == '\0')) {
sv_setpvn(pat, "\\s+", 3);
p = SvPV(pat, plen);
pm->op_pmflags |= PMf_SKIPWHITE;
if (SvPOK(cv))
Perl_sv_catpvf(aTHX_ msg, " (%"SVf")", (SV *)cv);
else
- Perl_sv_catpvf(aTHX_ msg, ": none");
+ Perl_sv_catpv(aTHX_ msg, ": none");
sv_catpv(msg, " vs ");
if (p)
Perl_sv_catpvf(aTHX_ msg, "(%s)", p);
}
else
aname = Nullch;
- gv = gv_fetchpv(name ? name : (aname ? aname :
- (PL_curstash ? "__ANON__" : "__ANON__::__ANON__")),
- GV_ADDMULTI | ((block || attrs) ? 0 : GV_NOINIT),
- SVt_PVCV);
+ gv = name ? gv_fetchsv(cSVOPo->op_sv,
+ GV_ADDMULTI | ((block || attrs) ? 0 : GV_NOINIT),
+ SVt_PVCV)
+ : gv_fetchpv(aname ? aname
+ : (PL_curstash ? "__ANON__" : "__ANON__::__ANON__"),
+ GV_ADDMULTI | ((block || attrs) ? 0 : GV_NOINIT),
+ SVt_PVCV);
if (o)
SAVEFREEOP(o);
Perl_newFORM(pTHX_ I32 floor, OP *o, OP *block)
{
register CV *cv;
- char *name;
GV *gv;
- STRLEN n_a;
if (o)
- name = SvPVx(cSVOPo->op_sv, n_a);
+ gv = gv_fetchsv(cSVOPo->op_sv, TRUE, SVt_PVFM);
else
- name = "STDOUT";
- gv = gv_fetchpv(name,TRUE, SVt_PVFM);
+ gv = gv_fetchpv("STDOUT", TRUE, SVt_PVFM);
+
#ifdef GV_UNIQUE_CHECK
if (GvUNIQUE(gv)) {
Perl_croak(aTHX_ "Bad symbol for form (GV is unique)");
line_t oldline = CopLINE(PL_curcop);
if (PL_copline != NOLINE)
CopLINE_set(PL_curcop, PL_copline);
- Perl_warner(aTHX_ packWARN(WARN_REDEFINE), "Format %s redefined",name);
+ Perl_warner(aTHX_ packWARN(WARN_REDEFINE),
+ o ? "Format %"SVf" redefined"
+ : "Format STDOUT redefined" ,cSVOPo->op_sv);
CopLINE_set(PL_curcop, oldline);
}
SvREFCNT_dec(cv);
o->op_private |= (PL_hints & HINT_STRICT_REFS);
if (kid->op_type == OP_CONST) {
- char *name;
int iscv;
GV *gv;
SV *kidsv = kid->op_sv;
- STRLEN n_a;
/* Is it a constant from cv_const_sv()? */
if (SvROK(kidsv) && SvREADONLY(kidsv)) {
Perl_croak(aTHX_ "Constant is not %s reference", badtype);
return o;
}
- name = SvPV(kidsv, n_a);
if ((PL_hints & HINT_STRICT_REFS) && (kid->op_private & OPpCONST_BARE)) {
char *badthing = Nullch;
switch (o->op_type) {
}
if (badthing)
Perl_croak(aTHX_
- "Can't use bareword (\"%s\") as %s ref while \"strict refs\" in use",
- name, badthing);
+ "Can't use bareword (\"%"SVf"\") as %s ref while \"strict refs\" in use",
+ kidsv, badthing);
}
/*
* This is a little tricky. We only want to add the symbol if we
*/
iscv = (o->op_type == OP_RV2CV) * 2;
do {
- gv = gv_fetchpv(name,
+ gv = gv_fetchsv(kidsv,
iscv | !(kid->op_private & OPpCONST_ENTERED),
iscv
? SVt_PVCV
SVOP *kid = (SVOP*)cUNOPo->op_first;
if (kid->op_type == OP_CONST && (kid->op_private & OPpCONST_BARE)) {
- STRLEN n_a;
OP *newop = newGVOP(type, OPf_REF,
- gv_fetchpv(SvPVx(kid->op_sv, n_a), TRUE, SVt_PVIO));
+ gv_fetchsv(kid->op_sv, TRUE, SVt_PVIO));
op_free(o);
o = newop;
return o;
}
if (o->op_flags & OPf_KIDS) {
- STRLEN n_a;
tokid = &cLISTOPo->op_first;
kid = cLISTOPo->op_first;
if (kid->op_type == OP_PUSHMARK ||
if (kid->op_type == OP_CONST &&
(kid->op_private & OPpCONST_BARE))
{
- char *name = SvPVx(((SVOP*)kid)->op_sv, n_a);
OP *newop = newAVREF(newGVOP(OP_GV, 0,
- gv_fetchpv(name, TRUE, SVt_PVAV) ));
+ gv_fetchsv(((SVOP*)kid)->op_sv, TRUE, SVt_PVAV) ));
if (ckWARN2(WARN_DEPRECATED, WARN_SYNTAX))
Perl_warner(aTHX_ packWARN2(WARN_DEPRECATED, WARN_SYNTAX),
- "Array @%s missing the @ in argument %"IVdf" of %s()",
- name, (IV)numargs, PL_op_desc[type]);
+ "Array @%"SVf" missing the @ in argument %"IVdf" of %s()",
+ ((SVOP*)kid)->op_sv, (IV)numargs, PL_op_desc[type]);
op_free(kid);
kid = newop;
kid->op_sibling = sibl;
if (kid->op_type == OP_CONST &&
(kid->op_private & OPpCONST_BARE))
{
- char *name = SvPVx(((SVOP*)kid)->op_sv, n_a);
OP *newop = newHVREF(newGVOP(OP_GV, 0,
- gv_fetchpv(name, TRUE, SVt_PVHV) ));
+ gv_fetchsv(((SVOP*)kid)->op_sv, TRUE, SVt_PVHV) ));
if (ckWARN2(WARN_DEPRECATED, WARN_SYNTAX))
Perl_warner(aTHX_ packWARN2(WARN_DEPRECATED, WARN_SYNTAX),
- "Hash %%%s missing the %% in argument %"IVdf" of %s()",
- name, (IV)numargs, PL_op_desc[type]);
+ "Hash %%%"SVf" missing the %% in argument %"IVdf" of %s()",
+ ((SVOP*)kid)->op_sv, (IV)numargs, PL_op_desc[type]);
op_free(kid);
kid = newop;
kid->op_sibling = sibl;
(kid->op_private & OPpCONST_BARE))
{
OP *newop = newGVOP(OP_GV, 0,
- gv_fetchpv(SvPVx(((SVOP*)kid)->op_sv, n_a), TRUE,
- SVt_PVIO) );
+ gv_fetchsv(((SVOP*)kid)->op_sv, TRUE, SVt_PVIO) );
if (!(o->op_private & 1) && /* if not unop */
kid == cLISTOPo->op_last)
cLISTOPo->op_last = newop;
OP *k;
int descending;
GV *gv;
+ const char *gvname;
if (!(o->op_flags & OPf_STACKED))
return;
GvMULTI_on(gv_fetchpv("a", TRUE, SVt_PV));
gv = kGVOP_gv;
if (GvSTASH(gv) != PL_curstash)
return;
- if (strEQ(GvNAME(gv), "a"))
+ gvname = GvNAME(gv);
+ if (*gvname == 'a' && gvname[1] == '\0')
descending = 0;
- else if (strEQ(GvNAME(gv), "b"))
+ else if (*gvname == 'b' && gvname[1] == '\0')
descending = 1;
else
return;
return;
kid = kUNOP->op_first; /* get past rv2sv */
gv = kGVOP_gv;
- if (GvSTASH(gv) != PL_curstash
- || ( descending
- ? strNE(GvNAME(gv), "a")
- : strNE(GvNAME(gv), "b")))
+ if (GvSTASH(gv) != PL_curstash)
+ return;
+ gvname = GvNAME(gv);
+ if ( descending
+ ? !(*gvname == 'a' && gvname[1] == '\0')
+ : !(*gvname == 'b' && gvname[1] == '\0'))
return;
o->op_flags &= ~(OPf_STACKED | OPf_SPECIAL);
if (descending)
OP *sibling = o2->op_sibling;
SV *n = newSVpvn("",0);
op_free(o2);
- gv_fullname3(n, gv, "");
- if (SvCUR(n)>6 && strnEQ(SvPVX(n),"main::",6))
- sv_chop(n, SvPVX(n)+6);
+ gv_fullname4(n, gv, "", FALSE);
o2 = newSVOP(OP_CONST, 0, n);
prev->op_sibling = o2;
o2->op_sibling = sibling;
projects / p5sagit/p5-mst-13.2.git / blobdiff