This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Use pvs macros instead of pvn where possible.
[perl5.git] / pp_sys.c
index fc57695..033482d 100644 (file)
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -1,7 +1,7 @@
 /*    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.
@@ -328,7 +328,7 @@ PP(pp_backtick)
            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;
@@ -607,7 +607,7 @@ PP(pp_pipe_op)
     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);
@@ -762,8 +762,12 @@ PP(pp_binmode)
 
     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)) {
@@ -796,32 +800,35 @@ PP(pp_tie)
     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);
@@ -835,10 +842,12 @@ PP(pp_tie)
        /* 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);
@@ -877,7 +886,7 @@ PP(pp_untie)
     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))) {
@@ -915,7 +924,7 @@ PP(pp_tied)
     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))) {
@@ -935,14 +944,14 @@ PP(pp_dbmopen)
     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");
     }
 
@@ -1217,7 +1226,7 @@ PP(pp_getc)
        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 */
@@ -1297,7 +1306,7 @@ PP(pp_enterwrite)
        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);
@@ -1388,7 +1397,7 @@ PP(pp_leavewrite)
                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);
     }
 
@@ -1570,7 +1579,7 @@ PP(pp_sysread)
        goto say_undef;
     bufsv = *++MARK;
     if (! SvOK(bufsv))
-       sv_setpvn(bufsv, "", 0);
+       sv_setpvs(bufsv, "");
     length = SvIVx(*++MARK);
     SETERRNO(0,0);
     if (MARK < SP)
@@ -2014,10 +2023,10 @@ PP(pp_eof)
                    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));
                }
@@ -2189,11 +2198,11 @@ PP(pp_truncate)
            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;
            }
@@ -2810,7 +2819,7 @@ PP(pp_stat)
        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:
@@ -2836,10 +2845,10 @@ PP(pp_stat)
     }
     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;
@@ -3263,7 +3272,7 @@ PP(pp_fttext)
        else {
            PL_statgv = gv;
            PL_laststatval = -1;
-           sv_setpvn(PL_statname, "", 0);
+           sv_setpvs(PL_statname, "");
            io = GvIO(PL_statgv);
        }
        if (io && IoIFP(io)) {
@@ -3395,10 +3404,10 @@ PP(pp_chdir)
        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 {
@@ -4939,7 +4948,7 @@ PP(pp_snetent)
 {
 #ifdef HAS_SETNETENT
     dVAR; dSP;
-    PerlSock_setnetent(TOPi);
+    (void)PerlSock_setnetent(TOPi);
     RETSETYES;
 #else
     DIE(aTHX_ PL_no_sock_func, "setnetent");
@@ -4950,7 +4959,7 @@ PP(pp_sprotoent)
 {
 #ifdef HAS_SETPROTOENT
     dVAR; dSP;
-    PerlSock_setprotoent(TOPi);
+    (void)PerlSock_setprotoent(TOPi);
     RETSETYES;
 #else
     DIE(aTHX_ PL_no_sock_func, "setprotoent");
@@ -4961,7 +4970,7 @@ PP(pp_sservent)
 {
 #ifdef HAS_SETSERVENT
     dVAR; dSP;
-    PerlSock_setservent(TOPi);
+    (void)PerlSock_setservent(TOPi);
     RETSETYES;
 #else
     DIE(aTHX_ PL_no_sock_func, "setservent");