Tcl Source Code

Check-in [7070d2aa22]
Login
Bounty program for improvements to Tcl and certain Tcl packages.

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

Overview
Comment:[80304238ac] Prevent RC cycle in the localVarName objtype.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 7070d2aa2222bc5c15abdb6f09a17721e4017fe1
User & Date: dgp 2016-03-01 16:45:01
Context
2016-03-02
08:49
Eliminate exess spacings in many doc pages. check-in: 840e5d4825 user: jan.nijtmans tags: trunk
2016-03-01
16:45
[80304238ac] Prevent RC cycle in the localVarName objtype. check-in: 7070d2aa22 user: dgp tags: trunk
16:42
Extra safety against cycles Closed-Leaf check-in: b4d05f59f1 user: dgp tags: bug-80304238ac
13:24
merge release check-in: d73a0fbece user: dgp tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to generic/tclVar.c.

693
694
695
696
697
698
699

700
701
702
703
704
705

706


707
708
709
710
711
712
713
     * Cache the newly found variable if possible.
     */

    if (index >= 0) {
	/*
	 * An indexed local variable.
	 */


	part1Ptr->typePtr = &localVarNameType;
	if (part1Ptr != localName(iPtr->varFramePtr, index)) {
	    part1Ptr->internalRep.twoPtrValue.ptr1 =
		    localName(iPtr->varFramePtr, index);
	    Tcl_IncrRefCount((Tcl_Obj *)

		    part1Ptr->internalRep.twoPtrValue.ptr1);


	} else {
	    part1Ptr->internalRep.twoPtrValue.ptr1 = NULL;
	}
	part1Ptr->internalRep.twoPtrValue.ptr2 = INT2PTR(index);
    } else {
	/*
	 * At least mark part1Ptr as already parsed.






>


|
|
<
|
>
|
>
>







693
694
695
696
697
698
699
700
701
702
703
704

705
706
707
708
709
710
711
712
713
714
715
716
     * Cache the newly found variable if possible.
     */

    if (index >= 0) {
	/*
	 * An indexed local variable.
	 */
	Tcl_Obj *cachedNamePtr = localName(iPtr->varFramePtr, index);

	part1Ptr->typePtr = &localVarNameType;
	if (part1Ptr != cachedNamePtr) {
	    part1Ptr->internalRep.twoPtrValue.ptr1 = cachedNamePtr;

	    Tcl_IncrRefCount(cachedNamePtr);
	    if (cachedNamePtr->typePtr != &localVarNameType
		    || cachedNamePtr->internalRep.twoPtrValue.ptr1 != NULL) {
	        TclFreeIntRep(cachedNamePtr);
	    }
	} else {
	    part1Ptr->internalRep.twoPtrValue.ptr1 = NULL;
	}
	part1Ptr->internalRep.twoPtrValue.ptr2 = INT2PTR(index);
    } else {
	/*
	 * At least mark part1Ptr as already parsed.

Changes to tests/var.test.

908
909
910
911
912
913
914




























915
916
917
918
919
920
921
	    }
	}
    }
} -constraints memory -body {
    set end [getbytes]
    for {set i 0} {$i < 5} {incr i} {
	doit $i




























        set tmp $end
        set end [getbytes]
    }
    set leakedBytes [expr {$end - $tmp}]
} -cleanup {
    array unset A
    rename getbytes {}






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







908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
	    }
	}
    }
} -constraints memory -body {
    set end [getbytes]
    for {set i 0} {$i < 5} {incr i} {
	doit $i
        set tmp $end
        set end [getbytes]
    }
    set leakedBytes [expr {$end - $tmp}]
} -cleanup {
    array unset A
    rename getbytes {}
    rename doit {}
} -result 0
test var-22.1 {leak in localVarName intrep: Bug 80304238ac} -setup {
    proc getbytes {} {
	lindex [split [memory info] \n] 3 3
    }
    proc doit {} {
	interp create slave
	slave eval {
	    proc doit script {
		eval $script
		set foo bar
	    }
	    doit {foreach foo baz {}}
	}
	interp delete slave
    }
} -constraints memory -body {
    set end [getbytes]
    for {set i 0} {$i < 5} {incr i} {
	doit
        set tmp $end
        set end [getbytes]
    }
    set leakedBytes [expr {$end - $tmp}]
} -cleanup {
    array unset A
    rename getbytes {}