This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Cleanup lib/B
[perl5.git] / pp_sys.c
index 8193f3c..da07e46 100644 (file)
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -297,20 +297,7 @@ S_emulate_eaccess(pTHX_ const char* path, Mode_t mode)
 
     return res;
 }
-#   define PERL_EFF_ACCESS(p,f) (emulate_eaccess((p), (f)))
-#else
-/* With it or without it: anyway you get a warning: either that
-   it is unused, or it is declared static and never defined.
- */
-STATIC int
-S_emulate_eaccess(pTHX_ const char* path, Mode_t mode)
-{
-    PERL_UNUSED_ARG(path);
-    PERL_UNUSED_ARG(mode);
-    Perl_croak(aTHX_ "switching effective uid is not implemented");
-    /*NOTREACHED*/
-    return -1;
-}
+#   define PERL_EFF_ACCESS(p,f) (S_emulate_eaccess(aTHX_ (p), (f)))
 #endif
 
 PP(pp_backtick)
@@ -355,7 +342,7 @@ PP(pp_backtick)
                    SvREFCNT_dec(sv);
                    break;
                }
-               XPUSHs(sv_2mortal(sv));
+               mXPUSHs(sv);
                if (SvLEN(sv) - SvCUR(sv) > 20) {
                    SvPV_shrink_to_cur(sv);
                }
@@ -401,7 +388,7 @@ PP(pp_glob)
     PL_last_in_gv = (GV*)*PL_stack_sp--;
 
     SAVESPTR(PL_rs);           /* This is not permanent, either. */
-    PL_rs = sv_2mortal(newSVpvs("\000"));
+    PL_rs = newSVpvs_flags("\000", SVs_TEMP);
 #ifndef DOSISH
 #ifndef CSH
     *SvPVX(PL_rs) = '\n';
@@ -450,7 +437,7 @@ PP(pp_warn)
        tmps = SvPV_const(tmpsv, len);
     }
     if (!tmps || !len)
-       tmpsv = sv_2mortal(newSVpvs("Warning: something's wrong"));
+       tmpsv = newSVpvs_flags("Warning: something's wrong", SVs_TEMP);
 
     Perl_warn(aTHX_ "%"SVf, SVfARG(tmpsv));
     RETSETYES;
@@ -476,7 +463,7 @@ PP(pp_die)
     }
     else {
        tmpsv = TOPs;
-        tmps = SvROK(tmpsv) ? NULL : SvPV_const(tmpsv, len);
+        tmps = SvROK(tmpsv) ? (const char *)NULL : SvPV_const(tmpsv, len);
     }
     if (!tmps || !len) {
        SV * const error = ERRSV;
@@ -514,7 +501,7 @@ PP(pp_die)
        }
     }
     if (!tmps || !len)
-       tmpsv = sv_2mortal(newSVpvs("Died"));
+       tmpsv = newSVpvs_flags("Died", SVs_TEMP);
 
     DIE(aTHX_ "%"SVf, SVfARG(tmpsv));
 }
