From: H.Merijn Brand Date: Mon, 23 Sep 2002 18:33:12 +0000 (+0200) Subject: LEAKTEST is dead, RIP X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=7bab3ede7bf671f54f0d8f3d55d015d9c9882812;p=p5sagit%2Fp5-mst-13.2.git LEAKTEST is dead, RIP Subject: Re: [perl #17197] SIGSEGV in perl 5.8.0 multithread build with -DLEAKTEST From: "H.Merijn Brand" Message-Id: <20020923182824.C7B6.H.M.BRAND@hccnet.nl> p4raw-id: //depot/perl@17920 --- diff --git a/av.c b/av.c index a1d62fb..acc9963 100644 --- a/av.c +++ b/av.c @@ -105,7 +105,7 @@ Perl_av_extend(pTHX_ AV *av, I32 key) IV itmp; #endif -#if defined(MYMALLOC) && !defined(LEAKTEST) +#ifdef MYMALLOC newmax = malloced_size((void*)AvALLOC(av))/sizeof(SV*) - 1; if (key <= newmax) @@ -134,7 +134,7 @@ Perl_av_extend(pTHX_ AV *av, I32 key) Safefree(AvALLOC(av)); AvALLOC(av) = ary; #endif -#if defined(MYMALLOC) && !defined(LEAKTEST) +#ifdef MYMALLOC resized: #endif ary = AvALLOC(av) + AvMAX(av) + 1; diff --git a/embed.fnc b/embed.fnc index 74cc71b..f99be78 100644 --- a/embed.fnc +++ b/embed.fnc @@ -857,12 +857,6 @@ Anp |Malloc_t|safesysmalloc |MEM_SIZE nbytes Anp |Malloc_t|safesyscalloc |MEM_SIZE elements|MEM_SIZE size Anp |Malloc_t|safesysrealloc|Malloc_t where|MEM_SIZE nbytes Anp |Free_t |safesysfree |Malloc_t where -#if defined(LEAKTEST) -Anp |Malloc_t|safexmalloc |I32 x|MEM_SIZE size -Anp |Malloc_t|safexcalloc |I32 x|MEM_SIZE elements|MEM_SIZE size -Anp |Malloc_t|safexrealloc |Malloc_t where|MEM_SIZE size -Anp |void |safexfree |Malloc_t where -#endif #if defined(PERL_GLOBAL_STRUCT) Ap |struct perl_vars *|GetVars #endif @@ -1314,9 +1308,6 @@ s |char* |stdize_locale |char* locs #if defined(PERL_IN_UTIL_C) || defined(PERL_DECL_PROT) s |COP* |closest_cop |COP *cop|OP *o s |SV* |mess_alloc -# if defined(LEAKTEST) -s |void |xstat |int -# endif #endif START_EXTERN_C diff --git a/embed.h b/embed.h index 1bf26e4..f23f370 100644 --- a/embed.h +++ b/embed.h @@ -775,12 +775,6 @@ #define safesyscalloc Perl_safesyscalloc #define safesysrealloc Perl_safesysrealloc #define safesysfree Perl_safesysfree -#if defined(LEAKTEST) -#define safexmalloc Perl_safexmalloc -#define safexcalloc Perl_safexcalloc -#define safexrealloc Perl_safexrealloc -#define safexfree Perl_safexfree -#endif #if defined(PERL_GLOBAL_STRUCT) #define GetVars Perl_GetVars #endif @@ -1182,9 +1176,6 @@ #if defined(PERL_IN_UTIL_C) || defined(PERL_DECL_PROT) #define closest_cop S_closest_cop #define mess_alloc S_mess_alloc -# if defined(LEAKTEST) -#define xstat S_xstat -# endif #endif #define sv_setsv_flags Perl_sv_setsv_flags #define sv_catpvn_flags Perl_sv_catpvn_flags @@ -2343,12 +2334,6 @@ #define safesyscalloc Perl_safesyscalloc #define safesysrealloc Perl_safesysrealloc #define safesysfree Perl_safesysfree -#if defined(LEAKTEST) -#define safexmalloc Perl_safexmalloc -#define safexcalloc Perl_safexcalloc -#define safexrealloc Perl_safexrealloc -#define safexfree Perl_safexfree -#endif #if defined(PERL_GLOBAL_STRUCT) #define GetVars() Perl_GetVars(aTHX) #endif @@ -2745,9 +2730,6 @@ #if defined(PERL_IN_UTIL_C) || defined(PERL_DECL_PROT) #define closest_cop(a,b) S_closest_cop(aTHX_ a,b) #define mess_alloc() S_mess_alloc(aTHX) -# if defined(LEAKTEST) -#define xstat(a) S_xstat(aTHX_ a) -# endif #endif #define sv_setsv_flags(a,b,c) Perl_sv_setsv_flags(aTHX_ a,b,c) #define sv_catpvn_flags(a,b,c,d) Perl_sv_catpvn_flags(aTHX_ a,b,c,d) diff --git a/ext/GDBM_File/GDBM_File.xs b/ext/GDBM_File/GDBM_File.xs index 22350fd..34acd79 100644 --- a/ext/GDBM_File/GDBM_File.xs +++ b/ext/GDBM_File/GDBM_File.xs @@ -39,7 +39,7 @@ not_here(char *s) static void output_datum(pTHX_ SV *arg, char *str, int size) { -#if (!defined(MYMALLOC) || (defined(MYMALLOC) && defined(PERL_POLLUTE_MALLOC))) && !defined(LEAKTEST) +#if (!defined(MYMALLOC) || (defined(MYMALLOC) && defined(PERL_POLLUTE_MALLOC))) sv_usepvn(arg, str, size); #else sv_setpvn(arg, str, size); diff --git a/global.sym b/global.sym index 5f4ae54..5651534 100644 --- a/global.sym +++ b/global.sym @@ -536,10 +536,6 @@ Perl_safesysmalloc Perl_safesyscalloc Perl_safesysrealloc Perl_safesysfree -Perl_safexmalloc -Perl_safexcalloc -Perl_safexrealloc -Perl_safexfree Perl_GetVars Perl_runops_standard Perl_runops_debug diff --git a/handy.h b/handy.h index fe29019..c16ba47 100644 --- a/handy.h +++ b/handy.h @@ -516,18 +516,6 @@ typedef U16 line_t; /* - XXX LEAKTEST doesn't really work in perl5. There are direct calls to - safemalloc() in the source, so LEAKTEST won't pick them up. - (The main "offenders" are extensions.) - Further, if you try LEAKTEST, you'll also end up calling - Safefree, which might call safexfree() on some things that weren't - malloced with safexmalloc. The correct "fix" to this, if anyone - is interested, is to ensure that all calls go through the New and - Renew macros. - --Andy Dougherty August 1996 -*/ - -/* =head1 SV Manipulation Functions =for apidoc Am|SV*|NEWSV|int id|STRLEN len @@ -589,8 +577,6 @@ hopefully catches attempts to access uninitialized memory. #define NEWSV(x,len) newSV(len) -#ifndef LEAKTEST - #define New(x,v,n,t) (v = (t*)safemalloc((MEM_SIZE)((n)*sizeof(t)))) #define Newc(x,v,n,t,c) (v = (c*)safemalloc((MEM_SIZE)((n)*sizeof(t)))) #define Newz(x,v,n,t) (v = (t*)safemalloc((MEM_SIZE)((n)*sizeof(t)))), \ @@ -601,28 +587,6 @@ hopefully catches attempts to access uninitialized memory. (v = (c*)saferealloc((Malloc_t)(v),(MEM_SIZE)((n)*sizeof(t)))) #define Safefree(d) safefree((Malloc_t)(d)) -#else /* LEAKTEST */ - -#define New(x,v,n,t) (v = (t*)safexmalloc((x),(MEM_SIZE)((n)*sizeof(t)))) -#define Newc(x,v,n,t,c) (v = (c*)safexmalloc((x),(MEM_SIZE)((n)*sizeof(t)))) -#define Newz(x,v,n,t) (v = (t*)safexmalloc((x),(MEM_SIZE)((n)*sizeof(t)))), \ - memzero((char*)(v), (n)*sizeof(t)) -#define Renew(v,n,t) \ - (v = (t*)safexrealloc((Malloc_t)(v),(MEM_SIZE)((n)*sizeof(t)))) -#define Renewc(v,n,t,c) \ - (v = (c*)safexrealloc((Malloc_t)(v),(MEM_SIZE)((n)*sizeof(t)))) -#define Safefree(d) safexfree((Malloc_t)(d)) - -#define MAXXCOUNT 1400 -#define MAXY_SIZE 80 -#define MAXYCOUNT 16 /* (MAXY_SIZE/4 + 1) */ -extern long xcount[MAXXCOUNT]; -extern long lastxcount[MAXXCOUNT]; -extern long xycount[MAXXCOUNT][MAXYCOUNT]; -extern long lastxycount[MAXXCOUNT][MAXYCOUNT]; - -#endif /* LEAKTEST */ - #define Move(s,d,n,t) (void)memmove((char*)(d),(char*)(s), (n) * sizeof(t)) #define Copy(s,d,n,t) (void)memcpy((char*)(d),(char*)(s), (n) * sizeof(t)) #define Zero(d,n,t) (void)memzero((char*)(d), (n) * sizeof(t)) diff --git a/perl.c b/perl.c index e04670d..d295455 100644 --- a/perl.c +++ b/perl.c @@ -2360,7 +2360,7 @@ Perl_moreswitches(pTHX_ char *s) forbid_setid("-D"); if (isALPHA(s[1])) { /* if adding extra options, remember to update DEBUG_MASK */ - static char debopts[] = "psltocPmfrxuLHXDSTRJvC"; + static char debopts[] = "psltocPmfrxu HXDSTRJvC"; char *d; for (s++; *s && (d = strchr(debopts,*s)); s++) diff --git a/perl.h b/perl.h index 28e3f58..1c17d31 100644 --- a/perl.h +++ b/perl.h @@ -2452,7 +2452,6 @@ Gid_t getegid (void); #define DEBUG_r_FLAG 0x00000200 /* 512 */ #define DEBUG_x_FLAG 0x00000400 /* 1024 */ #define DEBUG_u_FLAG 0x00000800 /* 2048 */ -#define DEBUG_L_FLAG 0x00001000 /* 4096 */ #define DEBUG_H_FLAG 0x00002000 /* 8192 */ #define DEBUG_X_FLAG 0x00004000 /* 16384 */ #define DEBUG_D_FLAG 0x00008000 /* 32768 */ @@ -2462,7 +2461,7 @@ Gid_t getegid (void); #define DEBUG_J_FLAG 0x00080000 /* 524288 */ #define DEBUG_v_FLAG 0x00100000 /*1048576 */ #define DEBUG_C_FLAG 0x00200000 /*2097152 */ -#define DEBUG_MASK 0x003FFFFF /* mask of all the standard flags */ +#define DEBUG_MASK 0x003FEFFF /* mask of all the standard flags */ #define DEBUG_DB_RECURSE_FLAG 0x40000000 #define DEBUG_TOP_FLAG 0x80000000 /* XXX what's this for ??? Signal @@ -2480,7 +2479,6 @@ Gid_t getegid (void); # define DEBUG_r_TEST_ (PL_debug & DEBUG_r_FLAG) # define DEBUG_x_TEST_ (PL_debug & DEBUG_x_FLAG) # define DEBUG_u_TEST_ (PL_debug & DEBUG_u_FLAG) -# define DEBUG_L_TEST_ (PL_debug & DEBUG_L_FLAG) # define DEBUG_H_TEST_ (PL_debug & DEBUG_H_FLAG) # define DEBUG_X_TEST_ (PL_debug & DEBUG_X_FLAG) # define DEBUG_D_TEST_ (PL_debug & DEBUG_D_FLAG) @@ -2508,7 +2506,6 @@ Gid_t getegid (void); # define DEBUG_r_TEST DEBUG_r_TEST_ # define DEBUG_x_TEST DEBUG_x_TEST_ # define DEBUG_u_TEST DEBUG_u_TEST_ -# define DEBUG_L_TEST DEBUG_L_TEST_ # define DEBUG_H_TEST DEBUG_H_TEST_ # define DEBUG_X_TEST DEBUG_X_TEST_ # define DEBUG_D_TEST DEBUG_D_TEST_ @@ -2545,7 +2542,6 @@ Gid_t getegid (void); # define DEBUG_r(a) DEBUG__(DEBUG_r_TEST, a) # define DEBUG_x(a) DEBUG__(DEBUG_x_TEST, a) # define DEBUG_u(a) DEBUG__(DEBUG_u_TEST, a) -# define DEBUG_L(a) DEBUG__(DEBUG_L_TEST, a) # define DEBUG_H(a) DEBUG__(DEBUG_H_TEST, a) # define DEBUG_X(a) DEBUG__(DEBUG_X_TEST, a) # define DEBUG_D(a) DEBUG__(DEBUG_D_TEST, a) @@ -2575,7 +2571,6 @@ Gid_t getegid (void); # define DEBUG_r_TEST (0) # define DEBUG_x_TEST (0) # define DEBUG_u_TEST (0) -# define DEBUG_L_TEST (0) # define DEBUG_H_TEST (0) # define DEBUG_X_TEST (0) # define DEBUG_D_TEST (0) @@ -2600,7 +2595,6 @@ Gid_t getegid (void); # define DEBUG_r(a) # define DEBUG_x(a) # define DEBUG_u(a) -# define DEBUG_L(a) # define DEBUG_H(a) # define DEBUG_X(a) # define DEBUG_D(a) diff --git a/pod/perlrun.pod b/pod/perlrun.pod index ee80d38..9360b85 100644 --- a/pod/perlrun.pod +++ b/pod/perlrun.pod @@ -320,7 +320,7 @@ B<-D14> is equivalent to B<-Dtls>): 512 r Regular expression parsing and execution 1024 x Syntax tree dump 2048 u Tainting checks - 4096 L Memory leaks (needs -DLEAKTEST when compiling Perl) + 4096 (Obsolete, previously used for LEAKTEST) 8192 H Hash dump -- usurps values() 16384 X Scratchpad allocation 32768 D Cleaning up diff --git a/proto.h b/proto.h index 5923ba0..cf5efbd 100644 --- a/proto.h +++ b/proto.h @@ -894,12 +894,6 @@ PERL_CALLCONV Malloc_t Perl_safesysmalloc(MEM_SIZE nbytes); PERL_CALLCONV Malloc_t Perl_safesyscalloc(MEM_SIZE elements, MEM_SIZE size); PERL_CALLCONV Malloc_t Perl_safesysrealloc(Malloc_t where, MEM_SIZE nbytes); PERL_CALLCONV Free_t Perl_safesysfree(Malloc_t where); -#if defined(LEAKTEST) -PERL_CALLCONV Malloc_t Perl_safexmalloc(I32 x, MEM_SIZE size); -PERL_CALLCONV Malloc_t Perl_safexcalloc(I32 x, MEM_SIZE elements, MEM_SIZE size); -PERL_CALLCONV Malloc_t Perl_safexrealloc(Malloc_t where, MEM_SIZE size); -PERL_CALLCONV void Perl_safexfree(Malloc_t where); -#endif #if defined(PERL_GLOBAL_STRUCT) PERL_CALLCONV struct perl_vars * Perl_GetVars(pTHX); #endif @@ -1343,9 +1337,6 @@ STATIC char* S_stdize_locale(pTHX_ char* locs); #if defined(PERL_IN_UTIL_C) || defined(PERL_DECL_PROT) STATIC COP* S_closest_cop(pTHX_ COP *cop, OP *o); STATIC SV* S_mess_alloc(pTHX); -# if defined(LEAKTEST) -STATIC void S_xstat(pTHX_ int); -# endif #endif START_EXTERN_C diff --git a/sv.c b/sv.c index 51a0bb6..e3b38c9 100644 --- a/sv.c +++ b/sv.c @@ -1126,13 +1126,8 @@ S_more_xpvbm(pTHX) xpvbm->xpv_pv = 0; } -#ifdef LEAKTEST -# define my_safemalloc(s) (void*)safexmalloc(717,s) -# define my_safefree(p) safexfree((char*)p) -#else -# define my_safemalloc(s) (void*)safemalloc(s) -# define my_safefree(p) safefree((char*)p) -#endif +#define my_safemalloc(s) (void*)safemalloc(s) +#define my_safefree(p) safefree((char*)p) #ifdef PURIFY @@ -1578,7 +1573,7 @@ Perl_sv_grow(pTHX_ register SV *sv, register STRLEN newlen) if (newlen > SvLEN(sv)) { /* need more room? */ if (SvLEN(sv) && s) { -#if defined(MYMALLOC) && !defined(LEAKTEST) +#ifdef MYMALLOC STRLEN l = malloced_size((void*)SvPVX(sv)); if (newlen <= l) { SvLEN_set(sv, l); diff --git a/util.c b/util.c index ae5adb6..4901d90 100644 --- a/util.c +++ b/util.c @@ -38,15 +38,6 @@ #define FLUSH -#ifdef LEAKTEST - -long xcount[MAXXCOUNT]; -long lastxcount[MAXXCOUNT]; -long xycount[MAXXCOUNT][MAXYCOUNT]; -long lastxycount[MAXXCOUNT][MAXYCOUNT]; - -#endif - #if defined(HAS_FCNTL) && defined(F_SETFD) && !defined(FD_CLOEXEC) # define FD_CLOEXEC 1 /* NeXT needs this */ #endif @@ -189,148 +180,6 @@ Perl_safesyscalloc(MEM_SIZE count, MEM_SIZE size) /*NOTREACHED*/ } -#ifdef LEAKTEST - -struct mem_test_strut { - union { - long type; - char c[2]; - } u; - long size; -}; - -# define ALIGN sizeof(struct mem_test_strut) - -# define sizeof_chunk(ch) (((struct mem_test_strut*) (ch))->size) -# define typeof_chunk(ch) \ - (((struct mem_test_strut*) (ch))->u.c[0] + ((struct mem_test_strut*) (ch))->u.c[1]*100) -# define set_typeof_chunk(ch,t) \ - (((struct mem_test_strut*) (ch))->u.c[0] = t % 100, ((struct mem_test_strut*) (ch))->u.c[1] = t / 100) -#define SIZE_TO_Y(size) ( (size) > MAXY_SIZE \ - ? MAXYCOUNT - 1 \ - : ( (size) > 40 \ - ? ((size) - 1)/8 + 5 \ - : ((size) - 1)/4)) - -Malloc_t -Perl_safexmalloc(I32 x, MEM_SIZE size) -{ - register char* where = (char*)safemalloc(size + ALIGN); - - xcount[x] += size; - xycount[x][SIZE_TO_Y(size)]++; - set_typeof_chunk(where, x); - sizeof_chunk(where) = size; - return (Malloc_t)(where + ALIGN); -} - -Malloc_t -Perl_safexrealloc(Malloc_t wh, MEM_SIZE size) -{ - char *where = (char*)wh; - - if (!wh) - return safexmalloc(0,size); - - { - MEM_SIZE old = sizeof_chunk(where - ALIGN); - int t = typeof_chunk(where - ALIGN); - register char* new = (char*)saferealloc(where - ALIGN, size + ALIGN); - - xycount[t][SIZE_TO_Y(old)]--; - xycount[t][SIZE_TO_Y(size)]++; - xcount[t] += size - old; - sizeof_chunk(new) = size; - return (Malloc_t)(new + ALIGN); - } -} - -void -Perl_safexfree(Malloc_t wh) -{ - I32 x; - char *where = (char*)wh; - MEM_SIZE size; - - if (!where) - return; - where -= ALIGN; - size = sizeof_chunk(where); - x = where[0] + 100 * where[1]; - xcount[x] -= size; - xycount[x][SIZE_TO_Y(size)]--; - safefree(where); -} - -Malloc_t -Perl_safexcalloc(I32 x,MEM_SIZE count, MEM_SIZE size) -{ - register char * where = (char*)safexmalloc(x, size * count + ALIGN); - xcount[x] += size; - xycount[x][SIZE_TO_Y(size)]++; - memset((void*)(where + ALIGN), 0, size * count); - set_typeof_chunk(where, x); - sizeof_chunk(where) = size; - return (Malloc_t)(where + ALIGN); -} - -STATIC void -S_xstat(pTHX_ int flag) -{ - register I32 i, j, total = 0; - I32 subtot[MAXYCOUNT]; - - for (j = 0; j < MAXYCOUNT; j++) { - subtot[j] = 0; - } - - PerlIO_printf(Perl_debug_log, " Id subtot 4 8 12 16 20 24 28 32 36 40 48 56 64 72 80 80+\n", total); - for (i = 0; i < MAXXCOUNT; i++) { - total += xcount[i]; - for (j = 0; j < MAXYCOUNT; j++) { - subtot[j] += xycount[i][j]; - } - if (flag == 0 - ? xcount[i] /* Have something */ - : (flag == 2 - ? xcount[i] != lastxcount[i] /* Changed */ - : xcount[i] > lastxcount[i])) { /* Growed */ - PerlIO_printf(Perl_debug_log,"%2d %02d %7ld ", i / 100, i % 100, - flag == 2 ? xcount[i] - lastxcount[i] : xcount[i]); - lastxcount[i] = xcount[i]; - for (j = 0; j < MAXYCOUNT; j++) { - if ( flag == 0 - ? xycount[i][j] /* Have something */ - : (flag == 2 - ? xycount[i][j] != lastxycount[i][j] /* Changed */ - : xycount[i][j] > lastxycount[i][j])) { /* Growed */ - PerlIO_printf(Perl_debug_log,"%3ld ", - flag == 2 - ? xycount[i][j] - lastxycount[i][j] - : xycount[i][j]); - lastxycount[i][j] = xycount[i][j]; - } else { - PerlIO_printf(Perl_debug_log, " . ", xycount[i][j]); - } - } - PerlIO_printf(Perl_debug_log, "\n"); - } - } - if (flag != 2) { - PerlIO_printf(Perl_debug_log, "Total %7ld ", total); - for (j = 0; j < MAXYCOUNT; j++) { - if (subtot[j]) { - PerlIO_printf(Perl_debug_log, "%3ld ", subtot[j]); - } else { - PerlIO_printf(Perl_debug_log, " . "); - } - } - PerlIO_printf(Perl_debug_log, "\n"); - } -} - -#endif /* LEAKTEST */ - /* These must be defined when not using Perl's malloc for binary * compatibility */ @@ -1413,14 +1262,6 @@ Perl_vwarn(pTHX_ const char* pat, va_list *args) PerlIO *serr = Perl_error_log; PERL_WRITE_MSG_TO_CONSOLE(serr, message, msglen); -#ifdef LEAKTEST - DEBUG_L(*message == '!' - ? (xstat(message[1]=='!' - ? (message[2]=='!' ? 2 : 1) - : 0) - , 0) - : 0); -#endif (void)PerlIO_flush(serr); } } @@ -1564,14 +1405,6 @@ Perl_vwarner(pTHX_ U32 err, const char* pat, va_list* args) { PerlIO *serr = Perl_error_log; PERL_WRITE_MSG_TO_CONSOLE(serr, message, msglen); -#ifdef LEAKTEST - DEBUG_L(*message == '!' - ? (xstat(message[1]=='!' - ? (message[2]=='!' ? 2 : 1) - : 0) - , 0) - : 0); -#endif (void)PerlIO_flush(serr); } }