Tcl Source Code

Check-in [244c0b893d]
Login
Bounty program for improvements to Tcl and certain Tcl packages.
Tcl 2019 Conference, Houston/TX, US, Nov 4-8
Send your abstracts to [email protected]
or submit via the online form by Sep 9.

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:[46a2410650] compiled [unset] was bypassing cleanup of active array search. Overdue thanks to Andy Goth for tests and report.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | core-8-6-branch
Files: files | file ages | folders
SHA3-256: 244c0b893d3d3ddc3fafe87f31cd1838aa9d39a773218413a5fcef08a7fb747b
User & Date: dgp 2018-04-22 13:22:20
Context
2018-04-23
14:56
Add some state to encodings, so we can do better surrogate handling for TCL_UTF_MAX >= 4. Backported... check-in: c41cbc5340 user: jan.nijtmans tags: core-8-6-branch
2018-04-22
13:27
merge 8.6 check-in: 143af13340 user: dgp tags: core-8-branch
13:22
[46a2410650] compiled [unset] was bypassing cleanup of active array search. Overdue thanks to Andy G... check-in: 244c0b893d user: dgp tags: core-8-6-branch
2018-04-20
20:17
DeleteArray has only one caller. It is called on the "dummy" variable that is created during unset, ... check-in: 27ec7e3d3d user: dgp tags: core-8-6-branch
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to generic/tclExecute.c.

4165
4166
4167
4168
4169
4170
4171
4172

4173
4174
4175
4176
4177
4178
4179
	part2Ptr = OBJ_AT_TOS;
	arrayPtr = LOCAL(opnd);
	while (TclIsVarLink(arrayPtr)) {
	    arrayPtr = arrayPtr->value.linkPtr;
	}
	TRACE(("%s %u \"%.30s\" => ",
		(flags ? "normal" : "noerr"), opnd, O2S(part2Ptr)));
	if (TclIsVarArray(arrayPtr) && !UnsetTraced(arrayPtr)) {

	    varPtr = VarHashFindVar(arrayPtr->value.tablePtr, part2Ptr);
	    if (varPtr && TclIsVarDirectUnsettable(varPtr)) {
		/*
		 * No nasty traces and element exists, so we can proceed to
		 * unset it. Might still not exist though...
		 */







|
>







4165
4166
4167
4168
4169
4170
4171
4172
4173
4174
4175
4176
4177
4178
4179
4180
	part2Ptr = OBJ_AT_TOS;
	arrayPtr = LOCAL(opnd);
	while (TclIsVarLink(arrayPtr)) {
	    arrayPtr = arrayPtr->value.linkPtr;
	}
	TRACE(("%s %u \"%.30s\" => ",
		(flags ? "normal" : "noerr"), opnd, O2S(part2Ptr)));
	if (TclIsVarArray(arrayPtr) && !UnsetTraced(arrayPtr)
		&& !(arrayPtr->flags & VAR_SEARCH_ACTIVE)) {
	    varPtr = VarHashFindVar(arrayPtr->value.tablePtr, part2Ptr);
	    if (varPtr && TclIsVarDirectUnsettable(varPtr)) {
		/*
		 * No nasty traces and element exists, so we can proceed to
		 * unset it. Might still not exist though...
		 */

Changes to tests/var.test.

772
773
774
775
776
777
778
















779
780
781
782
783
784
785
    namespace eval :: {
	set t(1) 1
	trace variable t(1) u foo
	unset t
    }
    set x "If you see this, it worked"
} -result "If you see this, it worked"

















test var-14.1 {array names syntax} -body {
    array names foo bar baz snafu
} -returnCodes 1 -match glob -result *
test var-14.2 {array names -glob} -body {
    array names tcl_platform -glob os
} -result os






>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
    namespace eval :: {
	set t(1) 1
	trace variable t(1) u foo
	unset t
    }
    set x "If you see this, it worked"
} -result "If you see this, it worked"
test var-13.2 {unset array with search, bug 46a2410650} -body {
    apply {{} {
	array set a {aa 11 bb 22 cc 33 dd 44 ee 55 ff 66}
	set s [array startsearch a]
	unset a([array nextelement a $s])
	array nextelement a $s
    }}
} -returnCodes error -result {couldn't find search "s-1-a"}
test var-13.3 {unset array with search, SIGSEGV, bug 46a2410650} -body {
    apply {{} {
	array set a {aa 11 bb 22 cc 33 dd 44 ee 55 ff 66}
	set s [array startsearch a]
        unset a(ff)
	array nextelement a $s
    }}
} -returnCodes error -result {couldn't find search "s-1-a"}

test var-14.1 {array names syntax} -body {
    array names foo bar baz snafu
} -returnCodes 1 -match glob -result *
test var-14.2 {array names -glob} -body {
    array names tcl_platform -glob os
} -result os