@@ -901,7 +888,7 @@ PP(pp_untie)
            if (gv && isGV(gv) && (cv = GvCV(gv))) {
               PUSHMARK(SP);
               XPUSHs(SvTIED_obj((SV*)gv, mg));
-              XPUSHs(sv_2mortal(newSViv(SvREFCNT(obj)-1)));
+              mXPUSHi(SvREFCNT(obj) - 1);
               PUTBACK;
               ENTER;
               call_sv((SV *)cv, G_VOID);
@@ -949,7 +936,7 @@ PP(pp_dbmopen)
     GV *gv;
 
     HV * const hv = (HV*)POPs;
-    SV * const sv = sv_2mortal(newSVpvs("AnyDBM_File"));
+    SV * const sv = newSVpvs_flags("AnyDBM_File", SVs_TEMP);
     stash = gv_stashsv(sv, 0);
     if (!stash || !(gv = gv_fetchmethod(stash, "TIEHASH"))) {
        PUTBACK;
@@ -966,9 +953,9 @@ PP(pp_dbmopen)
     PUSHs(sv);
     PUSHs(left);
     if (SvIV(right))
-       PUSHs(sv_2mortal(newSVuv(O_RDWR|O_CREAT)));
+       mPUSHu(O_RDWR|O_CREAT);
     else
-       PUSHs(sv_2mortal(newSVuv(O_RDWR)));
+       mPUSHu(O_RDWR);
     PUSHs(right);
     PUTBACK;
     call_sv((SV*)GvCV(gv), G_SCALAR);
@@ -979,7 +966,7 @@ PP(pp_dbmopen)
        PUSHMARK(SP);
        PUSHs(sv);
        PUSHs(left);
-       PUSHs(sv_2mortal(newSVuv(O_RDONLY)));
+       mPUSHu(O_RDONLY);
        PUSHs(right);
        PUTBACK;
        call_sv((SV*)GvCV(gv), G_SCALAR);
@@ -1150,7 +1137,7 @@ PP(pp_sselect)
     if (GIMME == G_ARRAY && tbuf) {
        value = (NV)(timebuf.tv_sec) +
                (NV)(timebuf.tv_usec) / 1000000.0;
-       PUSHs(sv_2mortal(newSVnv(value)));
+       mPUSHn(value);
     }
     RETURN;
 #else
@@ -1187,7 +1174,7 @@ PP(pp_select)
            XPUSHTARG;
        }
        else {
-           XPUSHs(sv_2mortal(newRV((SV*)egv)));
+           mXPUSHs(newRV((SV*)egv));
        }
     }
 
@@ -2025,7 +2012,12 @@ PP(pp_eof)
                    IoLINES(io) = 0;
                    IoFLAGS(io) &= ~IOf_START;
                    do_open(gv, "-", 1, FALSE, O_RDONLY, 0, NULL);
-                   sv_setpvn(GvSV(gv), "-", 1);
+                   if ( GvSV(gv) ) {
+                       sv_setpvn(GvSV(gv), "-", 1);
+                   }
+                   else {
+                       GvSV(gv) = newSVpvn("-", 1);
+                   }
                    SvSETMAGIC(GvSV(gv));
                }
                else if (!nextargv(gv))
@@ -2108,11 +2100,11 @@ PP(pp_sysseek)
            PUSHMARK(SP);
            XPUSHs(SvTIED_obj((SV*)io, mg));
 #if LSEEKSIZE > IVSIZE
-           XPUSHs(sv_2mortal(newSVnv((NV) offset)));
+           mXPUSHn((NV) offset);
 #else
-           XPUSHs(sv_2mortal(newSViv(offset)));
+           mXPUSHi(offset);
 #endif
-           XPUSHs(sv_2mortal(newSViv(whence)));
+           mXPUSHi(whence);
            PUTBACK;
            ENTER;
            call_method("SEEK", G_SCALAR);
@@ -2136,7 +2128,7 @@ PP(pp_sysseek)
                 newSViv(sought)
 #endif
                 : newSVpvn(zero_but_true, ZBTLEN);
-            PUSHs(sv_2mortal(sv));
+            mPUSHs(sv);
         }
     }
     RETURN;
