Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
| Comment: | Demonstrate and fix memory leak in Tcl_ParseVar(). |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | core-8-5-branch |
| Files: | files | file ages | folders |
| SHA1: |
5cc898d5668b8e7faacd69aa8bd47b65 |
| User & Date: | dgp 2013-07-24 16:51:04 |
Context
|
2013-07-25
| ||
| 14:24 | Move test for pthread_atfork inside SC_ENABLE_THREADS check-in: f7fe2446ce user: jan.nijtmans tags: core-8-5-branch | |
| 07:02 | rebase check-in: c33b976db3 user: jan.nijtmans tags: rfe-notifier-fork | |
|
2013-07-24
| ||
| 16:56 | Demonstrate and fix memory leak in Tcl_ParseVar(). check-in: ade314d8cf user: dgp tags: trunk | |
| 16:51 | Demonstrate and fix memory leak in Tcl_ParseVar(). check-in: 5cc898d566 user: dgp tags: core-8-5-branch | |
|
2013-07-23
| ||
| 09:07 | Add "testfork" test command. Not used in any test-case yet check-in: b425245964 user: jan.nijtmans tags: core-8-5-branch | |
Changes
Changes to generic/tclParse.c.
| ︙ | ︙ | |||
1562 1563 1564 1565 1566 1567 1568 1569 1570 1571 1572 1573 1574 1575 |
TclStackFree(interp, parsePtr);
return "$";
}
code = TclSubstTokens(interp, parsePtr->tokenPtr, parsePtr->numTokens,
NULL, 1, NULL, NULL);
TclStackFree(interp, parsePtr);
if (code != TCL_OK) {
return NULL;
}
objPtr = Tcl_GetObjResult(interp);
/*
| > | 1562 1563 1564 1565 1566 1567 1568 1569 1570 1571 1572 1573 1574 1575 1576 |
TclStackFree(interp, parsePtr);
return "$";
}
code = TclSubstTokens(interp, parsePtr->tokenPtr, parsePtr->numTokens,
NULL, 1, NULL, NULL);
Tcl_FreeParse(parsePtr);
TclStackFree(interp, parsePtr);
if (code != TCL_OK) {
return NULL;
}
objPtr = Tcl_GetObjResult(interp);
/*
|
| ︙ | ︙ |
Changes to tests/parse.test.
| ︙ | ︙ | |||
19 20 21 22 23 24 25 26 27 28 29 30 31 32 |
testConstraint testparser [llength [info commands testparser]]
testConstraint testevalobjv [llength [info commands testevalobjv]]
testConstraint testevalex [llength [info commands testevalex]]
testConstraint testparsevarname [llength [info commands testparsevarname]]
testConstraint testparsevar [llength [info commands testparsevar]]
testConstraint testasync [llength [info commands testasync]]
testConstraint testcmdtrace [llength [info commands testcmdtrace]]
test parse-1.1 {Tcl_ParseCommand procedure, computing string length} testparser {
testparser [bytestring "foo\0 bar"] -1
} {- foo 1 simple foo 1 text foo 0 {}}
test parse-1.2 {Tcl_ParseCommand procedure, computing string length} testparser {
testparser "foo bar" -1
} {- {foo bar} 2 simple foo 1 text foo 0 simple bar 1 text bar 0 {}}
| > | 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 |
testConstraint testparser [llength [info commands testparser]]
testConstraint testevalobjv [llength [info commands testevalobjv]]
testConstraint testevalex [llength [info commands testevalex]]
testConstraint testparsevarname [llength [info commands testparsevarname]]
testConstraint testparsevar [llength [info commands testparsevar]]
testConstraint testasync [llength [info commands testasync]]
testConstraint testcmdtrace [llength [info commands testcmdtrace]]
testConstraint memory [llength [info commands memory]]
test parse-1.1 {Tcl_ParseCommand procedure, computing string length} testparser {
testparser [bytestring "foo\0 bar"] -1
} {- foo 1 simple foo 1 text foo 0 {}}
test parse-1.2 {Tcl_ParseCommand procedure, computing string length} testparser {
testparser "foo bar" -1
} {- {foo bar} 2 simple foo 1 text foo 0 simple bar 1 text bar 0 {}}
|
| ︙ | ︙ | |||
670 671 672 673 674 675 676 677 678 679 680 681 682 683 |
unset -nocomplain abc
list [catch {testparsevar {$abc}} msg] $msg
} {1 {can't read "abc": no such variable}}
test parse-13.5 {Tcl_ParseVar procedure, error looking up variable} testparsevar {
unset -nocomplain abc
list [catch {testparsevar {$abc([bogus x y z])}} msg] $msg
} {1 {invalid command name "bogus"}}
test parse-14.1 {Tcl_ParseBraces procedure, computing string length} testparser {
testparser [bytestring "foo\0 bar"] -1
} {- foo 1 simple foo 1 text foo 0 {}}
test parse-14.2 {Tcl_ParseBraces procedure, computing string length} testparser {
testparser "foo bar" -1
} {- {foo bar} 2 simple foo 1 text foo 0 simple bar 1 text bar 0 {}}
| > > > > > > > > > > > > > > > > > > > > | 671 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 |
unset -nocomplain abc
list [catch {testparsevar {$abc}} msg] $msg
} {1 {can't read "abc": no such variable}}
test parse-13.5 {Tcl_ParseVar procedure, error looking up variable} testparsevar {
unset -nocomplain abc
list [catch {testparsevar {$abc([bogus x y z])}} msg] $msg
} {1 {invalid command name "bogus"}}
test parse-13.6 {Tcl_ParseVar memory leak} -constraints memory -setup {
proc getbytes {} {
return [lindex [split [memory info] \n] 3 3]
}
} -body {
set a() foo
set end [getbytes]
for {set i 0} {$i < 5} {incr i} {
set vn {}
set res [testparsevar [append vn $ a([string repeat {[]} 19]) bar]]
if {$res ne {foo bar}} {error "Unexpected result: $res"}
set tmp $end
set end [getbytes]
}
expr {$end - $tmp}
} -cleanup {
unset -nocomplain a end i vn res tmp
rename getbytes {}
} -result 0
test parse-14.1 {Tcl_ParseBraces procedure, computing string length} testparser {
testparser [bytestring "foo\0 bar"] -1
} {- foo 1 simple foo 1 text foo 0 {}}
test parse-14.2 {Tcl_ParseBraces procedure, computing string length} testparser {
testparser "foo bar" -1
} {- {foo bar} 2 simple foo 1 text foo 0 simple bar 1 text bar 0 {}}
|
| ︙ | ︙ |