X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/2cdf406af42834c46ef407517daab0734f7066fc..8dbb2d9565f118c5bb1b0fdd1438830bb0f0022b:/pp_sys.c?ds=sidebyside

diff --git a/pp_sys.c b/pp_sys.c
index 0c9147b..e28e890 100644
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -213,8 +213,8 @@ void endservent(void);
 #endif
 
 #if !defined(PERL_EFF_ACCESS) && defined(HAS_ACCESSX) && defined(ACC_SELF)
-    /* AIX */
-#   define PERL_EFF_ACCESS(p,f) (accessx((p), (f), ACC_SELF))
+    /* AIX's accessx() doesn't declare its argument const, unlike every other platform */
+#   define PERL_EFF_ACCESS(p,f) (accessx((char*)(p), (f), ACC_SELF))
 #endif
 
 
@@ -417,7 +417,7 @@ PP(pp_warn)
     }
     else if (SP == MARK) {
 	exsv = &PL_sv_no;
-	EXTEND(SP, 1);
+	MEXTEND(SP, 1);
 	SP = MARK + 1;
     }
     else {
@@ -1725,10 +1725,9 @@ PP(pp_sysread)
 
     if ((fp_utf8 = PerlIO_isutf8(IoIFP(io))) && !IN_BYTES) {
         if (PL_op->op_type == OP_SYSREAD || PL_op->op_type == OP_RECV) {
-            Perl_ck_warner_d(aTHX_ packWARN(WARN_DEPRECATED),
-                             "%s() is deprecated on :utf8 handles. "
-                             "This will be a fatal error in Perl 5.30",
-                             OP_DESC(PL_op));
+            Perl_croak(aTHX_
+                       "%s() isn't allowed on :utf8 handles",
+                       OP_DESC(PL_op));
         }
 	buffer = SvPVutf8_force(bufsv, blen);
 	/* UTF-8 may not have been set if they are all low bytes */
@@ -1939,7 +1938,6 @@ PP(pp_syswrite)
     const char *buffer;
     SSize_t retval;
     STRLEN blen;
-    STRLEN orig_blen_bytes;
     const int op_type = PL_op->op_type;
     bool doing_utf8;
     U8 *tmpbuf = NULL;
@@ -1985,20 +1983,12 @@ PP(pp_syswrite)
 
     /* Do this first to trigger any overloading.  */
     buffer = SvPV_const(bufsv, blen);
-    orig_blen_bytes = blen;
     doing_utf8 = DO_UTF8(bufsv);
 
     if (PerlIO_isutf8(IoIFP(io))) {
-        Perl_ck_warner_d(aTHX_ packWARN(WARN_DEPRECATED),
-                         "%s() is deprecated on :utf8 handles. "
-                         "This will be a fatal error in Perl 5.30",
-                         OP_DESC(PL_op));
-	if (!SvUTF8(bufsv)) {
-	    /* We don't modify the original scalar.  */
-	    tmpbuf = bytes_to_utf8((const U8*) buffer, &blen);
-	    buffer = (char *) tmpbuf;
-	    doing_utf8 = TRUE;
-	}
+        Perl_croak(aTHX_
+                   "%s() isn't allowed on :utf8 handles",
+                   OP_DESC(PL_op));
     }
     else if (doing_utf8) {
 	STRLEN tmplen = blen;
@@ -2031,25 +2021,10 @@ PP(pp_syswrite)
 #endif
     {
 	Size_t length = 0; /* This length is in characters.  */
-	STRLEN blen_chars;
 	IV offset;
 
-	if (doing_utf8) {
-	    if (tmpbuf) {
-		/* The SV is bytes, and we've had to upgrade it.  */
-		blen_chars = orig_blen_bytes;
-	    } else {
-		/* The SV really is UTF-8.  */
-		/* Don't call sv_len_utf8 on a magical or overloaded
-		   scalar, as we might get back a different result.  */
-		blen_chars = sv_or_pv_len_utf8(bufsv, buffer, blen);
-	    }
-	} else {
-	    blen_chars = blen;
-	}
-
 	if (MARK >= SP) {
-	    length = blen_chars;
+	    length = blen;
 	} else {
 #if Size_t_size > IVSIZE
 	    length = (Size_t)SvNVx(*++MARK);
@@ -2065,46 +2040,21 @@ PP(pp_syswrite)
 	if (MARK < SP) {
 	    offset = SvIVx(*++MARK);
 	    if (offset < 0) {
-		if (-offset > (IV)blen_chars) {
+		if (-offset > (IV)blen) {
 		    Safefree(tmpbuf);
 		    DIE(aTHX_ "Offset outside string");
 		}
-		offset += blen_chars;
-	    } else if (offset > (IV)blen_chars) {
+		offset += blen;
+	    } else if (offset > (IV)blen) {
 		Safefree(tmpbuf);
 		DIE(aTHX_ "Offset outside string");
 	    }
 	} else
 	    offset = 0;
-	if (length > blen_chars - offset)
-	    length = blen_chars - offset;
-	if (doing_utf8) {
-	    /* Here we convert length from characters to bytes.  */
-	    if (tmpbuf || SvGMAGICAL(bufsv) || SvAMAGIC(bufsv)) {
-		/* Either we had to convert the SV, or the SV is magical, or
-		   the SV has overloading, in which case we can't or mustn't
-		   or mustn't call it again.  */
-
-		buffer = (const char*)utf8_hop((const U8 *)buffer, offset);
-		length = utf8_hop((U8 *)buffer, length) - (U8 *)buffer;
-	    } else {
-		/* It's a real UTF-8 SV, and it's not going to change under
-		   us.  Take advantage of any cache.  */
-		I32 start = offset;
-		I32 len_I32 = length;
-
-		/* Convert the start and end character positions to bytes.
-		   Remember that the second argument to sv_pos_u2b is relative
-		   to the first.  */
-		sv_pos_u2b(bufsv, &start, &len_I32);
-
-		buffer += start;
-		length = len_I32;
-	    }
-	}
-	else {
-	    buffer = buffer+offset;
-	}
+	if (length > blen - offset)
+	    length = blen - offset;
+        buffer = buffer+offset;
+
 #ifdef PERL_SOCK_SYSWRITE_IS_SEND
 	if (IoTYPE(io) == IoTYPE_SOCKET) {
 	    retval = PerlSock_send(fd, buffer, length, 0);
@@ -2120,8 +2070,6 @@ PP(pp_syswrite)
     if (retval < 0)
 	goto say_undef;
     SP = ORIGMARK;
-    if (doing_utf8)
-        retval = utf8_length((U8*)buffer, (U8*)buffer + retval);
 
     Safefree(tmpbuf);
 #if Size_t_size > IVSIZE
@@ -2173,7 +2121,7 @@ PP(pp_eof)
     }
 
     if (!gv)
-	RETPUSHNO;
+	RETPUSHYES;
 
     if ((io = GvIO(gv)) && (mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar))) {
 	return tied_method1(SV_CONST(EOF), SP, MUTABLE_SV(io), mg, newSVuv(which));
@@ -3876,8 +3824,7 @@ PP(pp_readlink)
     len = readlink(tmps, buf, sizeof(buf) - 1);
     if (len < 0)
 	RETPUSHUNDEF;
-    if (len != -1)
-        buf[len] = '\0';
+    buf[len] = '\0';
     PUSHp(buf, len);
     RETURN;
 #else
@@ -4375,7 +4322,7 @@ PP(pp_system)
 	STRLEN len;
 	char *pv;
 	SvGETMAGIC(origsv);
-#ifdef WIN32
+#if defined(WIN32) || defined(__VMS)
 	/*
 	 * Because of a nasty platform-specific variation on the meaning
 	 * of arguments to this op, we must preserve numeric arguments