@@ -2881,53 +2873,53 @@ PP(pp_stat)
     if (max) {
        EXTEND(SP, max);
        EXTEND_MORTAL(max);
-       PUSHs(sv_2mortal(newSViv(PL_statcache.st_dev)));
-       PUSHs(sv_2mortal(newSViv(PL_statcache.st_ino)));
-       PUSHs(sv_2mortal(newSVuv(PL_statcache.st_mode)));
-       PUSHs(sv_2mortal(newSVuv(PL_statcache.st_nlink)));
+       mPUSHi(PL_statcache.st_dev);
+       mPUSHi(PL_statcache.st_ino);
+       mPUSHu(PL_statcache.st_mode);
+       mPUSHu(PL_statcache.st_nlink);
 #if Uid_t_size > IVSIZE
-       PUSHs(sv_2mortal(newSVnv(PL_statcache.st_uid)));
+       mPUSHn(PL_statcache.st_uid);
 #else
 #   if Uid_t_sign <= 0
-       PUSHs(sv_2mortal(newSViv(PL_statcache.st_uid)));
+       mPUSHi(PL_statcache.st_uid);
 #   else
-       PUSHs(sv_2mortal(newSVuv(PL_statcache.st_uid)));
+       mPUSHu(PL_statcache.st_uid);
 #   endif
 #endif
 #if Gid_t_size > IVSIZE
-       PUSHs(sv_2mortal(newSVnv(PL_statcache.st_gid)));
+       mPUSHn(PL_statcache.st_gid);
 #else
 #   if Gid_t_sign <= 0
-       PUSHs(sv_2mortal(newSViv(PL_statcache.st_gid)));
+       mPUSHi(PL_statcache.st_gid);
 #   else
-       PUSHs(sv_2mortal(newSVuv(PL_statcache.st_gid)));
+       mPUSHu(PL_statcache.st_gid);
 #   endif
 #endif
 #ifdef USE_STAT_RDEV
-       PUSHs(sv_2mortal(newSViv(PL_statcache.st_rdev)));
+       mPUSHi(PL_statcache.st_rdev);
 #else
-       PUSHs(sv_2mortal(newSVpvs("")));
+       PUSHs(newSVpvs_flags("", SVs_TEMP));
 #endif
 #if Off_t_size > IVSIZE
-       PUSHs(sv_2mortal(newSVnv((NV)PL_statcache.st_size)));
+       mPUSHn(PL_statcache.st_size);
 #else
-       PUSHs(sv_2mortal(newSViv(PL_statcache.st_size)));
+       mPUSHi(PL_statcache.st_size);
 #endif
 #ifdef BIG_TIME
-       PUSHs(sv_2mortal(newSVnv(PL_statcache.st_atime)));
-       PUSHs(sv_2mortal(newSVnv(PL_statcache.st_mtime)));
-       PUSHs(sv_2mortal(newSVnv(PL_statcache.st_ctime)));
+       mPUSHn(PL_statcache.st_atime);
+       mPUSHn(PL_statcache.st_mtime);
+       mPUSHn(PL_statcache.st_ctime);
 #else
-       PUSHs(sv_2mortal(newSViv((IV)PL_statcache.st_atime)));
-       PUSHs(sv_2mortal(newSViv((IV)PL_statcache.st_mtime)));
-       PUSHs(sv_2mortal(newSViv((IV)PL_statcache.st_ctime)));
+       mPUSHi(PL_statcache.st_atime);
+       mPUSHi(PL_statcache.st_mtime);
+       mPUSHi(PL_statcache.st_ctime);
 #endif
 #ifdef USE_STAT_BLOCKS
-       PUSHs(sv_2mortal(newSVuv(PL_statcache.st_blksize)));
-       PUSHs(sv_2mortal(newSVuv(PL_statcache.st_blocks)));
+       mPUSHu(PL_statcache.st_blksize);
+       mPUSHu(PL_statcache.st_blocks);
 #else
-       PUSHs(sv_2mortal(newSVpvs("")));
-       PUSHs(sv_2mortal(newSVpvs("")));
+       PUSHs(newSVpvs_flags("", SVs_TEMP));
+       PUSHs(newSVpvs_flags("", SVs_TEMP));
 #endif
     }
     RETURN;
@@ -3007,10 +2999,9 @@ PP(pp_ftrread)
        effective = TRUE;
        break;
 
-
     case OP_FTEEXEC:
 #ifdef PERL_EFF_ACCESS
-       access_mode = W_OK;
+       access_mode = X_OK;
 #else
        use_access = 0;
 #endif
@@ -3820,7 +3811,7 @@ PP(pp_readdir)
         if (!(IoFLAGS(io) & IOf_UNTAINT))
             SvTAINTED_on(sv);
 #endif
-        XPUSHs(sv_2mortal(sv));
+        mXPUSHs(sv);
     } while (gimme == G_ARRAY);
 
     if (!dp && gimme != G_ARRAY)
