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 | trunk |
| Files: | files | file ages | folders |
| SHA1: |
ade314d8cf5fe3105820be104cdc40b4 |
| User & Date: | dgp 2013-07-24 16:56:59 |
Context
|
2013-07-25
| ||
| 06:59 | Put Cygwin's tclWinError.o in PLAT_OBJS, not in DL_OBJS check-in: 53be2bce4e user: jan.nijtmans tags: trunk | |
|
2013-07-24
| ||
| 17:15 | Remove all unneeded handling of the TCL_TOKEN_COMMAND token type. Add comment explaining the handlin... check-in: dd09c7e820 user: dgp tags: dgp-refactor | |
| 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 | |
| 13:58 | Mark commands with potential to compile expansion arguments (as [list] does). check-in: 2a890ec41a user: dgp tags: trunk | |
Changes
Changes to generic/tclParse.c.
| ︙ | ︙ | |||
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);
TclStackFree(interp, parsePtr);
if (code != TCL_OK) {
return NULL;
}
objPtr = Tcl_GetObjResult(interp);
/*
| > | 1563 1564 1565 1566 1567 1568 1569 1570 1571 1572 1573 1574 1575 1576 1577 |
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.
| ︙ | ︙ | |||
23 24 25 26 27 28 29 30 31 32 33 34 35 36 |
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 testevent [llength [info commands testevent]]
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 {}}
| > | 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 |
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 testevent [llength [info commands testevent]]
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 {}}
|
| ︙ | ︙ | |||
674 675 676 677 678 679 680 681 682 683 684 685 686 687 |
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 {}}
| > > > > > > > > > > > > > > > > > > > > | 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 705 706 707 708 |
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 {}}
|
| ︙ | ︙ |