Finish converting overload.t to Test::More
[p5sagit/p5-mst-13.2.git] / pp_sys.c
index e1c6125..92c0b08 100644 (file)
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -307,8 +307,8 @@ S_emulate_eaccess(pTHX_ const char* path, Mode_t mode)
 STATIC int
 S_emulate_eaccess(pTHX_ const char* path, Mode_t mode)
 {
-    (void)path;
-    (void)mode;
+    PERL_UNUSED_ARG(path);
+    PERL_UNUSED_ARG(mode);
     Perl_croak(aTHX_ "switching effective uid is not implemented");
     /*NOTREACHED*/
     return -1;
@@ -344,7 +344,7 @@ PP(pp_backtick)
            SAVESPTR(PL_rs);
            PL_rs = &PL_sv_undef;
            sv_setpvn(TARG, "", 0);     /* note that this preserves previous buffer */
-           while (sv_gets(TARG, fp, SvCUR(TARG)) != Nullch)
+           while (sv_gets(TARG, fp, SvCUR(TARG)) != NULL)
                ;
            LEAVE;
            XPUSHs(TARG);
@@ -352,8 +352,8 @@ PP(pp_backtick)
        }
        else {
            for (;;) {
-               SV * const sv = NEWSV(56, 79);
-               if (sv_gets(sv, fp, 0) == Nullch) {
+               SV * const sv = newSV(79);
+               if (sv_gets(sv, fp, 0) == NULL) {
                    SvREFCNT_dec(sv);
                    break;
                }
@@ -477,7 +477,7 @@ PP(pp_die)
     }
     else {
        tmpsv = TOPs;
-        tmps = SvROK(tmpsv) ? Nullch : SvPV_const(tmpsv, len);
+        tmps = SvROK(tmpsv) ? NULL : SvPV_const(tmpsv, len);
     }
     if (!tmps || !len) {
        SV * const error = ERRSV;
@@ -502,7 +502,7 @@ PP(pp_die)
                    sv_setsv(error,*PL_stack_sp--);
                }
            }
-           DIE(aTHX_ Nullch);
+           DIE(aTHX_ NULL);
        }
        else {
            if (SvPOK(error) && SvCUR(error))
@@ -511,7 +511,7 @@ PP(pp_die)
            if (SvOK(tmpsv))
                tmps = SvPV_const(tmpsv, len);
            else
-               tmps = Nullch;
+               tmps = NULL;
        }
     }
     if (!tmps || !len)
@@ -564,7 +564,7 @@ PP(pp_open)
     }
 
     tmps = SvPV_const(sv, len);
-    ok = do_openn(gv, tmps, len, FALSE, O_RDONLY, 0, Nullfp, MARK+1, (SP-MARK));
+    ok = do_openn(gv, tmps, len, FALSE, O_RDONLY, 0, NULL, MARK+1, (SP-MARK));
     SP = ORIGMARK;
     if (ok)
        PUSHi( (I32)PL_forkprocess );
@@ -726,7 +726,7 @@ PP(pp_binmode)
     IO *io;
     PerlIO *fp;
     MAGIC *mg;
-    SV *discp = Nullsv;
+    SV *discp = NULL;
 
     if (MAXARG < 1)
        RETPUSHUNDEF;
@@ -761,11 +761,11 @@ PP(pp_binmode)
 
     PUTBACK;
     if (PerlIO_binmode(aTHX_ fp,IoTYPE(io),mode_from_discipline(discp),
-                       (discp) ? SvPV_nolen_const(discp) : Nullch)) {
+                       (discp) ? SvPV_nolen_const(discp) : NULL)) {
        if (IoOFP(io) && IoOFP(io) != IoIFP(io)) {
             if (!PerlIO_binmode(aTHX_ IoOFP(io),IoTYPE(io),
                        mode_from_discipline(discp),
-                       (discp) ? SvPV_nolen_const(discp) : Nullch)) {
+                       (discp) ? SvPV_nolen_const(discp) : NULL)) {
                SPAGAIN;
                RETPUSHUNDEF;
             }
@@ -859,7 +859,7 @@ PP(pp_tie)
             SvTYPE(varsv) == SVt_PVHV))
            Perl_croak(aTHX_
                       "Self-ties of arrays and hashes are not supported");
