Tcl Source Code

2012-04-04  Donal K. Fellows  <[email protected]>

	* generic/tclOO.c (Tcl_NewObjectInstance, TclNRNewObjectInstance):
	[Bug 3514761]: Fixed bogosity with automated argument description
	handling when constructing an instance of a class that is itself a
	member of an ensemble. Thanks to Andreas Kupries for identifying that
	this was a problem case at all!
	(Tcl_CopyObjectInstance): Fix potential bleed-over of ensemble
	information into [oo::copy].

2012-04-04  Jan Nijtmans  <[email protected]>

	* win/tclWinSock.c: [Bug 510001]: TclSockMinimumBuffers needs plat imp
	* generic/tclIOSock.c:
	* generic/tclInt.decls:
	* generic/tclIntDecls.h:
	* generic/tclStubInit.c:

2012-04-03  Jan Nijtmans  <[email protected]>

	* generic/tclStubInit.c: Remove the TclpGetTZName implementation for
	* generic/tclIntDecls.h: Cygwin (from 2012-04-02 commit), re-generated
	* generic/tclIntPlatDecls.h:

2012-04-02  Donal K. Fellows  <[email protected]>

	IMPLEMENTATION OF TIP#396.

	* generic/tclBasic.c (builtInCmds, TclNRYieldToObjCmd): Convert the

	if (contextPtr != NULL) {
	    int result;
	    Tcl_InterpState state;

	    state = Tcl_SaveInterpState(interp, TCL_OK);
	    contextPtr->callPtr->flags |= CONSTRUCTOR;
	    contextPtr->skip = skip;

	    /*
	     * Adjust the ensmble tracking record if necessary. [Bug 3514761]
	     */

	    if (((Interp*) interp)->ensembleRewrite.sourceObjs) {
		((Interp*) interp)->ensembleRewrite.numInsertedObjs += skip-1;
		((Interp*) interp)->ensembleRewrite.numRemovedObjs += skip-1;
	    }
	    result = Tcl_NRCallObjProc(interp, TclOOInvokeContext, contextPtr,
		    objc, objv);

	    /*
	     * It's an error if the object was whacked in the constructor.
	     * Force this if it isn't already an error (don't want to lose
	     * errors by accident...) [Bug 2903011]

	*objectPtr = (Tcl_Object) oPtr;
	return TCL_OK;
    }

    state = Tcl_SaveInterpState(interp, TCL_OK);
    contextPtr->callPtr->flags |= CONSTRUCTOR;
    contextPtr->skip = skip;

    /*
     * Adjust the ensmble tracking record if necessary. [Bug 3514761]
     */

    if (((Interp *) interp)->ensembleRewrite.sourceObjs) {
	((Interp *) interp)->ensembleRewrite.numInsertedObjs += skip - 1;
	((Interp *) interp)->ensembleRewrite.numRemovedObjs += skip - 1;
    }

    /*
     * Fire off the constructors non-recursively.
     */

    AddRef(oPtr);
    TclNRAddCallback(interp, FinalizeAlloc, contextPtr, oPtr, state,

		    Tcl_ClassSetMetadata((Tcl_Class) cls2Ptr, metadataTypePtr,
			    duplicate);
		}
	    }
	}
    }

    TclResetRewriteEnsemble(interp, 1);
    contextPtr = TclOOGetCallContext(o2Ptr, oPtr->fPtr->clonedName, 0, NULL);
    if (contextPtr) {
	args[0] = TclOOObjectName(interp, o2Ptr);
	args[1] = oPtr->fPtr->clonedName;
	args[2] = TclOOObjectName(interp, oPtr);
	Tcl_IncrRefCount(args[0]);
	Tcl_IncrRefCount(args[1]);
	Tcl_IncrRefCount(args[2]);
	result = Tcl_NRCallObjProc(interp, TclOOInvokeContext, contextPtr, 3,
		args);
	TclDecrRefCount(args[0]);
	TclDecrRefCount(args[1]);
	TclDecrRefCount(args[2]);
	TclOODeleteContext(contextPtr);
	if (result == TCL_ERROR) {
	    Tcl_AddErrorInfo(interp,
		    "\n    (while performing post-copy callback)");
	}
	if (result != TCL_OK) {
	    Tcl_DeleteCommandFromToken(interp, o2Ptr->command);
	    return NULL;
	}
    }

    return (Tcl_Object) o2Ptr;

    }
    namespace tail [foo create good]
} -cleanup {
    foo destroy
} -result good
test oo-2.7 {construction, method calls and ensembles - Bug 3514761} -setup {
    namespace eval k {}
} -body {
    namespace eval k {
	oo::class create s {
	    constructor {j} {
		# nothing
	    }
	}
	namespace export s
	namespace ensemble create
    }
    k s create X
} -returnCodes error -cleanup {
    namespace delete k
} -result {wrong # args: should be "k s create X j"}
test oo-2.8 {construction, method calls and ensembles - Bug 3514761} -setup {
    namespace eval k {}
} -body {
    namespace eval k {
	oo::class create s {
	    constructor {j} {
		# nothing
	    }
	}
	oo::class create t {
	    superclass s
	    constructor args {
		k next {*}$args
	    }
	}
	interp alias {} ::k::next {} ::oo::Helpers::next
	namespace export t next
	namespace ensemble create
    }
    k t create X
} -returnCodes error -cleanup {
    namespace delete k
} -result {wrong # args: should be "k next j"}

test oo-3.1 {basic test of OO functionality: destructor} -setup {
    # This is a bit complex because it needs to run in a sub-interp as we're
    # modifying the root object class's constructor
    interp create subinterp
    subinterp eval {
	package require TclOO

    Foo create foo ok
    oo::copy foo bar
    foo check
    bar check
} -cleanup {
    Foo destroy
} -result {cloned ::foo ::bar check ::foo ok check ::bar ok}
test oo-15.9 {ensemble rewriting must not bleed through oo::copy} -setup {
    oo::class create Foo
} -body {
    oo::define Foo {
	method <cloned> {a b} {}
    }
    interp alias {} Bar {} oo::copy [Foo create foo]
    Bar bar
} -returnCodes error -cleanup {
    Foo destroy
} -result {wrong # args: should be "::bar <cloned> a b"}

test oo-16.1 {OO: object introspection} -body {
    info object
} -returnCodes 1 -result "wrong \# args: should be \"info object subcommand ?arg ...?\""
test oo-16.2 {OO: object introspection} -body {
    info object class NOTANOBJECT
} -returnCodes 1 -result {NOTANOBJECT does not refer to an object}