summaryrefslogtreecommitdiff
path: root/pp_sys.c
diff options
context:
space:
mode:
authorTony Cook <tony@develop-help.com>2018-09-25 11:18:40 +1000
committerTony Cook <tony@develop-help.com>2018-10-10 11:12:13 +1100
commit1ed4b7762a858fb9c71bc209fe868060f3774cb5 (patch)
treed7fd59a4d3f823d2d46530e79be9da4dff4f2b64 /pp_sys.c
parent03b94aa47e981af3c7b0118bfb11facda2b95251 (diff)
downloadperl-1ed4b7762a858fb9c71bc209fe868060f3774cb5.tar.gz
(perl #125760) fatalize sysread/syswrite/recv/send on :utf8 handles
This includes removing the :utf8 logic from pp_syswrite. pp_sysread retains it, since it's also used for read(). Tests that are specifically testing the behaviour against :utf8 handles have been removed (eg in lib/open.t), several other tests that incidentally used those functions on :utf8 handles have been adapted to use :raw handles instead (eg. op/readline.t). Test lib/sigtrap.t fails if STDERR is :utf8, in code from the original 5.000 commit, which is intended to run in a signal handler
Diffstat (limited to 'pp_sys.c')
-rw-r--r--pp_sys.c80
1 files changed, 14 insertions, 66 deletions
diff --git a/pp_sys.c b/pp_sys.c
index 4ae475d460..00faa7711f 100644
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -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