-       sv_magic(varsv, (SvRV(sv) == varsv ? Nullsv : sv), how, Nullch, 0);
+       sv_magic(varsv, (SvRV(sv) == varsv ? NULL : sv), how, NULL, 0);
     }
     LEAVE;
     SP = PL_stack_base + markoff;
@@ -975,7 +975,7 @@ PP(pp_dbmopen)
 
     if (sv_isobject(TOPs)) {
        sv_unmagic((SV *) hv, PERL_MAGIC_tied);
-       sv_magic((SV*)hv, TOPs, PERL_MAGIC_tied, Nullch, 0);
+       sv_magic((SV*)hv, TOPs, PERL_MAGIC_tied, NULL, 0);
     }
     LEAVE;
     RETURN;
@@ -1070,7 +1070,7 @@ PP(pp_sselect)
        timebuf.tv_usec = (long)(value * 1000000.0);
     }
     else
-       tbuf = Null(struct timeval*);
+       tbuf = NULL;
 
     for (i = 1; i <= 3; i++) {
        sv = SP[i];
@@ -1150,8 +1150,7 @@ void
 Perl_setdefout(pTHX_ GV *gv)
 {
     dVAR;
-    if (gv)
-       (void)SvREFCNT_inc(gv);
+    SvREFCNT_inc_simple_void(gv);
     if (PL_defoutgv)
        SvREFCNT_dec(PL_defoutgv);
     PL_defoutgv = gv;
@@ -1172,7 +1171,7 @@ PP(pp_select)
     else {
        GV * const * const gvp = (GV**)hv_fetch(hv, GvNAME(egv), GvNAMELEN(egv), FALSE);
        if (gvp && *gvp == egv) {
-           gv_efullname4(TARG, PL_defoutgv, Nullch, TRUE);
+           gv_efullname4(TARG, PL_defoutgv, NULL, TRUE);
            XPUSHTARG;
        }
        else {
@@ -1286,7 +1285,7 @@ PP(pp_enterwrite)
        if (fgv) {
            SV * const tmpsv = sv_newmortal();
            const char *name;
-           gv_efullname4(tmpsv, fgv, Nullch, FALSE);
+           gv_efullname4(tmpsv, fgv, NULL, FALSE);
            name = SvPV_nolen_const(tmpsv);
            if (name && *name)
                DIE(aTHX_ "Undefined format \"%s\" called", name);
@@ -1330,7 +1329,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", GV_NOTQUAL, SVt_PVFM))
                    IoTOP_NAME(io) = savesvpv(topname);
                else
                    IoTOP_NAME(io) = savepvs("top");
@@ -1375,7 +1374,7 @@ PP(pp_leavewrite)
        if (!cv) {
            SV * const sv = sv_newmortal();
            const char *name;
-           gv_efullname4(sv, fgv, Nullch, FALSE);
+           gv_efullname4(sv, fgv, NULL, FALSE);
            name = SvPV_nolen_const(sv);
            if (name && *name)
                DIE(aTHX_ "Undefined top format \"%s\" called",name);
@@ -1460,7 +1459,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);
@@ -1511,7 +1510,7 @@ PP(pp_sysopen)
     /* Need TIEHANDLE method ? */
     const char * const tmps = SvPV_const(sv, len);
     /* FIXME? do_open should do const  */
-    if (do_open(gv, tmps, len, TRUE, mode, perm, Nullfp)) {
+    if (do_open(gv, tmps, len, TRUE, mode, perm, NULL)) {
        IoLINES(GvIOp(gv)) = 0;
        PUSHs(&PL_sv_yes);
     }
@@ -1932,8 +1931,6 @@ PP(pp_eof)
 {
     dVAR; dSP;
     GV *gv;
-    IO *io;
-    MAGIC *mg;
 
     if (MAXARG == 0) {
        if (PL_op->op_flags & OPf_SPECIAL) {    /* eof() */
@@ -1944,7 +1941,7 @@ PP(pp_eof)
                if ((IoFLAGS(io) & IOf_START) && av_len(GvAVn(gv)) < 0) {
                    IoLINES(io) = 0;
                    IoFLAGS(io) &= ~IOf_START;
-                   do_open(gv, "-", 1, FALSE, O_RDONLY, 0, Nullfp);
+                   do_open(gv, "-", 1, FALSE, O_RDONLY, 0, NULL);
                    sv_setpvn(GvSV(gv), "-", 1);
                    SvSETMAGIC(GvSV(gv));
                }
@@ -1958,17 +1955,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)));
@@ -2162,7 +2161,7 @@ PP(pp_ioctl)
     const unsigned int func = POPu;
     const int optype = PL_op->op_type;
     GV * const gv = (GV*)POPs;
-    IO * const io = gv ? GvIOn(gv) : Null(IO*);
+    IO * const io = gv ? GvIOn(gv) : NULL;
     char *s;
     IV retval;
 
@@ -2243,7 +2242,7 @@ PP(pp_flock)
     if (gv && (io = GvIO(gv)))
        fp = IoIFP(io);
     else {
-       fp = Nullfp;
+       fp = NULL;
        io = NULL;
     }
     /* XXX Looks to me like io is always NULL at this point */
@@ -2381,10 +2380,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 +2387,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 +2566,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 +2652,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);
@@ -2775,7 +2751,7 @@ PP(pp_stat)
            goto do_fstat;
        }
        sv_setpv(PL_statname, SvPV_nolen_const(sv));
-       PL_statgv = Nullgv;
+       PL_statgv = NULL;
        PL_laststype = PL_op->op_type;
        if (PL_op->op_type == OP_LSTAT)
            PL_laststatval = PerlLIO_lstat(SvPV_nolen_const(PL_statname), &PL_statcache);
@@ -3112,7 +3088,7 @@ PP(pp_fttty)
     dSP;
     int fd;
     GV *gv;
-    SV *tmpsv = Nullsv;
+    SV *tmpsv = NULL;
 
     STACKED_FTEST_CHECK;
 
@@ -3172,7 +3148,7 @@ PP(pp_fttext)
     else if (SvROK(TOPs) && isGV(SvRV(TOPs)))
        gv = (GV*)SvRV(POPs);
     else
-       gv = Nullgv;
+       gv = NULL;
 
     if (gv) {
        EXTEND(SP, 1);
@@ -3227,7 +3203,7 @@ PP(pp_fttext)
     else {
        sv = POPs;
       really_filename:
-       PL_statgv = Nullgv;
+       PL_statgv = NULL;
        PL_laststype = OP_STAT;
        sv_setpv(PL_statname, SvPV_nolen_const(sv));
        if (!(fp = PerlIO_open(SvPVX_const(PL_statname), "r"))) {
@@ -3241,7 +3217,7 @@ PP(pp_fttext)
            (void)PerlIO_close(fp);
            RETPUSHUNDEF;
        }
-       PerlIO_binmode(aTHX_ fp, '<', O_BINARY, Nullch);
+       PerlIO_binmode(aTHX_ fp, '<', O_BINARY, NULL);
        len = PerlIO_read(fp, tbuf, sizeof(tbuf));
        (void)PerlIO_close(fp);
        if (len <= 0) {
@@ -3316,7 +3292,10 @@ PP(pp_chdir)
 
     if( MAXARG == 1 ) {
        SV * const sv = POPs;
-        if (SvTYPE(sv) == SVt_PVGV) {
+       if (PL_op->op_flags & OPf_SPECIAL) {
+           gv = gv_fetchsv(sv, 0, SVt_PVIO);
+       }
+        else if (SvTYPE(sv) == SVt_PVGV) {
            gv = (GV*)sv;
         }
        else if (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVGV) {
@@ -3365,10 +3344,16 @@ PP(pp_chdir)
 #endif
            }
            else {
+               if (ckWARN2(WARN_UNOPENED,WARN_CLOSED))
+                   report_evil_fh(gv, io, PL_op->op_type);
+               SETERRNO(EBADF, RMS_IFI);
                PUSHi(0);
            }
         }
        else {
+           if (ckWARN2(WARN_UNOPENED,WARN_CLOSED))
+               report_evil_fh(gv, io, PL_op->op_type);
+           SETERRNO(EBADF,RMS_IFI);
            PUSHi(0);
        }
 #else
@@ -3534,7 +3519,7 @@ S_dooneliner(pTHX_ const char *cmd, const char *filename)
        /* Need to save/restore 'PL_rs' ?? */
        s = sv_gets(tmpsv, myfp, 0);
        (void)PerlProc_pclose(myfp);
-       if (s != Nullch) {
+       if (s != NULL) {
            int e;
            for (e = 1;
 #ifdef HAS_SYS_ERRLIST
@@ -3543,7 +3528,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 +3864,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|GV_NOTQUAL, SVt_PV);
        if (tmpgv) {
             SvREADONLY_off(GvSV(tmpgv));
            sv_setiv(GvSV(tmpgv), (IV)PerlProc_getpid());
@@ -4062,7 +4047,7 @@ PP(pp_system)
            value = (I32)do_aexec5(really, MARK, SP, pp[1], did_pipes);
        }
        else if (SP - MARK != 1)
-           value = (I32)do_aexec5(Nullsv, MARK, SP, pp[1], did_pipes);
+           value = (I32)do_aexec5(NULL, MARK, SP, pp[1], did_pipes);
        else {
            value = (I32)do_exec3(SvPVx_nolen(sv_mortalcopy(*SP)), pp[1], did_pipes);
        }
@@ -4081,9 +4066,9 @@ PP(pp_system)
     }
     else if (SP - MARK != 1) {
 #  if defined(WIN32) || defined(OS2) || defined(__SYMBIAN32__)
-       value = (I32)do_aspawn(Nullsv, MARK, SP);
+       value = (I32)do_aspawn(NULL, MARK, SP);
 #  else
-       value = (I32)do_aspawn(Nullsv, (void **)MARK, (void **)SP);
+       value = (I32)do_aspawn(NULL, (void **)MARK, (void **)SP);
 #  endif
     }
     else {
@@ -4121,15 +4106,15 @@ PP(pp_exec)
     }
     else if (SP - MARK != 1)
 #ifdef VMS
-       value = (I32)vms_do_aexec(Nullsv, MARK, SP);
+       value = (I32)vms_do_aexec(NULL, MARK, SP);
 #else
 #  ifdef __OPEN_VM
        {
-          (void ) do_aspawn(Nullsv, MARK, SP);
+          (void ) do_aspawn(NULL, MARK, SP);
           value = 0;
        }
 #  else
-       value = (I32)do_aexec(Nullsv, MARK, SP);
+       value = (I32)do_aexec(NULL, MARK, SP);
 #  endif
 #endif
     else {
@@ -4255,9 +4240,9 @@ PP(pp_time)
 {
     dVAR; dSP; dTARGET;
 #ifdef BIG_TIME
-    XPUSHn( time(Null(Time_t*)) );
+    XPUSHn( time(NULL) );
 #else
-    XPUSHi( time(Null(Time_t*)) );
+    XPUSHi( time(NULL) );
 #endif
     RETURN;
 }
@@ -4776,7 +4761,7 @@ PP(pp_gservent)
 #ifdef HAS_GETSERVBYNAME
        const char * const proto = POPpbytex;
        const char * const name = POPpbytex;
-       sent = PerlSock_getservbyname(name, (proto && !*proto) ? Nullch : proto);
+       sent = PerlSock_getservbyname(name, (proto && !*proto) ? NULL : proto);
 #else
        DIE(aTHX_ PL_no_sock_func, "getservbyname");
 #endif
@@ -4788,7 +4773,7 @@ PP(pp_gservent)
 #ifdef HAS_HTONS
        port = PerlSock_htons(port);
 #endif
-       sent = PerlSock_getservbyport(port, (proto && !*proto) ? Nullch : proto);
+       sent = PerlSock_getservbyport(port, (proto && !*proto) ? NULL : proto);
 #else
        DIE(aTHX_ PL_no_sock_func, "getservbyport");
 #endif
@@ -5194,18 +5179,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 +5199,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 +5212,8 @@ PP(pp_ggrent)
     }
 
     if (grent) {
+       SV *sv;
+       char **elem;
        PUSHs(sv = sv_mortalcopy(&PL_sv_no));
        sv_setpv(sv, grent->gr_name);