Merge trunk

3 files changed, 68 insertions, 26 deletions

diff --git a/generic/tclCkalloc.c b/generic/tclCkalloc.c
index 394287a..18e3edb 100644
--- a/generic/tclCkalloc.c
+++ b/generic/tclCkalloc.c
@@ -89,14 +89,14 @@ static struct mem_header *allocHead = NULL;  /* List of allocated structures */
 #define BODY_OFFSET \
 	((size_t) (&((struct mem_header *) 0)->body))
 
-static int total_mallocs = 0;
-static int total_frees = 0;
+static unsigned int total_mallocs = 0;
+static unsigned int total_frees = 0;
 static size_t current_bytes_malloced = 0;
 static size_t maximum_bytes_malloced = 0;
-static int current_malloc_packets = 0;
-static int maximum_malloc_packets = 0;
-static int break_on_malloc = 0;
-static int trace_on_at_malloc = 0;
+static unsigned int current_malloc_packets = 0;
+static unsigned int  maximum_malloc_packets = 0;
+static unsigned int break_on_malloc = 0;
+static unsigned int trace_on_at_malloc = 0;
 static int alloc_tracing = FALSE;
 static int init_malloced_bodies = TRUE;
 #ifdef MEM_VALIDATE
@@ -184,18 +184,18 @@ TclDumpMemoryInfo(
         return 0;
     }
     sprintf(buf,
-	    "total mallocs             %10d\n"
-	    "total frees               %10d\n"
-	    "current packets allocated %10d\n"
-	    "current bytes allocated   %10lu\n"
-	    "maximum packets allocated %10d\n"
-	    "maximum bytes allocated   %10lu\n",
+	    "total mallocs             %10u\n"
+	    "total frees               %10u\n"
+	    "current packets allocated %10u\n"
+	    "current bytes allocated   %10" TCL_Z_MODIFIER "u\n"
+	    "maximum packets allocated %10u\n"
+	    "maximum bytes allocated   %10" TCL_Z_MODIFIER "u\n",
 	    total_mallocs,
 	    total_frees,
 	    current_malloc_packets,
-	    (unsigned long)current_bytes_malloced,
+	    current_bytes_malloced,
 	    maximum_malloc_packets,
-	    (unsigned long)maximum_bytes_malloced);
+	    maximum_bytes_malloced);
     if (flags == 0) {
 	fprintf((FILE *)clientData, "%s", buf);
     } else {
@@ -359,9 +359,8 @@ Tcl_DumpActiveMemory(
     Tcl_MutexLock(ckallocMutexPtr);
     for (memScanP = allocHead; memScanP != NULL; memScanP = memScanP->flink) {
 	address = &memScanP->body[0];
-	fprintf(fileP, "%8" TCL_Z_MODIFIER "x - %8" TCL_Z_MODIFIER "x  %7" TCL_Z_MODIFIER "d @ %s %d %s",
-		(size_t)address,
-		((size_t)address + memScanP->length - 1),
+	fprintf(fileP, "%p - %p  %" TCL_Z_MODIFIER "u @ %s %d %s",
+		address, address + memScanP->length - 1,
 		memScanP->length, memScanP->file, memScanP->line,
 		(memScanP->tagPtr == NULL) ? "" : memScanP->tagPtr->string);
 	(void) fputc('\n', fileP);
@@ -450,7 +449,7 @@ Tcl_DbCkalloc(
     total_mallocs++;
     if (trace_on_at_malloc && (total_mallocs >= trace_on_at_malloc)) {
 	(void) fflush(stdout);
-	fprintf(stderr, "reached malloc trace enable point (%d)\n",
+	fprintf(stderr, "reached malloc trace enable point (%u)\n",
 		total_mallocs);
 	fflush(stderr);
 	alloc_tracing = TRUE;
@@ -465,7 +464,7 @@ Tcl_DbCkalloc(
     if (break_on_malloc && (total_mallocs >= break_on_malloc)) {
 	break_on_malloc = 0;
 	(void) fflush(stdout);
-	Tcl_Panic("reached malloc break limit (%d)", total_mallocs);
+	Tcl_Panic("reached malloc break limit (%u)", total_mallocs);
     }
 
     current_malloc_packets++;
@@ -612,8 +611,8 @@ Tcl_DbCkfree(
     memp = (struct mem_header *) (((size_t) ptr) - BODY_OFFSET);
 
     if (alloc_tracing) {
-	fprintf(stderr, "ckfree %p %" TCL_LL_MODIFIER "d %s %d\n",
-		memp->body, (Tcl_WideInt) memp->length, file, line);
+	fprintf(stderr, "ckfree %p %" TCL_Z_MODIFIER "u %s %d\n",
+		memp->body, memp->length, file, line);
     }
 
     if (validate_memory) {
@@ -848,22 +847,24 @@ MemoryCmd(
 	return TCL_OK;
     }
     if (strcmp(argv[1],"break_on_malloc") == 0) {
+	int value;
 	if (argc != 3) {
 	    goto argError;
 	}
-	if (Tcl_GetInt(interp, argv[2], &break_on_malloc) != TCL_OK) {
+	if (Tcl_GetInt(interp, argv[2], &value) != TCL_OK) {
 	    return TCL_ERROR;
 	}
+	break_on_malloc = (unsigned int) value;
 	return TCL_OK;
     }
     if (strcmp(argv[1],"info") == 0) {
 	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
-		"%-25s %10d\n%-25s %10d\n%-25s %10d\n%-25s %10lu\n%-25s %10d\n%-25s %10lu\n",
+		"%-25s %10u\n%-25s %10u\n%-25s %10u\n%-25s %10" TCL_Z_MODIFIER"u\n%-25s %10u\n%-25s %10" TCL_Z_MODIFIER "u\n",
 		"total mallocs", total_mallocs, "total frees", total_frees,
 		"current packets allocated", current_malloc_packets,
-		"current bytes allocated", (unsigned long)current_bytes_malloced,
+		"current bytes allocated", current_bytes_malloced,
 		"maximum packets allocated", maximum_malloc_packets,
-		"maximum bytes allocated", (unsigned long)maximum_bytes_malloced));
+		"maximum bytes allocated", maximum_bytes_malloced));
 	return TCL_OK;
     }
     if (strcmp(argv[1], "init") == 0) {
@@ -934,12 +935,14 @@ MemoryCmd(
     }
 
     if (strcmp(argv[1],"trace_on_at_malloc") == 0) {
+	int value;
 	if (argc != 3) {
 	    goto argError;
 	}
-	if (Tcl_GetInt(interp, argv[2], &trace_on_at_malloc) != TCL_OK) {
+	if (Tcl_GetInt(interp, argv[2], &value) != TCL_OK) {
 	    return TCL_ERROR;
 	}
+	trace_on_at_malloc = value;
 	return TCL_OK;
     }
     if (strcmp(argv[1],"validate") == 0) {
diff --git a/generic/tclOOCall.c b/generic/tclOOCall.c
index 8003345..ac0b94d 100644
--- a/generic/tclOOCall.c
+++ b/generic/tclOOCall.c
@@ -619,6 +619,7 @@ AddClassMethodNames(
 		int isWanted = (!(flags & PUBLIC_METHOD)
 			|| (mPtr->flags & PUBLIC_METHOD)) ? IN_LIST : 0;
 
+		isWanted |= (mPtr->typePtr == NULL ? NO_IMPLEMENTATION : 0);
 		Tcl_SetHashValue(hPtr, INT2PTR(isWanted));
 	    } else if ((PTR2INT(Tcl_GetHashValue(hPtr)) & NO_IMPLEMENTATION)
 		    && mPtr->typePtr != NULL) {
diff --git a/tests/oo.test b/tests/oo.test
index ccb05c1..e03911b 100644
--- a/tests/oo.test
+++ b/tests/oo.test
@@ -2241,6 +2241,44 @@ test oo-17.10 {OO: class introspection} -setup {
     oo::define foo unexport {*}[info class methods foo -all]
     info class methods foo -all
 } -result {}
+set stdmethods {<cloned> destroy eval unknown variable varname}
+test oo-17.11 {OO: object method unexport (bug 900cb0284bc)} -setup {
+    oo::object create o
+    oo::objdefine o unexport m
+} -body {
+    lsort [info object methods o -all -private]
+} -cleanup {
+    o destroy
+} -result $stdmethods
+test oo-17.12 {OO: instance method unexport (bug 900cb0284bc)} -setup {
+    oo::class create c
+    c create o
+    oo::objdefine o unexport m
+} -body {
+    lsort [info object methods o -all -private]
+} -cleanup {
+    o destroy
+    c destroy
+} -result $stdmethods
+test oo-17.13 {OO: class method unexport (bug 900cb0284bc)} -setup {
+    oo::class create c
+    oo::define c unexport m
+} -body {
+    lsort [info class methods c -all -private]
+} -cleanup {
+    c destroy
+} -result $stdmethods
+test oo-17.14 {OO: instance method unexport (bug 900cb0284bc)} -setup {
+    oo::class create c
+    oo::define c unexport m
+    c create o
+} -body {
+    lsort [info object methods o -all -private]
+} -cleanup {
+    o destroy
+    c destroy
+} -result $stdmethods
+
 
 test oo-18.1 {OO: define command support} {
     list [catch {oo::define oo::object {error foo}} msg] $msg $errorInfo