diff --git a/MANIFEST b/MANIFEST index e5acc7d23bcbe..b8d0e47986335 100644 --- a/MANIFEST +++ b/MANIFEST @@ -5972,6 +5972,7 @@ t/bigmem/stack_over.t Check handling of stack overflows with 32-bit MARK on 64 t/bigmem/str.t Test string primitives with large strings t/bigmem/subst.t Test s/// with large strings t/bigmem/subst2.t Test s//EXPR/e with large strings +t/bigmem/sv_gets.t Test reading a lot with sv_gets() t/bigmem/vec.t Check vec() handles large offsets t/charset_tools.pl To aid in portable testing across platforms with different character sets t/class/accessor.t See if accessor methods work diff --git a/embed.fnc b/embed.fnc index 391f4f8a8fd2a..7d38ad278b4de 100644 --- a/embed.fnc +++ b/embed.fnc @@ -3175,7 +3175,7 @@ ATdpx |SV * |sv_get_backrefs|NN SV * const sv Adip |void |SvGETMAGIC |NN SV *sv Adp |char * |sv_gets |NN SV * const sv \ |NN PerlIO * const fp \ - |I32 append + |SSize_t append Cdp |char * |sv_grow |NN SV * const sv \ |STRLEN newlen Cdp |char * |sv_grow_fresh |NN SV * const sv \ diff --git a/proto.h b/proto.h index e23b66e5f0eff..cf879162e7914 100644 --- a/proto.h +++ b/proto.h @@ -4557,7 +4557,7 @@ Perl_sv_get_backrefs(SV * const sv); assert(sv) PERL_CALLCONV char * -Perl_sv_gets(pTHX_ SV * const sv, PerlIO * const fp, I32 append); +Perl_sv_gets(pTHX_ SV * const sv, PerlIO * const fp, SSize_t append); #define PERL_ARGS_ASSERT_SV_GETS \ assert(sv); assert(fp) diff --git a/sv.c b/sv.c index 85c3f47339a1b..b49e4e427d35a 100644 --- a/sv.c +++ b/sv.c @@ -8679,7 +8679,7 @@ Perl_sv_collxfrm_flags(pTHX_ SV *const sv, STRLEN *const nxp, const I32 flags) #endif /* USE_LOCALE_COLLATE */ static char * -S_sv_gets_append_to_utf8(pTHX_ SV *const sv, PerlIO *const fp, I32 append) +S_sv_gets_append_to_utf8(pTHX_ SV *const sv, PerlIO *const fp, SSize_t append) { SV * const tsv = newSV_type(SVt_NULL); ENTER; @@ -8693,7 +8693,7 @@ S_sv_gets_append_to_utf8(pTHX_ SV *const sv, PerlIO *const fp, I32 append) } static char * -S_sv_gets_read_record(pTHX_ SV *const sv, PerlIO *const fp, I32 append) +S_sv_gets_read_record(pTHX_ SV *const sv, PerlIO *const fp, SSize_t append) { SSize_t bytesread; const STRLEN recsize = SvUV(SvRV(PL_rs)); /* RsRECORD() guarantees > 0. */ @@ -8821,7 +8821,7 @@ in the SV (typically, C is a suitable choice). */ char * -Perl_sv_gets(pTHX_ SV *const sv, PerlIO *const fp, I32 append) +Perl_sv_gets(pTHX_ SV *const sv, PerlIO *const fp, SSize_t append) { const char *rsptr; STRLEN rslen; @@ -8847,7 +8847,8 @@ Perl_sv_gets(pTHX_ SV *const sv, PerlIO *const fp, I32 append) if (PerlIO_isutf8(fp)) { if (!SvUTF8(sv)) { sv_utf8_upgrade_nomg(sv); - sv_pos_u2b(sv,&append,0); + append = (SSize_t)sv_pos_u2b_flags(sv, (STRLEN)append, NULL, + SV_GMAGIC|SV_CONST_RETURN); } } else if (SvUTF8(sv)) { return S_sv_gets_append_to_utf8(aTHX_ sv, fp, append); @@ -8961,11 +8962,11 @@ Perl_sv_gets(pTHX_ SV *const sv, PerlIO *const fp, I32 append) STDCHAR *ptr; /* pointer into fp's read-ahead buffer */ STRLEN bpx; /* length of the data in the target sv used to fix pointers after a SvGROW */ - I32 shortbuffered; /* If the pv buffer is shorter than the amount - of data left in the read-ahead buffer. - If 0 then the pv buffer can hold the full - amount left, otherwise this is the amount it - can hold. */ + SSize_t shortbuffered;/* If the pv buffer is shorter than the amount + of data left in the read-ahead buffer. + If 0 then the pv buffer can hold the full + amount left, otherwise this is the amount it + can hold. */ /* Here is some breathtakingly efficient cheating */ @@ -9028,11 +9029,11 @@ Perl_sv_gets(pTHX_ SV *const sv, PerlIO *const fp, I32 append) cnt = PerlIO_get_cnt(fp); /* make sure we have the room */ - if ((I32)(SvLEN(sv) - append) <= cnt + 1) { + if ((SSize_t)(SvLEN(sv) - append) <= cnt + 1) { /* Not room for all of it if we are looking for a separator and room for some */ - if (rslen && cnt > 80 && (I32)SvLEN(sv) > append) { + if (rslen && cnt > 80 && SvLEN(sv) > (STRLEN)append) { /* just process what we have room for */ shortbuffered = cnt - SvLEN(sv) + append + 1; cnt -= shortbuffered; diff --git a/t/bigmem/sv_gets.t b/t/bigmem/sv_gets.t new file mode 100644 index 0000000000000..be7f1f7ab9bd3 --- /dev/null +++ b/t/bigmem/sv_gets.t @@ -0,0 +1,21 @@ +#!perl +BEGIN { + chdir 't' if -d 't'; + @INC = "../lib"; +} + +use strict; +require './test.pl'; +use Config qw(%Config); + +# 2 for the child, 2 for the parent +$ENV{PERL_TEST_MEMORY} >= 4 + or skip_all("Need ~4Gb for this test"); +$Config{ptrsize} >= 8 + or skip_all("Need 64-bit pointers for this test"); + +# https://www.perlmonks.org/?node_id=11161665 +my $x = `$^X -e "print q/x/ x 0x80000000"`; +is(length $x, 0x80000000, "check entire input read"); + +done_testing();