@@ -4375,22 +4366,22 @@ PP(pp_tms)
                                                    /* is returned.                   */
 #endif
 
-    PUSHs(sv_2mortal(newSVnv(((NV)PL_timesbuf.tms_utime)/(NV)PL_clocktick)));
+    mPUSHn(((NV)PL_timesbuf.tms_utime)/(NV)PL_clocktick);
     if (GIMME == G_ARRAY) {
-       PUSHs(sv_2mortal(newSVnv(((NV)PL_timesbuf.tms_stime)/(NV)PL_clocktick)));
-       PUSHs(sv_2mortal(newSVnv(((NV)PL_timesbuf.tms_cutime)/(NV)PL_clocktick)));
-       PUSHs(sv_2mortal(newSVnv(((NV)PL_timesbuf.tms_cstime)/(NV)PL_clocktick)));
+       mPUSHn(((NV)PL_timesbuf.tms_stime)/(NV)PL_clocktick);
+       mPUSHn(((NV)PL_timesbuf.tms_cutime)/(NV)PL_clocktick);
+       mPUSHn(((NV)PL_timesbuf.tms_cstime)/(NV)PL_clocktick);
     }
     RETURN;
 #else
 #   ifdef PERL_MICRO
     dSP;
-    PUSHs(sv_2mortal(newSVnv((NV)0.0)));
+    mPUSHn(0.0);
     EXTEND(SP, 4);
     if (GIMME == G_ARRAY) {
-        PUSHs(sv_2mortal(newSVnv((NV)0.0)));
-        PUSHs(sv_2mortal(newSVnv((NV)0.0)));
-        PUSHs(sv_2mortal(newSVnv((NV)0.0)));
+        mPUSHn(0.0);
+        mPUSHn(0.0);
+        mPUSHn(0.0);
     }
     RETURN;
 #   else
@@ -4483,20 +4474,20 @@ PP(pp_gmtime)
                            tmbuf->tm_min,
                            tmbuf->tm_sec,
                            tmbuf->tm_year + 1900);
-       PUSHs(sv_2mortal(tsv));
+       mPUSHs(tsv);
     }
     else if (tmbuf) {
         EXTEND(SP, 9);
         EXTEND_MORTAL(9);
-        PUSHs(sv_2mortal(newSViv(tmbuf->tm_sec)));
-       PUSHs(sv_2mortal(newSViv(tmbuf->tm_min)));
-       PUSHs(sv_2mortal(newSViv(tmbuf->tm_hour)));
-       PUSHs(sv_2mortal(newSViv(tmbuf->tm_mday)));
-       PUSHs(sv_2mortal(newSViv(tmbuf->tm_mon)));
-       PUSHs(sv_2mortal(newSViv(tmbuf->tm_year)));
-       PUSHs(sv_2mortal(newSViv(tmbuf->tm_wday)));
-       PUSHs(sv_2mortal(newSViv(tmbuf->tm_yday)));
-       PUSHs(sv_2mortal(newSViv(tmbuf->tm_isdst)));
+        mPUSHi(tmbuf->tm_sec);
+       mPUSHi(tmbuf->tm_min);
+       mPUSHi(tmbuf->tm_hour);
+       mPUSHi(tmbuf->tm_mday);
+       mPUSHi(tmbuf->tm_mon);
+       mPUSHi(tmbuf->tm_year);
+       mPUSHi(tmbuf->tm_wday);
+       mPUSHi(tmbuf->tm_yday);
+       mPUSHi(tmbuf->tm_isdst);
     }
     RETURN;
 }
