In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/7cd83f6573da7fd1101fc83cb13867d52fea3d41?hp=5eabab158821032728b40b21aab4353b1213e250>
- Log ----------------------------------------------------------------- commit 7cd83f6573da7fd1101fc83cb13867d52fea3d41 Author: Craig A. Berry <[email protected]> Date: Sun Sep 2 21:30:55 2012 -0500 Out of memory message should not allocate memory. This fixes [perl #40595]. When Perl_malloc reports an out of memory error, it should not make calls to PerlIO functions that may turn around and allocate memory using Perl_malloc. A simple write() should be ok, though. Inspired by S_write_no_mem() from util.c. Also replaces the local write2 function, which did the same thing slightly differently. Under -DDEBUGGING, there are other calls to PerlIO_printf that are also likely unsafe, but that problem is not addressed here. ----------------------------------------------------------------------- Summary of changes: malloc.c | 43 ++++++++++++++++++++----------------------- 1 files changed, 20 insertions(+), 23 deletions(-) diff --git a/malloc.c b/malloc.c index f658489..1d22923 100644 --- a/malloc.c +++ b/malloc.c @@ -1091,11 +1091,8 @@ emergency_sbrk(MEM_SIZE size) # define emergency_sbrk(size) -1 #endif /* defined PERL_EMERGENCY_SBRK */ -static void -write2(const char *mess) -{ - write(2, mess, strlen(mess)); -} +/* Don't use PerlIO buffered writes as they allocate memory. */ +#define MYMALLOC_WRITE2STDERR(s) PerlLIO_write(PerlIO_fileno(PerlIO_stderr()),s,strlen(s)) #ifdef DEBUGGING #undef ASSERT @@ -1113,13 +1110,13 @@ botch(const char *diag, const char *s, const char *file, int line) "assertion botched (%s?): %s %s:%d\n", diag, s, file, line) != 0) { do_write: /* Can be initializing interpreter */ - write2("assertion botched ("); - write2(diag); - write2("?): "); - write2(s); - write2(" ("); - write2(file); - write2(":"); + MYMALLOC_WRITE2STDERR("assertion botched ("); + MYMALLOC_WRITE2STDERR(diag); + MYMALLOC_WRITE2STDERR("?): "); + MYMALLOC_WRITE2STDERR(s); + MYMALLOC_WRITE2STDERR(" ("); + MYMALLOC_WRITE2STDERR(file); + MYMALLOC_WRITE2STDERR(":"); { char linebuf[10]; char *s = linebuf + sizeof(linebuf) - 1; @@ -1128,9 +1125,9 @@ botch(const char *diag, const char *s, const char *file, int line) do { *--s = '0' + (n % 10); } while (n /= 10); - write2(s); + MYMALLOC_WRITE2STDERR(s); } - write2(")\n"); + MYMALLOC_WRITE2STDERR(")\n"); } PerlProc_abort(); } @@ -1290,14 +1287,14 @@ Perl_malloc(size_t nbytes) dTHX; if (!PL_nomemok) { #if defined(PLAIN_MALLOC) && defined(NO_FANCY_MALLOC) - PerlIO_puts(PerlIO_stderr(),"Out of memory!\n"); + MYMALLOC_WRITE2STDERR("Out of memory!\n"); #else char buff[80]; char *eb = buff + sizeof(buff) - 1; char *s = eb; size_t n = nbytes; - PerlIO_puts(PerlIO_stderr(),"Out of memory during request for "); + MYMALLOC_WRITE2STDERR("Out of memory during request for "); #if defined(DEBUGGING) || defined(RCHECK) n = size; #endif @@ -1305,15 +1302,15 @@ Perl_malloc(size_t nbytes) do { *--s = '0' + (n % 10); } while (n /= 10); - PerlIO_puts(PerlIO_stderr(),s); - PerlIO_puts(PerlIO_stderr()," bytes, total sbrk() is "); + MYMALLOC_WRITE2STDERR(s); + MYMALLOC_WRITE2STDERR(" bytes, total sbrk() is "); s = eb; n = goodsbrk + sbrk_slack; do { *--s = '0' + (n % 10); } while (n /= 10); - PerlIO_puts(PerlIO_stderr(),s); - PerlIO_puts(PerlIO_stderr()," bytes!\n"); + MYMALLOC_WRITE2STDERR(s); + MYMALLOC_WRITE2STDERR(" bytes!\n"); #endif /* defined(PLAIN_MALLOC) && defined(NO_FANCY_MALLOC) */ my_exit(1); } @@ -1714,9 +1711,9 @@ morecore(register int bucket) } } if (t && *t) { - write2("Unrecognized part of PERL_MALLOC_OPT: \""); - write2(t); - write2("\"\n"); + MYMALLOC_WRITE2STDERR("Unrecognized part of PERL_MALLOC_OPT: \""); + MYMALLOC_WRITE2STDERR(t); + MYMALLOC_WRITE2STDERR("\"\n"); } if (changed) MallocCfg[MallocCfg_cfg_env_read] = 1; -- Perl5 Master Repository
