In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/9efda33a86bb90e4838144d230a4fc3ae4d63d7d?hp=8a6d8ec6fe627c401c6c759edd38bbb10e4b56e9>
- Log ----------------------------------------------------------------- commit 9efda33a86bb90e4838144d230a4fc3ae4d63d7d Author: Tony Cook <[email protected]> Date: Tue Feb 10 10:19:56 2015 +1100 [perl #123554] catch a couple of other size overflows Unfortunately, running out of memory in safesysmalloc() and safesysrealloc() doesn't produce a catchable croak(), so remove the test. ----------------------------------------------------------------------- Summary of changes: sv.c | 4 +++- t/op/repeat.t | 5 +---- util.c | 15 +++++++++------ 3 files changed, 13 insertions(+), 11 deletions(-) diff --git a/sv.c b/sv.c index adc2fc3..50cab47 100644 --- a/sv.c +++ b/sv.c @@ -1616,7 +1616,9 @@ Perl_sv_grow(pTHX_ SV *const sv, STRLEN newlen) /* Don't round up on the first allocation, as odds are pretty good that * the initial request is accurate as to what is really needed */ if (SvLEN(sv)) { - newlen = PERL_STRLEN_ROUNDUP(newlen); + STRLEN rounded = PERL_STRLEN_ROUNDUP(newlen); + if (rounded > newlen) + newlen = rounded; } #endif if (SvLEN(sv) && s) { diff --git a/t/op/repeat.t b/t/op/repeat.t index b6dcc7a..8df5241 100644 --- a/t/op/repeat.t +++ b/t/op/repeat.t @@ -6,7 +6,7 @@ BEGIN { } require './test.pl'; -plan(tests => 48); +plan(tests => 47); # compile time @@ -173,6 +173,3 @@ for(($#that_array)x2) { $_ *= 2; } is($#that_array, 28, 'list repetition propagates lvalue cx to its lhs'); - -# see [perl #123554] -ok(!eval '33x~3', "eval 33x~3 should panic, not crash perl"); diff --git a/util.c b/util.c index 08f6abc..c92ed2e 100644 --- a/util.c +++ b/util.c @@ -128,7 +128,12 @@ Perl_safesysmalloc(MEM_SIZE size) dTHX; #endif Malloc_t ptr; + +#ifdef USE_MDH + if (size + PERL_MEMORY_DEBUG_HEADER_SIZE < size) + goto out_of_memory; size += PERL_MEMORY_DEBUG_HEADER_SIZE; +#endif #ifdef DEBUGGING if ((SSize_t)size < 0) Perl_croak_nocontext("panic: malloc, size=%"UVuf, (UV) size); @@ -175,9 +180,7 @@ Perl_safesysmalloc(MEM_SIZE size) } else { -#ifndef ALWAYS_NEED_THX - dTHX; -#endif + out_of_memory: if (PL_nomemok) ptr = NULL; else @@ -214,6 +217,8 @@ Perl_safesysrealloc(Malloc_t where,MEM_SIZE size) else { #ifdef USE_MDH where = (Malloc_t)((char*)where-PERL_MEMORY_DEBUG_HEADER_SIZE); + if (size + PERL_MEMORY_DEBUG_HEADER_SIZE < size) + goto out_of_memory; size += PERL_MEMORY_DEBUG_HEADER_SIZE; { struct perl_memory_debug_header *const header @@ -292,9 +297,7 @@ Perl_safesysrealloc(Malloc_t where,MEM_SIZE size) DEBUG_m(PerlIO_printf(Perl_debug_log, "0x%"UVxf": (%05ld) realloc %ld bytes\n",PTR2UV(ptr),(long)PL_an++,(long)size)); if (ptr == NULL) { -#ifndef ALWAYS_NEED_THX - dTHX; -#endif + out_of_memory: if (PL_nomemok) ptr = NULL; else -- Perl5 Master Repository