@@ -4615,7 +4606,7 @@ S_space_join_names_mortal(pTHX_ char *const *array)
     SV *target;
 
     if (array && *array) {
-       target = sv_2mortal(newSVpvs(""));
+       target = newSVpvs_flags("", SVs_TEMP);
        while (1) {
            sv_catpv(target, *array);
            if (!*++array)
@@ -4698,18 +4689,18 @@ PP(pp_ghostent)
     }
 
     if (hent) {
-       PUSHs(sv_2mortal(newSVpv((char*)hent->h_name, 0)));
+       mPUSHs(newSVpv((char*)hent->h_name, 0));
        PUSHs(space_join_names_mortal(hent->h_aliases));
-       PUSHs(sv_2mortal(newSViv((IV)hent->h_addrtype)));
+       mPUSHi(hent->h_addrtype);
        len = hent->h_length;
-       PUSHs(sv_2mortal(newSViv((IV)len)));
+       mPUSHi(len);
 #ifdef h_addr
        for (elem = hent->h_addr_list; elem && *elem; elem++) {
-           XPUSHs(sv_2mortal(newSVpvn(*elem, len)));
+           mXPUSHp(*elem, len);
        }
 #else
        if (hent->h_addr)
-           PUSHs(newSVpvn(hent->h_addr, len));
+           mPUSHp(hent->h_addr, len);
        else
            PUSHs(sv_mortalcopy(&PL_sv_no));
 #endif /* h_addr */
@@ -4781,10 +4772,10 @@ PP(pp_gnetent)
     }
 
     if (nent) {
-       PUSHs(sv_2mortal(newSVpv(nent->n_name, 0)));
+       mPUSHs(newSVpv(nent->n_name, 0));
        PUSHs(space_join_names_mortal(nent->n_aliases));
-       PUSHs(sv_2mortal(newSViv((IV)nent->n_addrtype)));
-       PUSHs(sv_2mortal(newSViv((IV)nent->n_net)));
+       mPUSHi(nent->n_addrtype);
+       mPUSHi(nent->n_net);
     }
 
     RETURN;
@@ -4842,9 +4833,9 @@ PP(pp_gprotoent)
     }
 
     if (pent) {
-       PUSHs(sv_2mortal(newSVpv(pent->p_name, 0)));
+       mPUSHs(newSVpv(pent->p_name, 0));
        PUSHs(space_join_names_mortal(pent->p_aliases));
-       PUSHs(sv_2mortal(newSViv((IV)pent->p_proto)));
+       mPUSHi(pent->p_proto);
     }
 
     RETURN;
@@ -4912,14 +4903,14 @@ PP(pp_gservent)
     }
 
     if (sent) {
-       PUSHs(sv_2mortal(newSVpv(sent->s_name, 0)));
+       mPUSHs(newSVpv(sent->s_name, 0));
        PUSHs(space_join_names_mortal(sent->s_aliases));
 #ifdef HAS_NTOHS
-       PUSHs(sv_2mortal(newSViv((IV)PerlSock_ntohs(sent->s_port))));
+       mPUSHi(PerlSock_ntohs(sent->s_port));
 #else
-       PUSHs(sv_2mortal(newSViv((IV)(sent->s_port))));
+       mPUSHi(sent->s_port);
 #endif
-       PUSHs(sv_2mortal(newSVpv(sent->s_proto, 0)));
+       mPUSHs(newSVpv(sent->s_proto, 0));
     }
 
     RETURN;
