Add gv_fetchpvs, which uses STR_WITH_LEN to call gv_fetchpvn_flags.

[perl5.git] / pp_sys.c

diff --git a/pp_sys.c b/pp_sys.c
index e1c6125..bc5a23e 100644 (file)
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -352,7 +352,7 @@ PP(pp_backtick)
        }
        else {
            for (;;) {
-               SV * const sv = NEWSV(56, 79);
+               SV * const sv = newSV(79);
                if (sv_gets(sv, fp, 0) == Nullch) {
                    SvREFCNT_dec(sv);
                    break;
@@ -1330,7 +1330,7 @@ PP(pp_leavewrite)
                topname = sv_2mortal(Perl_newSVpvf(aTHX_ "%s_TOP", GvNAME(gv)));
                topgv = gv_fetchsv(topname, 0, SVt_PVFM);
                if ((topgv && GvFORM(topgv)) ||
-                 !gv_fetchpv("top", 0, SVt_PVFM))
+                 !gv_fetchpvs("top", 0, SVt_PVFM))
                    IoTOP_NAME(io) = savesvpv(topname);
                else
                    IoTOP_NAME(io) = savepvs("top");
@@ -1460,7 +1460,7 @@ PP(pp_prtf)
        RETURN;
     }
 
-    sv = NEWSV(0,0);
+    sv = newSV(0);
     if (!(io = GvIO(gv))) {
        if (ckWARN2(WARN_UNOPENED,WARN_CLOSED))
            report_evil_fh(gv, io, PL_op->op_type);
@@ -1932,8 +1932,6 @@ PP(pp_eof)
 {
     dVAR; dSP;
     GV *gv;
-    IO *io;
-    MAGIC *mg;
 
     if (MAXARG == 0) {
        if (PL_op->op_flags & OPf_SPECIAL) {    /* eof() */
@@ -1958,17 +1956,19 @@ PP(pp_eof)
     else
        gv = PL_last_in_gv = (GV*)POPs;         /* eof(FH) */
 
-    if (gv && (io = GvIO(gv))
-       && (mg = SvTIED_mg((SV*)io, PERL_MAGIC_tiedscalar)))
-    {
-       PUSHMARK(SP);
-       XPUSHs(SvTIED_obj((SV*)io, mg));
-       PUTBACK;
-       ENTER;
-       call_method("EOF", G_SCALAR);
-       LEAVE;
-       SPAGAIN;
-       RETURN;
+    if (gv) {
+       IO * const io = GvIO(gv);
+       MAGIC * mg;
+       if (io && (mg = SvTIED_mg((SV*)io, PERL_MAGIC_tiedscalar))) {
+           PUSHMARK(SP);
+           XPUSHs(SvTIED_obj((SV*)io, mg));
+           PUTBACK;
+           ENTER;
+           call_method("EOF", G_SCALAR);
+           LEAVE;
+           SPAGAIN;
+           RETURN;
+       }
     }
 
     PUSHs(boolSV(!gv || do_eof(gv)));
@@ -2381,10 +2381,6 @@ PP(pp_bind)
 {
 #ifdef HAS_SOCKET
     dVAR; dSP;
-#ifdef MPE /* Requires PRIV mode to bind() to ports < 1024 */
-    extern void GETPRIVMODE();
-    extern void GETUSERMODE();
-#endif
     SV * const addrsv = POPs;
     /* OK, so on what platform does bind modify addr?  */
     const char *addr;
@@ -2392,35 +2388,16 @@ PP(pp_bind)
     register IO * const io = GvIOn(gv);
     STRLEN len;
     int bind_ok = 0;
-#ifdef MPE
-    int mpeprivmode = 0;
-#endif
 
     if (!io || !IoIFP(io))
        goto nuts;
 
     addr = SvPV_const(addrsv, len);
     TAINT_PROPER("bind");
-#ifdef MPE /* Deal with MPE bind() peculiarities */
-    if (((struct sockaddr *)addr)->sa_family == AF_INET) {
-        /* The address *MUST* stupidly be zero. */
-        ((struct sockaddr_in *)addr)->sin_addr.s_addr = INADDR_ANY;
-        /* PRIV mode is required to bind() to ports < 1024. */
-        if (((struct sockaddr_in *)addr)->sin_port < 1024 &&
-            ((struct sockaddr_in *)addr)->sin_port > 0) {
-            GETPRIVMODE(); /* If this fails, we are aborted by MPE/iX. */
-           mpeprivmode = 1;
-       }
-    }
-#endif /* MPE */
     if (PerlSock_bind(PerlIO_fileno(IoIFP(io)),
                      (struct sockaddr *)addr, len) >= 0)
        bind_ok = 1;
 
-#ifdef MPE /* Switch back to USER mode */
-    if (mpeprivmode)
-       GETUSERMODE();
-#endif /* MPE */
 
     if (bind_ok)
        RETPUSHYES;
@@ -2590,7 +2567,7 @@ PP(pp_ssockopt)
 #ifdef HAS_SOCKET
     dVAR; dSP;
     const int optype = PL_op->op_type;
-    SV * const sv = (optype == OP_GSOCKOPT) ? sv_2mortal(NEWSV(22, 257)) : POPs;
+    SV * const sv = (optype == OP_GSOCKOPT) ? sv_2mortal(newSV(257)) : POPs;
     const unsigned int optname = (unsigned int) POPi;
     const unsigned int lvl = (unsigned int) POPi;
     GV * const gv = (GV*)POPs;
@@ -2676,7 +2653,7 @@ PP(pp_getpeername)
     if (!io || !IoIFP(io))
        goto nuts;
 
-    sv = sv_2mortal(NEWSV(22, 257));
+    sv = sv_2mortal(newSV(257));
     (void)SvPOK_only(sv);
     len = 256;
     SvCUR_set(sv, len);
@@ -3543,7 +3520,7 @@ S_dooneliner(pTHX_ const char *cmd, const char *filename)
                 ; e++)
            {
                /* you don't see this */
-               char *errmsg =
+               const char * const errmsg =
 #ifdef HAS_SYS_ERRLIST
                    sys_errlist[e]
 #else
@@ -3879,7 +3856,7 @@ PP(pp_fork)
     if (childpid < 0)
        RETSETUNDEF;
     if (!childpid) {
-       GV * const tmpgv = gv_fetchpv("$", GV_ADD, SVt_PV);
+       GV * const tmpgv = gv_fetchpvs("$", GV_ADD, SVt_PV);
        if (tmpgv) {
             SvREADONLY_off(GvSV(tmpgv));
            sv_setiv(GvSV(tmpgv), (IV)PerlProc_getpid());
@@ -5194,18 +5171,16 @@ PP(pp_ggrent)
 {
 #ifdef HAS_GROUP
     dVAR; dSP;
-    I32 which = PL_op->op_type;
-    register char **elem;
-    register SV *sv;
-    struct group *grent;
+    const I32 which = PL_op->op_type;
+    const struct group *grent;
 
     if (which == OP_GGRNAM) {
        const char* const name = POPpbytex;
-       grent = (struct group *)getgrnam(name);
+       grent = (const struct group *)getgrnam(name);
     }
     else if (which == OP_GGRGID) {
        const Gid_t gid = POPi;
-       grent = (struct group *)getgrgid(gid);
+       grent = (const struct group *)getgrgid(gid);
     }
     else
 #ifdef HAS_GETGRENT
@@ -5216,7 +5191,9 @@ PP(pp_ggrent)
 
     EXTEND(SP, 4);
     if (GIMME != G_ARRAY) {
-       PUSHs(sv = sv_newmortal());
+       SV * const sv = sv_newmortal();
+
+       PUSHs(sv);
        if (grent) {
            if (which == OP_GGRNAM)
                sv_setiv(sv, (IV)grent->gr_gid);
@@ -5227,6 +5204,8 @@ PP(pp_ggrent)
     }
 
     if (grent) {
+       SV *sv;
+       char **elem;
        PUSHs(sv = sv_mortalcopy(&PL_sv_no));
        sv_setpv(sv, grent->gr_name);