Tcl Source Code

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

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

Overview
Comment:Fix memory leak in Tcl_DeleteNamespace.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | bug-e593adf103-core-8
Files: files | file ages | folders
SHA3-256: 3bf90104138a1ec2c13fa730cfa54b9db4e597aa47c864ed81daa399bfd482bf
User & Date: pooryorick 2018-05-21 09:51:09
Context
2018-05-21
10:02
merge core-8-branch check-in: 70e385378b user: pooryorick tags: bug-e593adf103-core-8
09:51
Fix memory leak in Tcl_DeleteNamespace. check-in: 3bf9010413 user: pooryorick tags: bug-e593adf103-core-8
2018-05-11
11:52
merge 8.7 check-in: 78ab648e4f user: dgp tags: bug-e593adf103-core-8
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to generic/tclNamesp.c.

1069
1070
1071
1072
1073
1074
1075

1076
1077
1078
1079
1080
1081
1082
		cmds[i] = Tcl_GetHashValue(entryPtr);
		cmds[i]->refCount++;
		i++;
	    }
	    for (i = 0 ; i < length ; i++) {
		Tcl_DeleteCommandFromToken((Tcl_Interp *) iPtr,
			(Tcl_Command) cmds[i]);

	    }
	    TclStackFree((Tcl_Interp *) iPtr, cmds);
	}

	/*
	 * Destroying the namespace's variable table, which may trigger traces.
	 * Variable table should be cleared but not freed!






>







1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
		cmds[i] = Tcl_GetHashValue(entryPtr);
		cmds[i]->refCount++;
		i++;
	    }
	    for (i = 0 ; i < length ; i++) {
		Tcl_DeleteCommandFromToken((Tcl_Interp *) iPtr,
			(Tcl_Command) cmds[i]);
		TclCleanupCommandMacro(cmds[i]);
	    }
	    TclStackFree((Tcl_Interp *) iPtr, cmds);
	}

	/*
	 * Destroying the namespace's variable table, which may trigger traces.
	 * Variable table should be cleared but not freed!

Changes to tests/interp.test.

15
16
17
18
19
20
21


















22
23
24
25
26
27
28
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

testConstraint testinterpdelete [llength [info commands testinterpdelete]]



















set hidden_cmds {cd encoding exec exit fconfigure file glob load open pwd socket source tcl:encoding:dirs tcl:file:atime tcl:file:attributes tcl:file:copy tcl:file:delete tcl:file:dirname tcl:file:executable tcl:file:exists tcl:file:extension tcl:file:isdirectory tcl:file:isfile tcl:file:link tcl:file:lstat tcl:file:mkdir tcl:file:mtime tcl:file:nativename tcl:file:normalize tcl:file:owned tcl:file:readable tcl:file:readlink tcl:file:rename tcl:file:rootname tcl:file:size tcl:file:stat tcl:file:tail tcl:file:tempfile tcl:file:type tcl:file:volumes tcl:file:writable unload}

foreach i [interp slaves] {
  interp delete $i
}







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







15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

testConstraint testinterpdelete [llength [info commands testinterpdelete]]

testConstraint memory [llength [info commands memory]]
if {[testConstraint memory]} {
    proc getbytes {} {
	set lines [split [memory info] \n]
	return [lindex $lines 3 3]
    }
    proc leaktest {script {iterations 3}} {
	set end [getbytes]
	for {set i 0} {$i < $iterations} {incr i} {
	    uplevel 1 $script
	    set tmp $end
	    set end [getbytes]
	}
	return [expr {$end - $tmp}]
    }
}


set hidden_cmds {cd encoding exec exit fconfigure file glob load open pwd socket source tcl:encoding:dirs tcl:file:atime tcl:file:attributes tcl:file:copy tcl:file:delete tcl:file:dirname tcl:file:executable tcl:file:exists tcl:file:extension tcl:file:isdirectory tcl:file:isfile tcl:file:link tcl:file:lstat tcl:file:mkdir tcl:file:mtime tcl:file:nativename tcl:file:normalize tcl:file:owned tcl:file:readable tcl:file:readlink tcl:file:rename tcl:file:rootname tcl:file:size tcl:file:stat tcl:file:tail tcl:file:tempfile tcl:file:type tcl:file:volumes tcl:file:writable unload}

foreach i [interp slaves] {
  interp delete $i
}

878
879
880
881
882
883
884









885
886
887
888
889
890
891
    list [catch {tst eval {suicide; set a 5}} msg] $msg
} {1 {attempt to call eval in deleted interpreter}}
test interp-18.10 {eval in deleted interp, bug 495830} {
    interp create tst
    interp alias tst suicide {} interp delete tst
    list [catch {tst eval {set set set; suicide; $set a 5}} msg] $msg
} {1 {attempt to call eval in deleted interpreter}}










# Test alias deletion

test interp-19.1 {alias deletion} {
    catch {interp delete a}
    interp create a
    interp alias a foo a bar






>
>
>
>
>
>
>
>
>







896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
    list [catch {tst eval {suicide; set a 5}} msg] $msg
} {1 {attempt to call eval in deleted interpreter}}
test interp-18.10 {eval in deleted interp, bug 495830} {
    interp create tst
    interp alias tst suicide {} interp delete tst
    list [catch {tst eval {set set set; suicide; $set a 5}} msg] $msg
} {1 {attempt to call eval in deleted interpreter}}

test interp-10.11 {test for leaks in simple creation/deletion} -setup {
} -constraints memory -body {
    leaktest {
	interp create slave
	interp delete slave
    }
} -cleanup {
} -result 0

# Test alias deletion

test interp-19.1 {alias deletion} {
    catch {interp delete a}
    interp create a
    interp alias a foo a bar