CV* startcv, I32 cx_ix));
static char*
-CvNAME(cv)
-CV* cv;
+gv_ename(gv)
+GV* gv;
{
SV* tmpsv = sv_newmortal();
- gv_efullname3(tmpsv, CvGV(cv), Nullch);
+ gv_efullname3(tmpsv, gv, Nullch);
return SvPV(tmpsv,na);
}
no_fh_allowed(op)
OP *op;
{
- sprintf(tokenbuf,"Missing comma after first argument to %s function",
- op_desc[op->op_type]);
- yyerror(tokenbuf);
+ yyerror(form("Missing comma after first argument to %s function",
+ op_desc[op->op_type]));
return op;
}
OP* op;
char* name;
{
- sprintf(tokenbuf,"Not enough arguments for %s", name);
- yyerror(tokenbuf);
+ yyerror(form("Not enough arguments for %s", name));
return op;
}
OP *op;
char* name;
{
- sprintf(tokenbuf,"Too many arguments for %s", name);
- yyerror(tokenbuf);
+ yyerror(form("Too many arguments for %s", name));
return op;
}
char *name;
OP *kid;
{
- sprintf(tokenbuf, "Type of arg %d to %s must be %s (not %s)",
- (int) n, name, t, op_desc[kid->op_type]);
- yyerror(tokenbuf);
+ yyerror(form("Type of arg %d to %s must be %s (not %s)",
+ (int)n, name, t, op_desc[kid->op_type]));
return op;
}
{
int type = op->op_type;
if (type != OP_AELEM && type != OP_HELEM) {
- sprintf(tokenbuf, "Can't use subscript on %s", op_desc[type]);
- yyerror(tokenbuf);
+ yyerror(form("Can't use subscript on %s", op_desc[type]));
if (type == OP_ENTERSUB || type == OP_RV2HV || type == OP_PADHV)
warn("(Did you mean $ or @ instead of %c?)\n",
type == OP_ENTERSUB ? '&' : '%');
SV *sv;
if (!(isALPHA(name[1]) || name[1] == '_' && (int)strlen(name) > 2)) {
- if (!isPRINT(name[1]))
- sprintf(name+1, "^%c", toCTRL(name[1])); /* XXX tokenbuf, really */
+ if (!isPRINT(name[1])) {
+ name[3] = '\0';
+ name[2] = toCTRL(name[1]);
+ name[1] = '^';
+ }
croak("Can't use global %s in \"my\"",name);
}
if (AvFILL(comppad_name) >= 0) {
for (kid = cUNOP->op_first->op_sibling; kid; kid = kid->op_sibling)
scalarvoid(kid);
break;
+
case OP_NULL:
if (op->op_targ == OP_NEXTSTATE || op->op_targ == OP_DBSTATE)
curcop = ((COP*)op); /* for warning below */
if (op->op_flags & OPf_STACKED)
break;
-
- case OP_REQUIRE:
- /* since all requires must return a value, they're never void */
- op->op_flags &= ~OPf_WANT;
- return scalar(op);
-
+ /* FALL THROUGH */
case OP_ENTERTRY:
case OP_ENTER:
case OP_SCALAR:
for (kid = cLISTOP->op_first; kid; kid = kid->op_sibling)
scalarvoid(kid);
break;
+ case OP_REQUIRE:
+ /* since all requires must return a value, they're never void */
+ op->op_flags &= ~OPf_WANT;
+ return scalar(op);
case OP_SPLIT:
if ((kid = ((LISTOP*)op)->op_first) && kid->op_type == OP_PUSHRE) {
if (!kPMOP->op_pmreplroot)
/* grep, foreach, subcalls, refgen */
if (type == OP_GREPSTART || type == OP_ENTERSUB || type == OP_REFGEN)
break;
- sprintf(tokenbuf, "Can't modify %s in %s",
- op_desc[op->op_type],
- type ? op_desc[type] : "local");
- yyerror(tokenbuf);
+ yyerror(form("Can't modify %s in %s",
+ op_desc[op->op_type],
+ type ? op_desc[type] : "local"));
return op;
case OP_PREINC:
type != OP_PADHV &&
type != OP_PUSHMARK)
{
- sprintf(tokenbuf, "Can't declare %s in my", op_desc[op->op_type]);
- yyerror(tokenbuf);
+ yyerror(form("Can't declare %s in my", op_desc[op->op_type]));
return op;
}
op->op_flags |= OPf_MOD;
I32 i = AvFILL(CvPADLIST(cv));
while (i >= 0) {
SV** svp = av_fetch(CvPADLIST(cv), i--, FALSE);
- if (svp)
- SvREFCNT_dec(*svp);
+ SV* sv = svp ? *svp : Nullsv;
+ if (!sv)
+ continue;
+ if (sv == (SV*)comppad_name)
+ comppad_name = Nullav;
+ else if (sv == (SV*)comppad) {
+ comppad = Nullav;
+ curpad = Null(SV**);
+ }
+ SvREFCNT_dec(sv);
}
SvREFCNT_dec((SV*)CvPADLIST(cv));
}
ENTER;
SAVESPTR(curpad);
SAVESPTR(comppad);
+ SAVESPTR(comppad_name);
SAVESPTR(compcv);
cv = compcv = (CV*)NEWSV(1104,0);
if (SvPOK(proto))
sv_setpvn((SV*)cv, SvPVX(proto), SvCUR(proto));
+ comppad_name = newAV();
+ for (ix = fname; ix >= 0; ix--)
+ av_store(comppad_name, ix, SvREFCNT_inc(pname[ix]));
+
comppad = newAV();
comppadlist = newAV();
AvREAL_off(comppadlist);
- av_store(comppadlist, 0, SvREFCNT_inc((SV*)protopad_name));
+ av_store(comppadlist, 0, (SV*)comppad_name);
av_store(comppadlist, 1, (SV*)comppad);
CvPADLIST(cv) = comppadlist;
av_fill(comppad, AvFILL(protopad));
char* p;
{
if ((!p != !SvPOK(cv)) || (p && strNE(p, SvPVX(cv)))) {
- char* buf;
+ SV* msg = sv_newmortal();
SV* name = Nullsv;
if (gv)
- gv_efullname3(name = NEWSV(606, 40), gv, Nullch);
- New(607, buf, ((name ? SvCUR(name) : 0)
- + (SvPOK(cv) ? SvCUR(cv) : 0)
- + (p ? strlen(p) : 0)
- + 60), char);
- strcpy(buf, "Prototype mismatch:");
- if (name) {
- sprintf(buf + strlen(buf), " sub %s", SvPVX(name));
- SvREFCNT_dec(name);
- }
+ gv_efullname3(name = sv_newmortal(), gv, Nullch);
+ sv_setpv(msg, "Prototype mismatch:");
+ if (name)
+ sv_catpvf(msg, " sub %_", name);
if (SvPOK(cv))
- sprintf(buf + strlen(buf), " (%s)", SvPVX(cv));
- strcat(buf, " vs ");
- sprintf(buf + strlen(buf), p ? "(%s)" : "none", p);
- warn("%s", buf);
- Safefree(buf);
+ sv_catpvf(msg, " (%s)", SvPVX(cv));
+ sv_catpv(msg, " vs ");
+ if (p)
+ sv_catpvf(msg, "(%s)", p);
+ else
+ sv_catpv(msg, "none");
+ warn("%_", msg);
}
}
else if (type == OP_PADSV) {
AV* pad = (AV*)(AvARRAY(CvPADLIST(cv))[1]);
sv = pad ? AvARRAY(pad)[o->op_targ] : Nullsv;
- if (!sv)
+ if (!sv || (!SvREADONLY(sv) && SvREFCNT(sv) > 1))
return Nullsv;
- if (!SvREADONLY(sv)) {
- if (SvREFCNT(sv) > 1)
- return Nullsv;
- SvREADONLY_on(sv);
- }
}
else
return Nullsv;
}
+ if (sv)
+ SvREADONLY_on(sv);
return sv;
}
if (name) {
char *s = strrchr(name, ':');
s = s ? s+1 : name;
- if (strEQ(s, "BEGIN"))
- croak("BEGIN not safe after errors--compilation aborted");
+ if (strEQ(s, "BEGIN")) {
+ char *not_safe =
+ "BEGIN not safe after errors--compilation aborted";
+ if (in_eval & 4)
+ croak(not_safe);
+ else {
+ /* force display of errors found but not reported */
+ sv_catpv(GvSV(errgv), not_safe);
+ croak("%s", SvPVx(GvSV(errgv), na));
+ }
+ }
}
}
if (!block) {
char *s;
if (perldb && curstash != debstash) {
- SV *sv;
+ SV *sv = NEWSV(0,0);
SV *tmpstr = sv_newmortal();
static GV *db_postponed;
CV *cv;
HV *hv;
- sprintf(buf, "%s:%ld",
- SvPVX(GvSV(curcop->cop_filegv)), (long)subline);
- sv = newSVpv(buf,0);
- sv_catpv(sv,"-");
- sprintf(buf,"%ld",(long)curcop->cop_line);
- sv_catpv(sv,buf);
+ sv_setpvf(sv, "%_:%ld-%ld",
+ GvSV(curcop->cop_filegv),
+ (long)subline, (long)curcop->cop_line);
gv_efullname3(tmpstr, gv, Nullch);
hv_store(GvHV(DBsub), SvPVX(tmpstr), SvCUR(tmpstr), sv, 0);
if (!db_postponed) {
GV *gv = gv_fetchpv("glob", FALSE, SVt_PVCV);
if (gv && GvIMPORTED_CV(gv)) {
+ static int glob_index;
+
+ append_elem(OP_GLOB, op,
+ newSVOP(OP_CONST, 0, newSViv(glob_index++)));
op->op_type = OP_LIST;
op->op_ppaddr = ppaddr[OP_LIST];
+ ((LISTOP*)op)->op_first->op_type = OP_PUSHMARK;
+ ((LISTOP*)op)->op_first->op_ppaddr = ppaddr[OP_PUSHMARK];
op = newUNOP(OP_ENTERSUB, OPf_STACKED,
append_elem(OP_LIST, op,
scalar(newUNOP(OP_RV2CV, 0,
OP *cvop;
char *proto = 0;
CV *cv = 0;
+ GV *namegv = 0;
int optional = 0;
I32 arg = 0;
tmpop = (SVOP*)((UNOP*)cvop)->op_first;
if (tmpop->op_type == OP_GV) {
cv = GvCVu(tmpop->op_sv);
- if (cv && SvPOK(cv) && !(op->op_private & OPpENTERSUB_AMPER))
- proto = SvPV((SV*)cv,na);
+ if (cv && SvPOK(cv) && !(op->op_private & OPpENTERSUB_AMPER)) {
+ namegv = CvANON(cv) ? (GV*)tmpop->op_sv : CvGV(cv);
+ proto = SvPV((SV*)cv, na);
+ }
}
}
op->op_private |= (hints & HINT_STRICT_REFS);
if (proto) {
switch (*proto) {
case '\0':
- return too_many_arguments(op, CvNAME(cv));
+ return too_many_arguments(op, gv_ename(namegv));
case ';':
optional = 1;
proto++;
proto++;
arg++;
if (o->op_type != OP_REFGEN && o->op_type != OP_UNDEF)
- bad_type(arg, "block", CvNAME(cv), o);
+ bad_type(arg, "block", gv_ename(namegv), o);
break;
case '*':
proto++;
switch (*proto++) {
case '*':
if (o->op_type != OP_RV2GV)
- bad_type(arg, "symbol", CvNAME(cv), o);
+ bad_type(arg, "symbol", gv_ename(namegv), o);
goto wrapref;
case '&':
if (o->op_type != OP_RV2CV)
- bad_type(arg, "sub", CvNAME(cv), o);
+ bad_type(arg, "sub", gv_ename(namegv), o);
goto wrapref;
case '$':
if (o->op_type != OP_RV2SV && o->op_type != OP_PADSV)
- bad_type(arg, "scalar", CvNAME(cv), o);
+ bad_type(arg, "scalar", gv_ename(namegv), o);
goto wrapref;
case '@':
if (o->op_type != OP_RV2AV && o->op_type != OP_PADAV)
- bad_type(arg, "array", CvNAME(cv), o);
+ bad_type(arg, "array", gv_ename(namegv), o);
goto wrapref;
case '%':
if (o->op_type != OP_RV2HV && o->op_type != OP_PADHV)
- bad_type(arg, "hash", CvNAME(cv), o);
+ bad_type(arg, "hash", gv_ename(namegv), o);
wrapref:
{
OP* kid = o;
default:
oops:
croak("Malformed prototype for %s: %s",
- CvNAME(cv),SvPV((SV*)cv,na));
+ gv_ename(namegv), SvPV((SV*)cv, na));
}
}
else
o = o->op_sibling;
}
if (proto && !optional && *proto == '$')
- return too_few_arguments(op, CvNAME(cv));
+ return too_few_arguments(op, gv_ename(namegv));
return op;
}
https://perl5.git.perl.org / perl5.git / blobdiff