@@ -5135,9 +5126,10 @@ PP(pp_gpwent)
     }
 
     if (pwent) {
-       PUSHs(sv_2mortal(newSVpv(pwent->pw_name, 0)));
+       mPUSHs(newSVpv(pwent->pw_name, 0));
 
-       PUSHs(sv = sv_2mortal(newSViv(0)));
+       sv = newSViv(0);
+       mPUSHs(sv);
        /* If we have getspnam(), we try to dig up the shadow
         * password.  If we are underprivileged, the shadow
         * interface will set the errno to EACCES or similar,
@@ -5181,15 +5173,15 @@ PP(pp_gpwent)
 #   endif
 
 #   if Uid_t_sign <= 0
-       PUSHs(sv_2mortal(newSViv((IV)pwent->pw_uid)));
+       mPUSHi(pwent->pw_uid);
 #   else
-       PUSHs(sv_2mortal(newSVuv((UV)pwent->pw_uid)));
+       mPUSHu(pwent->pw_uid);
 #   endif
 
 #   if Uid_t_sign <= 0
-       PUSHs(sv_2mortal(newSViv((IV)pwent->pw_gid)));
+       mPUSHi(pwent->pw_gid);
 #   else
-       PUSHs(sv_2mortal(newSVuv((UV)pwent->pw_gid)));
+       mPUSHu(pwent->pw_gid);
 #   endif
        /* pw_change, pw_quota, and pw_age are mutually exclusive--
         * because of the poor interface of the Perl getpw*(),
@@ -5197,13 +5189,13 @@ PP(pp_gpwent)
         * A better interface would have been to return a hash,
         * but we are accursed by our history, alas. --jhi.  */
 #   ifdef PWCHANGE
-       PUSHs(sv_2mortal(newSViv((IV)pwent->pw_change)));
+       mPUSHi(pwent->pw_change);
 #   else
 #       ifdef PWQUOTA
-       PUSHs(sv_2mortal(newSViv((IV)pwent->pw_quota)));
+       mPUSHi(pwent->pw_quota);
 #       else
 #           ifdef PWAGE
-       PUSHs(sv_2mortal(newSVpv(pwent->pw_age, 0)));
+       mPUSHs(newSVpv(pwent->pw_age, 0));
 #          else
        /* I think that you can never get this compiled, but just in case.  */
        PUSHs(sv_mortalcopy(&PL_sv_no));
@@ -5214,10 +5206,10 @@ PP(pp_gpwent)
        /* pw_class and pw_comment are mutually exclusive--.
         * see the above note for pw_change, pw_quota, and pw_age. */
 #   ifdef PWCLASS
-       PUSHs(sv_2mortal(newSVpv(pwent->pw_class, 0)));
+       mPUSHs(newSVpv(pwent->pw_class, 0));
 #   else
 #       ifdef PWCOMMENT
-       PUSHs(sv_2mortal(newSVpv(pwent->pw_comment, 0)));
+       mPUSHs(newSVpv(pwent->pw_comment, 0));
 #      else
        /* I think that you can never get this compiled, but just in case.  */
        PUSHs(sv_mortalcopy(&PL_sv_no));
@@ -5227,14 +5219,14 @@ PP(pp_gpwent)
 #   ifdef PWGECOS
        PUSHs(sv = sv_2mortal(newSVpv(pwent->pw_gecos, 0)));
 #   else
-       PUSHs(sv_mortalcopy(&PL_sv_no));
+       PUSHs(sv = sv_mortalcopy(&PL_sv_no));
 #   endif
 #   ifndef INCOMPLETE_TAINTS
        /* pw_gecos is tainted because user himself can diddle with it. */
        SvTAINTED_on(sv);
 #   endif
 
-       PUSHs(sv_2mortal(newSVpv(pwent->pw_dir, 0)));
+       mPUSHs(newSVpv(pwent->pw_dir, 0));
 
        PUSHs(sv = sv_2mortal(newSVpv(pwent->pw_shell, 0)));
 #   ifndef INCOMPLETE_TAINTS
@@ -5243,7 +5235,7 @@ PP(pp_gpwent)
 #   endif
 
 #   ifdef PWEXPIRE
-       PUSHs(sv_2mortal(newSViv((IV)pwent->pw_expire)));
+       mPUSHi(pwent->pw_expire);
 #   endif
     }
     RETURN;
@@ -5311,15 +5303,15 @@ PP(pp_ggrent)
     }
 
     if (grent) {
-       PUSHs(sv_2mortal(newSVpv(grent->gr_name, 0)));
+       mPUSHs(newSVpv(grent->gr_name, 0));
 
 #ifdef GRPASSWD
-       PUSHs(sv_2mortal(newSVpv(grent->gr_passwd, 0)));
+       mPUSHs(newSVpv(grent->gr_passwd, 0));
 #else
        PUSHs(sv_mortalcopy(&PL_sv_no));
 #endif
 
-       PUSHs(sv_2mortal(newSViv((IV)grent->gr_gid)));
+       mPUSHi(grent->gr_gid);
 
 #if !(defined(_CRAYMPP) && defined(USE_REENTRANT_API))
        /* In UNICOS/mk (_CRAYMPP) the multithreading