}
else {
/* Set TARG to PV(left), then add right */
- U8 *l, *c;
+ U8 *l, *c, *olds = NULL;
STRLEN targlen;
- if (TARG == right)
+ if (TARG == right) {
/* Need a safe copy elsewhere since we're just about to
write onto TARG */
- s = strdup(SvPV(right,len));
+ olds = (U8*)SvPV(right,len);
+ s = (U8*)savepv((char*)olds);
+ }
else
- s = SvPV(right,len);
- l = SvPV(left, targlen);
+ s = (U8*)SvPV(right,len);
+ l = (U8*)SvPV(left, targlen);
if (TARG != left)
- sv_setpvn(TARG,l,targlen);
+ sv_setpvn(TARG, (char*)l, targlen);
if (!left_utf)
sv_utf8_upgrade(TARG);
/* Extend TARG to length of right (s) */
}
SvGROW(TARG, targlen+1);
/* And now copy, maybe upgrading right to UTF8 on the fly */
- for (c = SvEND(TARG); *s; s++) {
+ for (c = (U8*)SvEND(TARG); *s; s++) {
if (*s & 0x80 && !right_utf)
c = uv_to_utf8(c, *s);
else
*SvEND(TARG) = '\0';
SvUTF8_on(TARG);
SETs(TARG);
+ Safefree(olds);
RETURN;
}
}
if (TARG != left) {
- s = SvPV(left,len);
+ s = (U8*)SvPV(left,len);
if (TARG == right) {
- sv_insert(TARG, 0, 0, s, len);
+ sv_insert(TARG, 0, 0, (char*)s, len);
SETs(TARG);
RETURN;
}
- sv_setpvn(TARG,s,len);
+ sv_setpvn(TARG, (char *)s, len);
}
else if (SvGMAGICAL(TARG))
mg_get(TARG);
else if (!SvOK(TARG) && SvTYPE(TARG) <= SVt_PVMG)
sv_setpv(TARG, ""); /* Suppress warning. */
- s = SvPV(right,len);
+ s = (U8*)SvPV(right,len);
if (SvOK(TARG)) {
#if defined(PERL_Y2KWARN)
if ((SvIOK(right) || SvNOK(right)) && ckWARN(WARN_Y2K)) {
}
}
#endif
- sv_catpvn(TARG,s,len);
+ sv_catpvn(TARG, (char *)s, len);
}
else
- sv_setpvn(TARG,s,len); /* suppress warning */
+ sv_setpvn(TARG, (char *)s, len); /* suppress warning */
if (left_utf)
SvUTF8_on(TARG);
SETTARG;
RETURN;
}
if (!(io = GvIO(gv))) {
- if (ckWARN(WARN_UNOPENED)) {
- SV* sv = sv_newmortal();
- gv_efullname3(sv, gv, Nullch);
- Perl_warner(aTHX_ WARN_UNOPENED, "Filehandle %s never opened",
- SvPV(sv,n_a));
- }
+ dTHR;
+ if (ckWARN2(WARN_UNOPENED,WARN_CLOSED))
+ report_evil_fh(gv, io, PL_op->op_type);
SETERRNO(EBADF,RMS$_IFI);
goto just_say_no;
}
else if (!(fp = IoOFP(io))) {
if (ckWARN2(WARN_CLOSED, WARN_IO)) {
if (IoIFP(io)) {
- SV* sv = sv_newmortal();
- gv_efullname3(sv, gv, Nullch);
- Perl_warner(aTHX_ WARN_IO,
- "Filehandle %s opened only for input",
- SvPV(sv,n_a));
+ /* integrate with report_evil_fh()? */
+ char *name = NULL;
+ if (isGV(gv)) {
+ SV* sv = sv_newmortal();
+ gv_efullname4(sv, gv, Nullch, FALSE);
+ name = SvPV_nolen(sv);
+ }
+ if (name && *name)
+ Perl_warner(aTHX_ WARN_IO,
+ "Filehandle %s opened only for input", name);
+ else
+ Perl_warner(aTHX_ WARN_IO,
+ "Filehandle opened only for input");
}
- else if (ckWARN(WARN_CLOSED))
- report_closed_fh(gv, io, "print", "filehandle");
+ else if (ckWARN2(WARN_UNOPENED,WARN_CLOSED))
+ report_evil_fh(gv, io, PL_op->op_type);
}
SETERRNO(EBADF,IoIFP(io)?RMS$_FAC:RMS$_IFI);
goto just_say_no;
&& (IoTYPE(io) == '>' || fp == PerlIO_stdout()
|| fp == PerlIO_stderr()))
{
- SV* sv = sv_newmortal();
- gv_efullname3(sv, PL_last_in_gv, Nullch);
- Perl_warner(aTHX_ WARN_IO, "Filehandle %s opened only for output",
- SvPV_nolen(sv));
+ /* integrate with report_evil_fh()? */
+ char *name = NULL;
+ if (isGV(PL_last_in_gv)) { /* can this ever fail? */
+ SV* sv = sv_newmortal();
+ gv_efullname4(sv, PL_last_in_gv, Nullch, FALSE);
+ name = SvPV_nolen(sv);
+ }
+ if (name && *name)
+ Perl_warner(aTHX_ WARN_IO,
+ "Filehandle %s opened only for output", name);
+ else
+ Perl_warner(aTHX_ WARN_IO,
+ "Filehandle opened only for output");
}
}
if (!fp) {
"glob failed (can't start child: %s)",
Strerror(errno));
else
- report_closed_fh(PL_last_in_gv, io, "readline", "filehandle");
+ report_evil_fh(PL_last_in_gv, io, PL_op->op_type);
}
if (gimme == G_SCALAR) {
(void)SvOK_off(TARG);
/* delay EOF state for a snarfed empty file */
#define SNARF_EOF(gimme,rs,io,sv) \
(gimme != G_SCALAR || SvCUR(sv) \
- || !RsSNARF(rs) || (IoFLAGS(io) & IOf_NOLINE) \
- || ((IoFLAGS(io) |= IOf_NOLINE), FALSE))
+ || (IoFLAGS(io) & IOf_NOLINE) || !RsSNARF(rs))
for (;;) {
if (!sv_gets(sv, fp, offset)
SvTAINTED_on(sv);
}
IoLINES(io)++;
+ IoFLAGS(io) |= IOf_NOLINE;
SvSETMAGIC(sv);
XPUSHs(sv);
if (type == OP_GLOB) {
&& (gv = (GV*)*svp) ))) {
/* Use GV from the stack as a fallback. */
/* GV is potentially non-unique, or contain different CV. */
- sv_setsv(dbsv, newRV((SV*)cv));
+ SV *tmp = newRV((SV*)cv);
+ sv_setsv(dbsv, tmp);
+ SvREFCNT_dec(tmp);
}
else {
gv_efullname3(dbsv, gv, Nullch);
cx->blk_sub.savearray = GvAV(PL_defgv);
GvAV(PL_defgv) = (AV*)SvREFCNT_inc(av);
#endif /* USE_THREADS */
+ cx->blk_sub.oldcurpad = PL_curpad;
cx->blk_sub.argarray = av;
++MARK;
char* leaf = name;
char* sep = Nullch;
char* p;
+ GV* gv;
for (p = name; *p; p++) {
if (*p == '\'')
packname = name;
packlen = sep - name;
}
- Perl_croak(aTHX_
- "Can't locate object method \"%s\" via package \"%s\"",
- leaf, packname);
+ gv = gv_fetchpv(packname, 0, SVt_PVHV);
+ if (gv && isGV(gv)) {
+ Perl_croak(aTHX_
+ "Can't locate object method \"%s\" via package \"%s\"",
+ leaf, packname);
+ }
+ else {
+ Perl_croak(aTHX_
+ "Can't locate object method \"%s\" via package \"%s\""
+ " (perhaps you forgot to load \"%s\"?)",
+ leaf, packname, packname);
+ }
}
return isGV(gv) ? (SV*)GvCV(gv) : (SV*)gv;
}