Tcl Source Code

2012-02-09  Don Porter  <[email protected]>

	* generic/tclStringObj.c:	Converted the memcpy() calls in 
	append operations to memmove() calls.  This adds safety in the case
	of overlapping copies, and improves performance on some benchmarks.

2012-02-06  Don Porter  <[email protected]>

	* generic/tclEnsemble.c: [Bug 3485022] TclCompileEnsemble() avoid
	* tests/trace.test:	compile when exec traces set.

2012-02-06  Miguel Sofer  <[email protected]>

	* generic/tclTrace.c:  Fix for [Bug 3484621]: insure that
	* tests/trace.test:    execution traces on bytecoded commands bump
	the interp's compile epoch.
	
2012-02-02  Jan Nijtmans  <[email protected]>

	* generic/tclUniData.c: [Frq 3464401] Support Unicode 6.1
	* generic/regc_locale.c:

2012-02-02  Don Porter  <[email protected]>

	return TCL_ERROR;
    }
    targetCmdObj = elems[0];

    Tcl_IncrRefCount(targetCmdObj);
    cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, targetCmdObj);
    TclDecrRefCount(targetCmdObj);
    if (cmdPtr == NULL || cmdPtr->compileProc == NULL
	    || cmdPtr->nsPtr->flags & NS_SUPPRESS_COMPILATION
	    || cmdPtr->flags * CMD_HAS_EXEC_TRACES
	    || ((Interp *)interp)->flags & DONT_COMPILE_CMDS_INLINE) {
	/*
	 * Maps to an undefined command or a command without a compiler.
	 * Cannot compile.
	 */

	return TCL_ERROR;
    }

    }

    /*
     * Copy the new string onto the end of the old string, then add the
     * trailing null.
     */

    memmove(stringPtr->unicode + stringPtr->numChars, unicode,
	    appendNumChars * sizeof(Tcl_UniChar));
    stringPtr->unicode[numChars] = 0;
    stringPtr->numChars = numChars;
    stringPtr->allocated = 0;

    TclInvalidateStringRep(objPtr);
}

    /*
     * Invalidate the unicode data.
     */

    stringPtr->numChars = -1;
    stringPtr->hasUnicode = 0;

    memmove(objPtr->bytes + oldLength, bytes, numBytes);
    objPtr->bytes[newLength] = 0;
    objPtr->length = newLength;
}

/*
 *----------------------------------------------------------------------
 *

    tracePtr->clientData = clientData;
    tracePtr->flags = flags &
	    (TCL_TRACE_RENAME | TCL_TRACE_DELETE | TCL_TRACE_ANY_EXEC);
    tracePtr->nextPtr = cmdPtr->tracePtr;
    tracePtr->refCount = 1;
    cmdPtr->tracePtr = tracePtr;
    if (tracePtr->flags & TCL_TRACE_ANY_EXEC) {
	/*
	 * Bug 3484621: up the interp's epoch if this is a BC'ed command
	 */
	
	if ((cmdPtr->compileProc != NULL) && !(cmdPtr->flags & CMD_HAS_EXEC_TRACES)){
	    Interp *iPtr = (Interp *) interp;
	    iPtr->compileEpoch++;
	}
	cmdPtr->flags |= CMD_HAS_EXEC_TRACES;
    }

    
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_UntraceCommand --

	/*
	 * None of the remaining traces on this command are execution traces.
	 * We therefore remove this flag:
	 */

	cmdPtr->flags &= ~CMD_HAS_EXEC_TRACES;

        /*
	 * Bug 3484621: up the interp's epoch if this is a BC'ed command
	 */
	
	if (cmdPtr->compileProc != NULL) {
	    Interp *iPtr = (Interp *) interp;
	    iPtr->compileEpoch++;
	}
    }
}

/*
 *----------------------------------------------------------------------
 *
 * TraceCommandProc --

    } -body {
	untraced $t
	list \$::tracevar \$::tracevar2
    } -result {$r}
}
runbase {{- *} {-* *} {- *} {- *}} $base

test trace-39 {bug #3484621: tracing Bc'ed commands} -setup {
    set ::traceLog 0
    set ::traceCalls 0
    set ::bar [list 0 1 2 3]
    set res {}
    proc dotrace args {
	incr ::traceLog
    }
    proc foo {} {
	incr ::traceCalls
	# choose a BC'ed command that is 'unlikely' to interfere with tcltest's
	# internals 
	lset ::bar 1 2
    }
} -body {
    foo
    lappend res $::traceLog

    trace add execution lset enter dotrace
    foo
    lappend res $::traceLog

    trace remove execution lset enter dotrace
    foo
    lappend res $::traceLog

    list $::traceCalls | {*}$res
} -cleanup {
    unset ::traceLog ::traceCalls ::bar res
    rename dotrace {}
    rename foo {}
} -result {3 | 0 1 1}
    
test trace-39.1 {bug #3485022: tracing Bc'ed commands} -setup {
    set ::traceLog 0
    set ::traceCalls 0
    set res {}
    proc dotrace args {
	incr ::traceLog
    }
    proc foo {} {
	incr ::traceCalls
	string equal zip zap
    }
} -body {
    foo
    lappend res $::traceLog

    trace add execution ::tcl::string::equal enter dotrace
    foo
    lappend res $::traceLog

    trace remove execution tcl::string::equal enter dotrace
    foo
    lappend res $::traceLog

    list $::traceCalls | {*}$res
} -cleanup {
    unset ::traceLog ::traceCalls res
    rename dotrace {}
    rename foo {}
} -result {3 | 0 1 1}
    
# Delete procedures when done, so we don't clash with other tests
# (e.g. foobar will clash with 'unknown' tests).
catch {rename foobar {}}
catch {rename foo {}}
catch {rename bar {}}
catch {rename untraced {}}
catch {rename traceproc {}}