diff options
| author | Joe Mistachkin <joe@mistachkin.com> | 2009-10-18 11:21:38 (GMT) |
|---|---|---|
| committer | Joe Mistachkin <joe@mistachkin.com> | 2009-10-18 11:21:38 (GMT) |
| commit | 7b94da051e6dde67f1a1602c93fffbcc98787cf1 (patch) | |
| tree | 603c5054308f9adf1cc735c02a0e1c578b379924 /generic/tclCkalloc.c | |
| parent | 391cc5529b10b842b5e34acb19bf559b56df7f49 (diff) | |
| download | tcl-7b94da051e6dde67f1a1602c93fffbcc98787cf1.zip tcl-7b94da051e6dde67f1a1602c93fffbcc98787cf1.tar.gz tcl-7b94da051e6dde67f1a1602c93fffbcc98787cf1.tar.bz2 | |
Fix for [Bug 988703, 1565466]
Diffstat (limited to 'generic/tclCkalloc.c')
| -rw-r--r-- | generic/tclCkalloc.c | 23 |
1 files changed, 22 insertions, 1 deletions
diff --git a/generic/tclCkalloc.c b/generic/tclCkalloc.c index a29208a..81b8851 100644 --- a/generic/tclCkalloc.c +++ b/generic/tclCkalloc.c @@ -14,7 +14,7 @@ * * This code contributed by Karl Lehenbauer and Mark Diekhans * - * RCS: @(#) $Id: tclCkalloc.c,v 1.32.4.1 2009/09/29 04:43:58 dgp Exp $ + * RCS: @(#) $Id: tclCkalloc.c,v 1.32.4.2 2009/10/18 11:21:38 mistachkin Exp $ */ #include "tclInt.h" @@ -811,6 +811,7 @@ MemoryCmd( CONST char *argv[]) { CONST char *fileName; + FILE *fileP; Tcl_DString buffer; int result; @@ -864,6 +865,26 @@ MemoryCmd( init_malloced_bodies = (strcmp(argv[2],"on") == 0); return TCL_OK; } + if (strcmp(argv[1],"objs") == 0) { + if (argc != 3) { + Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], + " objs file\"", NULL); + return TCL_ERROR; + } + fileName = Tcl_TranslateFileName(interp, argv[2], &buffer); + if (fileName == NULL) { + return TCL_ERROR; + } + fileP = fopen(fileName, "w"); + if (fileP == NULL) { + Tcl_AppendResult(interp, "cannot open output file", NULL); + return TCL_ERROR; + } + TclDbDumpActiveObjects(fileP); + fclose(fileP); + Tcl_DStringFree(&buffer); + return TCL_OK; + } if (strcmp(argv[1],"onexit") == 0) { if (argc != 3) { Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], |