X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=pp_sys.c;h=92c0b08a3344ef6a56b49cf6377118de77c8d4c8;hb=b1fbf5c3d1dc6dd7934002da04dede2ae2e3ef65;hp=e1c6125dc97b038cb5b0943679df05ddb8f33f5a;hpb=a4fc7abc9c5502fa20253f620ede1e956c44caed;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/pp_sys.c b/pp_sys.c
index e1c6125..92c0b08 100644
--- 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);