/* pp_sys.c
*
* Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003,
- * 2004, 2005, 2006, 2007 by Larry Wall and others
+ * 2004, 2005, 2006, 2007, 2008 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.
ENTER;
SAVESPTR(PL_rs);
PL_rs = &PL_sv_undef;
- sv_setpvn(TARG, "", 0); /* note that this preserves previous buffer */
+ sv_setpvs(TARG, ""); /* note that this preserves previous buffer */
while (sv_gets(TARG, fp, SvCUR(TARG)) != NULL)
NOOP;
LEAVE;
if (!rgv || !wgv)
goto badexit;
- if (SvTYPE(rgv) != SVt_PVGV || SvTYPE(wgv) != SVt_PVGV)
+ if (!isGV_with_GP(rgv) || !isGV_with_GP(wgv))
DIE(aTHX_ PL_no_usym, "filehandle");
rstio = GvIOn(rgv);
wstio = GvIOn(wgv);
PUTBACK;
{
- const int mode = mode_from_discipline(discp);
- const char *const d = (discp ? SvPV_nolen_const(discp) : NULL);
+ STRLEN len = 0;
+ const char *d = NULL;
+ int mode;
+ if (discp)
+ d = SvPV_const(discp, len);
+ mode = mode_from_discipline(d, len);
if (PerlIO_binmode(aTHX_ fp, IoTYPE(io), mode, d)) {
if (IoOFP(io) && IoOFP(io) != IoIFP(io)) {
if (!PerlIO_binmode(aTHX_ IoOFP(io), IoTYPE(io), mode, d)) {
switch(SvTYPE(varsv)) {
case SVt_PVHV:
methname = "TIEHASH";
- HvEITER_set((HV *)varsv, 0);
+ HvEITER_set(MUTABLE_HV(varsv), 0);
break;
case SVt_PVAV:
methname = "TIEARRAY";
break;
case SVt_PVGV:
+ if (isGV_with_GP(varsv)) {
#ifdef GV_UNIQUE_CHECK
- if (GvUNIQUE((GV*)varsv)) {
- Perl_croak(aTHX_ "Attempt to tie unique GV");
- }
+ if (GvUNIQUE((GV*)varsv)) {
+ Perl_croak(aTHX_ "Attempt to tie unique GV");
+ }
#endif
- methname = "TIEHANDLE";
- how = PERL_MAGIC_tiedscalar;
- /* For tied filehandles, we apply tiedscalar magic to the IO
- slot of the GP rather than the GV itself. AMS 20010812 */
- if (!GvIOp(varsv))
- GvIOp(varsv) = newIO();
- varsv = (SV *)GvIOp(varsv);
- break;
+ methname = "TIEHANDLE";
+ how = PERL_MAGIC_tiedscalar;
+ /* For tied filehandles, we apply tiedscalar magic to the IO
+ slot of the GP rather than the GV itself. AMS 20010812 */
+ if (!GvIOp(varsv))
+ GvIOp(varsv) = newIO();
+ varsv = (SV *)GvIOp(varsv);
+ break;
+ }
+ /* FALL THROUGH */
default:
methname = "TIESCALAR";
how = PERL_MAGIC_tiedscalar;
break;
}
items = SP - MARK++;
- if (sv_isobject(*MARK)) {
+ if (sv_isobject(*MARK)) { /* Calls GET magic. */
ENTER;
PUSHSTACKi(PERLSI_MAGIC);
PUSHMARK(SP);
/* Not clear why we don't call call_method here too.
* perhaps to get different error message ?
*/
- stash = gv_stashsv(*MARK, 0);
+ STRLEN len;
+ const char *name = SvPV_nomg_const(*MARK, len);
+ stash = gv_stashpvn(name, len, 0);
if (!stash || !(gv = gv_fetchmethod(stash, methname))) {
DIE(aTHX_ "Can't locate object method \"%s\" via package \"%"SVf"\"",
- methname, SVfARG(*MARK));
+ methname, SVfARG(SvOK(*MARK) ? *MARK : &PL_sv_no));
}
ENTER;
PUSHSTACKi(PERLSI_MAGIC);
const char how = (SvTYPE(sv) == SVt_PVHV || SvTYPE(sv) == SVt_PVAV)
? PERL_MAGIC_tied : PERL_MAGIC_tiedscalar;
- if (SvTYPE(sv) == SVt_PVGV && !(sv = (SV *)GvIOp(sv)))
+ if (isGV_with_GP(sv) && !(sv = (SV *)GvIOp(sv)))
RETPUSHYES;
if ((mg = SvTIED_mg(sv, how))) {
const char how = (SvTYPE(sv) == SVt_PVHV || SvTYPE(sv) == SVt_PVAV)
? PERL_MAGIC_tied : PERL_MAGIC_tiedscalar;
- if (SvTYPE(sv) == SVt_PVGV && !(sv = (SV *)GvIOp(sv)))
+ if (isGV_with_GP(sv) && !(sv = (SV *)GvIOp(sv)))
RETPUSHUNDEF;
if ((mg = SvTIED_mg(sv, how))) {
HV* stash;
GV *gv;
- HV * const hv = (HV*)POPs;
+ HV * const hv = MUTABLE_HV(POPs);
SV * const sv = newSVpvs_flags("AnyDBM_File", SVs_TEMP);
stash = gv_stashsv(sv, 0);
if (!stash || !(gv = gv_fetchmethod(stash, "TIEHASH"))) {
PUTBACK;
require_pv("AnyDBM_File.pm");
SPAGAIN;
- if (!(gv = gv_fetchmethod(stash, "TIEHASH")))
+ if (!stash || !(gv = gv_fetchmethod(stash, "TIEHASH")))
DIE(aTHX_ "No dbm on this machine");
}
RETPUSHUNDEF;
}
TAINT;
- sv_setpvn(TARG, " ", 1);
+ sv_setpvs(TARG, " ");
*SvPVX(TARG) = PerlIO_getc(IoIFP(GvIOp(gv))); /* should never be EOF */
if (PerlIO_isutf8(IoIFP(GvIOp(gv)))) {
/* Find out how many bytes the char needs */
DIE(aTHX_ "Not a format reference");
}
if (CvCLONE(cv))
- cv = (CV*)sv_2mortal((SV*)cv_clone(cv));
+ cv = MUTABLE_CV(sv_2mortal((SV*)cv_clone(cv)));
IoFLAGS(io) &= ~IOf_DIDTOP;
return doform(cv,gv,PL_op->op_next);
DIE(aTHX_ "Undefined top format called");
}
if (cv && CvCLONE(cv))
- cv = (CV*)sv_2mortal((SV*)cv_clone(cv));
+ cv = MUTABLE_CV(sv_2mortal((SV*)cv_clone(cv)));
return doform(cv, gv, PL_op);
}
goto say_undef;
bufsv = *++MARK;
if (! SvOK(bufsv))
- sv_setpvn(bufsv, "", 0);
+ sv_setpvs(bufsv, "");
length = SvIVx(*++MARK);
SETERRNO(0,0);
if (MARK < SP)
IoFLAGS(io) &= ~IOf_START;
do_open(gv, "-", 1, FALSE, O_RDONLY, 0, NULL);
if ( GvSV(gv) ) {
- sv_setpvn(GvSV(gv), "-", 1);
+ sv_setpvs(GvSV(gv), "-");
}
else {
- GvSV(gv) = newSVpvn("-", 1);
+ GvSV(gv) = newSVpvs("-");
}
SvSETMAGIC(GvSV(gv));
}
SV * const sv = POPs;
const char *name;
- if (SvTYPE(sv) == SVt_PVGV) {
+ if (isGV_with_GP(sv)) {
tmpgv = (GV*)sv; /* *main::FRED for example */
goto do_ftruncate_gv;
}
- else if (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVGV) {
+ else if (SvROK(sv) && isGV_with_GP(SvRV(sv))) {
tmpgv = (GV*) SvRV(sv); /* \*main::FRED for example */
goto do_ftruncate_gv;
}
if (gv != PL_defgv) {
PL_laststype = OP_STAT;
PL_statgv = gv;
- sv_setpvn(PL_statname, "", 0);
+ sv_setpvs(PL_statname, "");
if(gv) {
io = GvIO(gv);
do_fstat_have_io:
}
else {
SV* const sv = POPs;
- if (SvTYPE(sv) == SVt_PVGV) {
+ if (isGV_with_GP(sv)) {
gv = (GV*)sv;
goto do_fstat;
- } else if(SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVGV) {
+ } else if(SvROK(sv) && isGV_with_GP(SvRV(sv))) {
gv = (GV*)SvRV(sv);
if (PL_op->op_type == OP_LSTAT)
goto do_fstat_warning_check;
else {
PL_statgv = gv;
PL_laststatval = -1;
- sv_setpvn(PL_statname, "", 0);
+ sv_setpvs(PL_statname, "");
io = GvIO(PL_statgv);
}
if (io && IoIFP(io)) {
if (PL_op->op_flags & OPf_SPECIAL) {
gv = gv_fetchsv(sv, 0, SVt_PVIO);
}
- else if (SvTYPE(sv) == SVt_PVGV) {
+ else if (isGV_with_GP(sv)) {
gv = (GV*)sv;
}
- else if (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVGV) {
+ else if (SvROK(sv) && isGV_with_GP(SvRV(sv))) {
gv = (GV*)SvRV(sv);
}
else {
{
#ifdef HAS_SETNETENT
dVAR; dSP;
- PerlSock_setnetent(TOPi);
+ (void)PerlSock_setnetent(TOPi);
RETSETYES;
#else
DIE(aTHX_ PL_no_sock_func, "setnetent");
{
#ifdef HAS_SETPROTOENT
dVAR; dSP;
- PerlSock_setprotoent(TOPi);
+ (void)PerlSock_setprotoent(TOPi);
RETSETYES;
#else
DIE(aTHX_ PL_no_sock_func, "setprotoent");
{
#ifdef HAS_SETSERVENT
dVAR; dSP;
- PerlSock_setservent(TOPi);
+ (void)PerlSock_setservent(TOPi);
RETSETYES;
#else
DIE(aTHX_ PL_no_sock_func, "setservent");