X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=pp_sys.c;h=68f72271ac8fdbf9d9a17ad20072b353aba072cb;hb=89e33a0587050e7ef2e88ba45c87444d8506f821;hp=208e0eec225c80deee9c9f0d66d2eb551f756736;hpb=10516c54a74630cf74b5f3650f62a47cae3b2ac0;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/pp_sys.c b/pp_sys.c
index 208e0ee..68f7227 100644
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -321,7 +321,6 @@ PP(pp_backtick)
 {
     dSP; dTARGET;
     PerlIO *fp;
-    STRLEN n_a;
     const char *tmps = POPpconstx;
     const I32 gimme = GIMME_V;
     const char *mode = "r";
@@ -343,7 +342,6 @@ PP(pp_backtick)
 	if (gimme == G_VOID) {
 	    char tmpbuf[256];
 	    while (PerlIO_read(fp, tmpbuf, sizeof tmpbuf) > 0)
-		/*SUPPRESS 530*/
 		;
 	}
 	else if (gimme == G_SCALAR) {
@@ -352,7 +350,6 @@ PP(pp_backtick)
 	    PL_rs = &PL_sv_undef;
 	    sv_setpvn(TARG, "", 0);	/* note that this preserves previous buffer */
 	    while (sv_gets(TARG, fp, SvCUR(TARG)) != Nullch)
-		/*SUPPRESS 530*/
 		;
 	    LEAVE;
 	    XPUSHs(TARG);
@@ -1010,7 +1007,6 @@ PP(pp_sselect)
     struct timeval *tbuf = &timebuf;
     I32 growsize;
     char *fd_sets[4];
-    STRLEN n_a;
 #if BYTEORDER != 0x1234 && BYTEORDER != 0x12345678
 	I32 masksize;
 	I32 offset;
@@ -1026,9 +1022,16 @@ PP(pp_sselect)
 
     SP -= 4;
     for (i = 1; i <= 3; i++) {
-	if (!SvPOK(SP[i]))
+	SV *sv = SP[i];
+	if (SvOK(sv) && SvREADONLY(sv)) {
+	    if (SvIsCOW(sv))
+		sv_force_normal_flags(sv, 0);
+	    if (SvREADONLY(sv))
+		DIE(aTHX_ PL_no_modify);
+	}
+	if (!SvPOK(sv))
 	    continue;
-	j = SvCUR(SP[i]);
+	j = SvCUR(sv);
 	if (maxlen < j)
 	    maxlen = j;
     }
@@ -1082,7 +1085,7 @@ PP(pp_sselect)
 	    continue;
 	}
 	else if (!SvPOK(sv))
-	    SvPV_force(sv,n_a);	/* force string conversion */
+	    SvPV_force_nolen(sv);	/* force string conversion */
 	j = SvLEN(sv);
 	if (j < growsize) {
 	    Sv_Grow(sv, growsize);
@@ -1817,7 +1820,7 @@ PP(pp_send)
     GV *gv;
     IO *io;
     SV *bufsv;
-    char *buffer;
+    const char *buffer;
     Size_t length;
     SSize_t retval;
     STRLEN blen;
@@ -1866,7 +1869,7 @@ PP(pp_send)
 	    bufsv = sv_2mortal(newSVsv(bufsv));
 	    buffer = sv_2pvutf8(bufsv, &blen);
 	} else
-	    buffer = SvPV(bufsv, blen);
+	    buffer = SvPV_const(bufsv, blen);
     }
     else {
 	 if (DO_UTF8(bufsv)) {
@@ -1874,7 +1877,7 @@ PP(pp_send)
 	      bufsv = sv_2mortal(newSVsv(bufsv));
 	      sv_utf8_downgrade(bufsv, FALSE);
 	 }
-	 buffer = SvPV(bufsv, blen);
+	 buffer = SvPV_const(bufsv, blen);
     }
 
     if (PL_op->op_type == OP_SYSWRITE) {
@@ -1896,7 +1899,7 @@ PP(pp_send)
 	if (length > blen - offset)
 	    length = blen - offset;
 	if (DO_UTF8(bufsv)) {
-	    buffer = (char*)utf8_hop((U8 *)buffer, offset);
+	    buffer = (const char*)utf8_hop((const U8 *)buffer, offset);
 	    length = utf8_hop((U8 *)buffer, length) - (U8 *)buffer;
 	}
 	else {
@@ -2142,8 +2145,7 @@ PP(pp_truncate)
 	}
 	else {
 	    SV *sv = POPs;
-	    char *name;
-	    STRLEN n_a;
+	    const char *name;
 
 	    if (SvTYPE(sv) == SVt_PVGV) {
 	        tmpgv = (GV*)sv;		/* *main::FRED for example */
@@ -2158,7 +2160,7 @@ PP(pp_truncate)
 		goto do_ftruncate_io;
 	    }
 
-	    name = SvPV(sv, n_a);
+	    name = SvPV_nolen_const(sv);
 	    TAINT_PROPER("truncate");
 #ifdef HAS_TRUNCATE
 	    if (truncate(name, len) < 0)
@@ -2433,7 +2435,8 @@ PP(pp_bind)
     extern void GETUSERMODE();
 #endif
     SV *addrsv = POPs;
-    char *addr;
+    /* OK, so on what platform does bind modify addr?  */
+    const char *addr;
     GV *gv = (GV*)POPs;
     register IO *io = GvIOn(gv);
     STRLEN len;
@@ -2445,7 +2448,7 @@ PP(pp_bind)
     if (!io || !IoIFP(io))
 	goto nuts;
 
-    addr = SvPV(addrsv, len);
+    addr = SvPV_const(addrsv, len);
     TAINT_PROPER("bind");
 #ifdef MPE /* Deal with MPE bind() peculiarities */
     if (((struct sockaddr *)addr)->sa_family == AF_INET) {
@@ -2488,7 +2491,7 @@ PP(pp_connect)
 #ifdef HAS_SOCKET
     dSP;
     SV *addrsv = POPs;
-    char *addr;
+    const char *addr;
     GV *gv = (GV*)POPs;
     register IO *io = GvIOn(gv);
     STRLEN len;
@@ -2496,7 +2499,7 @@ PP(pp_connect)
     if (!io || !IoIFP(io))
 	goto nuts;
 
-    addr = SvPV(addrsv, len);
+    addr = SvPV_const(addrsv, len);
     TAINT_PROPER("connect");
     if (PerlSock_connect(PerlIO_fileno(IoIFP(io)), (struct sockaddr *)addr, len) >= 0)
 	RETPUSHYES;
@@ -2683,16 +2686,16 @@ PP(pp_ssockopt)
 	PUSHs(sv);
 	break;
     case OP_SSOCKOPT: {
-	    char *buf;
+	    const char *buf;
 	    int aint;
 	    if (SvPOKp(sv)) {
 		STRLEN l;
-		buf = SvPV(sv, l);
+		buf = SvPV_const(sv, l);
 		len = l;
 	    }
 	    else {
 		aint = (int)SvIV(sv);
-		buf = (char*)&aint;
+		buf = (const char*)&aint;
 		len = sizeof(int);
 	    }
 	    if (PerlSock_setsockopt(fd, lvl, optname, buf, len) < 0)
@@ -2756,8 +2759,8 @@ PP(pp_getpeername)
 	{
 	    static const char nowhere[] = "\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0";
 	    /* If the call succeeded, make sure we don't have a zeroed port/addr */
-	    if (((struct sockaddr *)SvPVX(sv))->sa_family == AF_INET &&
-		!memcmp((char *)SvPVX(sv) + sizeof(u_short), nowhere,
+	    if (((struct sockaddr *)SvPVX_const(sv))->sa_family == AF_INET &&
+		!memcmp((char *)SvPVX_const(sv) + sizeof(u_short), nowhere,
 			sizeof(u_short) + sizeof(struct in_addr))) {
 		goto nuts2;	
 	    }
@@ -2801,7 +2804,6 @@ PP(pp_stat)
     GV *gv;
     I32 gimme;
     I32 max = 13;
-    STRLEN n_a;
 
     if (PL_op->op_flags & OPf_REF) {
 	gv = cGVOP_gv;
@@ -2841,15 +2843,15 @@ PP(pp_stat)
 			"lstat() on filehandle %s", GvENAME(gv));
 	    goto do_fstat;
 	}
-	sv_setpv(PL_statname, SvPV_const(sv,n_a));
+	sv_setpv(PL_statname, SvPV_nolen_const(sv));
 	PL_statgv = Nullgv;
 	PL_laststype = PL_op->op_type;
 	if (PL_op->op_type == OP_LSTAT)
-	    PL_laststatval = PerlLIO_lstat(SvPV(PL_statname, n_a), &PL_statcache);
+	    PL_laststatval = PerlLIO_lstat(SvPV_nolen_const(PL_statname), &PL_statcache);
 	else
-	    PL_laststatval = PerlLIO_stat(SvPV(PL_statname, n_a), &PL_statcache);
+	    PL_laststatval = PerlLIO_stat(SvPV_nolen_const(PL_statname), &PL_statcache);
 	if (PL_laststatval < 0) {
-	    if (ckWARN(WARN_NEWLINE) && strchr(SvPV(PL_statname, n_a), '\n'))
+	    if (ckWARN(WARN_NEWLINE) && strchr(SvPV_nolen_const(PL_statname), '\n'))
 		Perl_warner(aTHX_ packWARN(WARN_NEWLINE), PL_warn_nl, "stat");
 	    max = 0;
 	}
@@ -2932,7 +2934,6 @@ PP(pp_ftrread)
     STACKED_FTEST_CHECK;
 #if defined(HAS_ACCESS) && defined(R_OK)
     if ((PL_op->op_private & OPpFT_ACCESS) && SvPOK(TOPs)) {
-	STRLEN n_a;
 	result = access(POPpx, R_OK);
 	if (result == 0)
 	    RETPUSHYES;
@@ -2960,7 +2961,6 @@ PP(pp_ftrwrite)
     STACKED_FTEST_CHECK;
 #if defined(HAS_ACCESS) && defined(W_OK)
     if ((PL_op->op_private & OPpFT_ACCESS) && SvPOK(TOPs)) {
-	STRLEN n_a;
 	result = access(POPpx, W_OK);
 	if (result == 0)
 	    RETPUSHYES;
@@ -2988,7 +2988,6 @@ PP(pp_ftrexec)
     STACKED_FTEST_CHECK;
 #if defined(HAS_ACCESS) && defined(X_OK)
     if ((PL_op->op_private & OPpFT_ACCESS) && SvPOK(TOPs)) {
-	STRLEN n_a;
 	result = access(POPpx, X_OK);
 	if (result == 0)
 	    RETPUSHYES;
@@ -3016,7 +3015,6 @@ PP(pp_fteread)
     STACKED_FTEST_CHECK;
 #ifdef PERL_EFF_ACCESS_R_OK
     if ((PL_op->op_private & OPpFT_ACCESS) && SvPOK(TOPs)) {
-	STRLEN n_a;
 	result = PERL_EFF_ACCESS_R_OK(POPpx);
 	if (result == 0)
 	    RETPUSHYES;
@@ -3044,7 +3042,6 @@ PP(pp_ftewrite)
     STACKED_FTEST_CHECK;
 #ifdef PERL_EFF_ACCESS_W_OK
     if ((PL_op->op_private & OPpFT_ACCESS) && SvPOK(TOPs)) {
-	STRLEN n_a;
 	result = PERL_EFF_ACCESS_W_OK(POPpx);
 	if (result == 0)
 	    RETPUSHYES;
@@ -3072,7 +3069,6 @@ PP(pp_fteexec)
     STACKED_FTEST_CHECK;
 #ifdef PERL_EFF_ACCESS_X_OK
     if ((PL_op->op_private & OPpFT_ACCESS) && SvPOK(TOPs)) {
-	STRLEN n_a;
 	result = PERL_EFF_ACCESS_X_OK(POPpx);
 	if (result == 0)
 	    RETPUSHYES;
@@ -3359,8 +3355,7 @@ PP(pp_fttty)
     if (GvIO(gv) && IoIFP(GvIOp(gv)))
 	fd = PerlIO_fileno(IoIFP(GvIOp(gv)));
     else if (tmpsv && SvOK(tmpsv)) {
-	STRLEN n_a;
-	char *tmps = SvPV(tmpsv, n_a);
+	const char *tmps = SvPV_nolen_const(tmpsv);
 	if (isDIGIT(*tmps))
 	    fd = atoi(tmps);
 	else 
@@ -3392,7 +3387,6 @@ PP(pp_fttext)
     register IO *io;
     register SV *sv;
     GV *gv;
-    STRLEN n_a;
     PerlIO *fp;
 
     STACKED_FTEST_CHECK;
@@ -3461,9 +3455,10 @@ PP(pp_fttext)
       really_filename:
 	PL_statgv = Nullgv;
 	PL_laststype = OP_STAT;
-	sv_setpv(PL_statname, SvPV(sv, n_a));
+	sv_setpv(PL_statname, SvPV_nolen_const(sv));
 	if (!(fp = PerlIO_open(SvPVX_const(PL_statname), "r"))) {
-	    if (ckWARN(WARN_NEWLINE) && strchr(SvPV(PL_statname, n_a), '\n'))
+	    if (ckWARN(WARN_NEWLINE) && strchr(SvPV_nolen_const(PL_statname),
+					       '\n'))
 		Perl_warner(aTHX_ packWARN(WARN_NEWLINE), PL_warn_nl, "open");
 	    RETPUSHUNDEF;
 	}
@@ -3549,7 +3544,6 @@ PP(pp_chdir)
     dSP; dTARGET;
     const char *tmps;
     SV **svp;
-    STRLEN n_a;
 
     if( MAXARG == 1 )
         tmps = POPpconstx;
@@ -3566,7 +3560,7 @@ PP(pp_chdir)
         {
             if( MAXARG == 1 )
                 deprecate("chdir('') or chdir(undef) as chdir()");
-            tmps = SvPV_const(*svp, n_a);
+            tmps = SvPV_nolen_const(*svp);
         }
         else {
             PUSHi(0);
@@ -3603,7 +3597,6 @@ PP(pp_chroot)
 {
 #ifdef HAS_CHROOT
     dSP; dTARGET;
-    STRLEN n_a;
     char *tmps = POPpx;
     TAINT_PROPER("chroot");
     PUSHi( chroot(tmps) >= 0 );
@@ -3647,7 +3640,6 @@ PP(pp_rename)
 {
     dSP; dTARGET;
     int anum;
-    STRLEN n_a;
     const char *tmps2 = POPpconstx;
     const char *tmps = SvPV_nolen_const(TOPs);
     TAINT_PROPER("rename");
@@ -3673,7 +3665,6 @@ PP(pp_link)
 {
 #ifdef HAS_LINK
     dSP; dTARGET;
-    STRLEN n_a;
     const char *tmps2 = POPpconstx;
     const char *tmps = SvPV_nolen_const(TOPs);
     TAINT_PROPER("link");
@@ -3688,9 +3679,8 @@ PP(pp_symlink)
 {
 #ifdef HAS_SYMLINK
     dSP; dTARGET;
-    STRLEN n_a;
-    char *tmps2 = POPpx;
-    char *tmps = SvPV(TOPs, n_a);
+    const char *tmps2 = POPpconstx;
+    const char *tmps = SvPV_nolen_const(TOPs);
     TAINT_PROPER("symlink");
     SETi( symlink(tmps, tmps2) >= 0 );
     RETURN;
@@ -3707,7 +3697,6 @@ PP(pp_readlink)
     const char *tmps;
     char buf[MAXPATHLEN];
     int len;
-    STRLEN n_a;
 
 #ifndef INCOMPLETE_TAINTS
     TAINT;
@@ -3889,7 +3878,6 @@ PP(pp_open_dir)
 {
 #if defined(Direntry_t) && defined(HAS_READDIR)
     dSP;
-    STRLEN n_a;
     const char *dirname = POPpconstx;
     GV *gv = (GV*)POPs;
     register IO *io = GvIOn(gv);
@@ -4080,7 +4068,6 @@ PP(pp_fork)
     if (childpid < 0)
 	RETSETUNDEF;
     if (!childpid) {
-	/*SUPPRESS 560*/
 	if ((tmpgv = gv_fetchpv("$", TRUE, SVt_PV))) {
             SvREADONLY_off(GvSV(tmpgv));
 	    sv_setiv(GvSV(tmpgv), (IV)PerlProc_getpid());
@@ -4175,7 +4162,6 @@ PP(pp_system)
 {
     dSP; dMARK; dORIGMARK; dTARGET;
     I32 value;
-    STRLEN n_a;
     int result;
 
     if (PL_tainting) {
@@ -4266,7 +4252,7 @@ PP(pp_system)
 	else if (SP - MARK != 1)
 	    value = (I32)do_aexec5(Nullsv, MARK, SP, pp[1], did_pipes);
 	else {
-	    value = (I32)do_exec3(SvPVx(sv_mortalcopy(*SP), n_a), pp[1], did_pipes);
+	    value = (I32)do_exec3(SvPVx_nolen(sv_mortalcopy(*SP)), pp[1], did_pipes);
 	}
 	PerlProc__exit(-1);
     }
@@ -4289,7 +4275,7 @@ PP(pp_system)
 #  endif
     }
     else {
-	value = (I32)do_spawn(SvPVx(sv_mortalcopy(*SP), n_a));
+	value = (I32)do_spawn(SvPVx_nolen(sv_mortalcopy(*SP)));
     }
     if (PL_statusvalue == -1)	/* hint that value must be returned as is */
 	result = 1;
@@ -4305,7 +4291,6 @@ PP(pp_exec)
 {
     dSP; dMARK; dORIGMARK; dTARGET;
     I32 value;
-    STRLEN n_a;
 
     if (PL_tainting) {
 	TAINT_ENV();
@@ -4337,13 +4322,13 @@ PP(pp_exec)
 #endif
     else {
 #ifdef VMS
-	value = (I32)vms_do_exec(SvPVx(sv_mortalcopy(*SP), n_a));
+	value = (I32)vms_do_exec(SvPVx_nolen(sv_mortalcopy(*SP)));
 #else
 #  ifdef __OPEN_VM
-	(void) do_spawn(SvPVx(sv_mortalcopy(*SP), n_a));
+	(void) do_spawn(SvPVx_nolen(sv_mortalcopy(*SP)));
 	value = 0;
 #  else
-	value = (I32)do_exec(SvPVx(sv_mortalcopy(*SP), n_a));
+	value = (I32)do_exec(SvPVx_nolen(sv_mortalcopy(*SP)));
 #  endif
 #endif
     }
@@ -4770,7 +4755,6 @@ PP(pp_ghostent)
 #endif
     struct hostent *hent;
     unsigned long len;
-    STRLEN n_a;
 
     EXTEND(SP, 10);
     if (which == OP_GHBYNAME) {
@@ -4886,7 +4870,6 @@ PP(pp_gnetent)
     struct netent *getnetent(void);
 #endif
     struct netent *nent;
-    STRLEN n_a;
 
     if (which == OP_GNBYNAME){
 #ifdef HAS_GETNETBYNAME
@@ -4987,7 +4970,6 @@ PP(pp_gprotoent)
     struct protoent *getprotoent(void);
 #endif
     struct protoent *pent;
-    STRLEN n_a;
 
     if (which == OP_GPBYNAME) {
 #ifdef HAS_GETPROTOBYNAME
@@ -5074,7 +5056,6 @@ PP(pp_gservent)
     struct servent *getservent(void);
 #endif
     struct servent *sent;
-    STRLEN n_a;
 
     if (which == OP_GSBYNAME) {
 #ifdef HAS_GETSERVBYNAME
@@ -5270,7 +5251,6 @@ PP(pp_gpwent)
     dSP;
     I32 which = PL_op->op_type;
     register SV *sv;
-    STRLEN n_a;
     struct passwd *pwent  = NULL;
     /*
      * We currently support only the SysV getsp* shadow password interface.
@@ -5549,7 +5529,6 @@ PP(pp_ggrent)
     register char **elem;
     register SV *sv;
     struct group *grent;
-    STRLEN n_a;
 
     if (which == OP_GGRNAM) {
         char* name = POPpbytex;
@@ -5661,7 +5640,6 @@ PP(pp_syscall)
     unsigned long a[20];
     register I32 i = 0;
     I32 retval = -1;
-    STRLEN n_a;
 
     if (PL_tainting) {
 	while (++MARK <= SP) {
@@ -5684,7 +5662,7 @@ PP(pp_syscall)
 	else if (*MARK == &PL_sv_undef)
 	    a[i++] = 0;
 	else
-	    a[i++] = (unsigned long)SvPV_force(*MARK, n_a);
+	    a[i++] = (unsigned long)SvPV_force_nolen(*MARK);
 	if (i > 15)
 	    break;
     }