Tcl Source Code

2011-08-07  Donal K. Fellows  <[email protected]>

	* generic/tclOOInfo.c (InfoClassCallCmd): [Bug 3387082]: Plug memory
	leak in call chain introspection.

2011-08-06  Kevin B, Kenny  <[email protected]>

	* generic/tclAssemnbly.c: [Bug 3384840]: Plug another memory leak.
	* generic/tclStrToD.c: [Bug 3386975]: Plug another memory leak.

2011-08-05  Kevin B. Kenny  <[email protected]>

	* generic/tclStrToD.c: [Bug 3386975]: Plugged a memory leak in
	double->string conversion.

2011-08-05  Donal K. Fellows  <[email protected]>

	* generic/tclAssembly.c (AssembleOneLine): Ensure that memory isn't
	leaked when an unknown instruction is encountered. Also simplify code
	through use of Tcl_ObjPrintf in error message generation.

	    Tcl_SetHashValue(hPtr, NULL);
	    TclOODeleteChain(callPtr);
	}
    } else {
	hPtr = NULL;
    }

    callPtr = ckalloc(sizeof(CallChain));
    memset(callPtr, 0, sizeof(CallChain));
    callPtr->flags = flags & (PUBLIC_METHOD|PRIVATE_METHOD|FILTER_HANDLING);
    callPtr->epoch = fPtr->epoch;
    callPtr->objectCreationEpoch = fPtr->tsdPtr->nsCount;
    callPtr->objectEpoch = clsPtr->thisPtr->epoch;
    callPtr->refCount = 1;
    callPtr->chain = callPtr->staticChain;

	if (count == callPtr->numChain) {
	    TclOODeleteChain(callPtr);
	    return NULL;
	}
    } else {
	if (hPtr == NULL) {
	    if (clsPtr->classChainCache == NULL) {
		clsPtr->classChainCache = ckalloc(sizeof(Tcl_HashTable));


		Tcl_InitObjHashTable(clsPtr->classChainCache);
	    }
	    hPtr = Tcl_CreateHashEntry(clsPtr->classChainCache,
		    (char *) methodNameObj, &i);
	}
	callPtr->refCount++;
	Tcl_SetHashValue(hPtr, callPtr);

    callPtr = TclOOGetStereotypeCallChain(clsPtr, objv[2], PUBLIC_METHOD);
    if (callPtr == NULL) {
	Tcl_AppendResult(interp, "cannot construct any call chain", NULL);
	return TCL_ERROR;
    }
    Tcl_SetObjResult(interp, TclOORenderCallChain(interp, callPtr));
    TclOODeleteChain(callPtr);
    return TCL_OK;
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4

    info object call notanobject x
} -returnCodes error -result {notanobject does not refer to an object}
test oo-call-1.18 {object call introspection - memory leaks} -body {
    leaktest {
	info object call oo::object destroy
    }
} -constraints memory -result 0
test oo-call-1.19 {object call introspection - memory leaks} -setup {
    oo::class create leaktester { method foo {} {dummy} }
} -body {
    leaktest {
	set lt [leaktester new]
	oo::objdefine $lt method foobar {} {dummy}
	list [info object call $lt destroy] \
	    [info object call $lt foo] \
	    [info object call $lt bar] \
	    [info object call $lt foobar] \
	    [$lt destroy]
    }
} -cleanup {
    leaktester destroy
} -constraints memory -result 0

test oo-call-2.1 {class call introspection} -setup {
    oo::class create root
} -body {
    oo::class create ::A {
	superclass root
	method x {} {}

    info class call notaclass x
} -returnCodes error -cleanup {
    root destroy
} -result {"notaclass" is not a class}
test oo-call-2.13 {class call introspection - memory leaks} -body {
    leaktest {
	info class call oo::class destroy
    }
} -constraints memory -result 0
test oo-call-2.14 {class call introspection - memory leaks} -body {
    leaktest {
	oo::class create leaktester { method foo {} {dummy} }
	[leaktester new] destroy
	list [info class call leaktester destroy] \
	    [info class call leaktester foo] \
	    [info class call leaktester bar] \
	    [leaktester destroy]
    }
} -constraints memory -result 0

test oo-call-3.1 {current call introspection} -setup {
    oo::class create root
} -body {
    oo::class create A {