X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=util.c;h=67ed3939515a2e99a1d0000c6ae179764faa14b3;hb=0bcc34c2b0b0cb62c0df3d5e562b779fb96595ba;hp=4b115d28c8eda285d02a7a73d31f1dc490ab2efd;hpb=42d9b98d3f03094883cfc4bb765785a6d4396077;p=p5sagit%2Fp5-mst-13.2.git diff --git a/util.c b/util.c index 4b115d2..67ed393 100644 --- a/util.c +++ b/util.c @@ -57,6 +57,16 @@ int putenv(char *); * XXX This advice seems to be widely ignored :-( --AD August 1996. */ +static char * +S_write_no_mem(pTHX) +{ + /* Can't use PerlIO to write as it allocates memory */ + PerlLIO_write(PerlIO_fileno(Perl_error_log), + PL_no_mem, strlen(PL_no_mem)); + my_exit(1); + return Nullch; +} + /* paranoid version of system's malloc() */ Malloc_t @@ -83,11 +93,7 @@ Perl_safesysmalloc(MEM_SIZE size) else if (PL_nomemok) return Nullch; else { - /* Can't use PerlIO to write as it allocates memory */ - PerlLIO_write(PerlIO_fileno(Perl_error_log), - PL_no_mem, strlen(PL_no_mem)); - my_exit(1); - return Nullch; + return S_write_no_mem(aTHX); } /*NOTREACHED*/ } @@ -132,11 +138,7 @@ Perl_safesysrealloc(Malloc_t where,MEM_SIZE size) else if (PL_nomemok) return Nullch; else { - /* Can't use PerlIO to write as it allocates memory */ - PerlLIO_write(PerlIO_fileno(Perl_error_log), - PL_no_mem, strlen(PL_no_mem)); - my_exit(1); - return Nullch; + return S_write_no_mem(aTHX); } /*NOTREACHED*/ } @@ -186,11 +188,7 @@ Perl_safesyscalloc(MEM_SIZE count, MEM_SIZE size) else if (PL_nomemok) return Nullch; else { - /* Can't use PerlIO to write as it allocates memory */ - PerlLIO_write(PerlIO_fileno(Perl_error_log), - PL_no_mem, strlen(PL_no_mem)); - my_exit(1); - return Nullch; + return S_write_no_mem(aTHX); } /*NOTREACHED*/ } @@ -819,9 +817,7 @@ Perl_savesharedpv(pTHX_ const char *pv) pvlen = strlen(pv)+1; newaddr = (char*)PerlMemShared_malloc(pvlen); if (!newaddr) { - PerlLIO_write(PerlIO_fileno(Perl_error_log), - PL_no_mem, strlen(PL_no_mem)); - my_exit(1); + return S_write_no_mem(aTHX); } return memcpy(newaddr,pv,pvlen); } @@ -2658,7 +2654,7 @@ Perl_wait4pid(pTHX_ Pid_t pid, int *statusp, int flags) if ((entry = hv_iternext(PL_pidstatus))) { SV * const sv = hv_iterval(PL_pidstatus,entry); I32 len; - const char *spid = hv_iterkey(entry,&len); + const char * const spid = hv_iterkey(entry,&len); assert (len == sizeof(Pid_t)); memcpy((char *)&pid, spid, len); @@ -2840,7 +2836,7 @@ Perl_find_script(pTHX_ const char *scriptname, bool dosearch, #endif /* additional extensions to try in each dir if scriptname not found */ #ifdef SEARCH_EXTS - const char *const exts[] = { SEARCH_EXTS }; + static const char *const exts[] = { SEARCH_EXTS }; const char *const *const ext = search_ext ? search_ext : exts; int extidx = 0, i = 0; const char *curext = Nullch;