Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
| Comment: | Add tests to exercise almost every line of TclStringReplace(). The one line not being exercised is the "return NULL" on TclStringCatObjv() failure. Coverage checked in an ad-hoc way by putting a breakpoint at the start of every basic block, then confirming each breakpoint is hit at least once when running string.test. |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | amg-string-insert |
| Files: | files | file ages | folders |
| SHA1: |
eb2821be09e07a20408d6a04e41cdfaf |
| User & Date: | andy 2017-08-20 19:57:43 |
Context
|
2017-08-20
| ||
| 20:11 | Add test cleanup check-in: 5f8c346dfb user: andy tags: amg-string-insert | |
| 19:57 | Add tests to exercise almost every line of TclStringReplace(). The one line not being exercised is ... check-in: eb2821be09 user: andy tags: amg-string-insert | |
| 19:55 | Tweak string index boundary conditionals for tiny performance improvement and to make existing tests... check-in: 025ea6e5be user: andy tags: amg-string-insert | |
Changes
Changes to tests/string.test.
| ︙ | ︙ | |||
16 17 18 19 20 21 22 23 24 25 26 27 28 29 |
package require tcltest
namespace import -force ::tcltest::*
}
::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]
# Some tests require the testobj command
testConstraint testobj [expr {[info commands testobj] != {}}]
testConstraint testindexobj [expr {[info commands testindexobj] != {}}]
# Used for constraining memory leak tests
testConstraint memory [llength [info commands memory]]
| > > > > > > | 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 |
package require tcltest
namespace import -force ::tcltest::*
}
::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]
# Helper commands to test various optimizations, code paths, and special cases.
proc makeByteArray {s} {binary format a* $s}
proc makeUnicode {s} {lindex [regexp -inline .* $s] 0}
proc makeList {args} {return $args}
proc makeShared {s} {uplevel 1 [list lappend copy $s]; return $s}
# Some tests require the testobj command
testConstraint testobj [expr {[info commands testobj] != {}}]
testConstraint testindexobj [expr {[info commands testindexobj] != {}}]
# Used for constraining memory leak tests
testConstraint memory [llength [info commands memory]]
|
| ︙ | ︙ | |||
1421 1422 1423 1424 1425 1426 1427 1428 1429 1430 1431 1432 1433 1434 |
} {abcdefghijklmnop}
test string-14.18 {string replace} {
string replace abcdefghijklmnop 10 9 XXX
} {abcdefghijklmnop}
test string-14.18.1 {string replace non-bytecode} {
{*}[list string replace] abcdefghijklmnop 10 9 XXX
} {abcdefghijklmnop}
test string-15.1 {string tolower too few args} {
list [catch {string tolower} msg] $msg
} {1 {wrong # args: should be "string tolower string ?first? ?last?"}}
test string-15.2 {string tolower bad args} {
list [catch {string tolower a b} msg] $msg
} {1 {bad index "b": must be integer?[+-]integer? or end?[+-]integer?}}
| > > > > > > > > | 1427 1428 1429 1430 1431 1432 1433 1434 1435 1436 1437 1438 1439 1440 1441 1442 1443 1444 1445 1446 1447 1448 |
} {abcdefghijklmnop}
test string-14.18 {string replace} {
string replace abcdefghijklmnop 10 9 XXX
} {abcdefghijklmnop}
test string-14.18.1 {string replace non-bytecode} {
{*}[list string replace] abcdefghijklmnop 10 9 XXX
} {abcdefghijklmnop}
test string-14.19 {string replace} {
string replace [makeByteArray abcdefghijklmnop] end-10 end-2\
[makeByteArray NEW]
} {abcdeNEWop}
test string-14.19.1 {string replace non-bytecode} {
{*}[list tcl::string::replace] [makeByteArray abcdefghijklmnop]\
end-10 end-2 [makeByteArray NEW]
} {abcdeNEWop}
test string-15.1 {string tolower too few args} {
list [catch {string tolower} msg] $msg
} {1 {wrong # args: should be "string tolower string ?first? ?last?"}}
test string-15.2 {string tolower bad args} {
list [catch {string tolower a b} msg] $msg
} {1 {bad index "b": must be integer?[+-]integer? or end?[+-]integer?}}
|
| ︙ | ︙ | |||
2127 2128 2129 2130 2131 2132 2133 |
test string-30.10 {string insert, negative index} {
tcl::string::insert 0123 -1 _
} _0123
test string-30.11 {string insert, index beyond end} {
tcl::string::insert 0123 5 _
} 0123_
test string-30.12 {string insert, start of string, pure byte array} {
| | | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | > > > > | 2141 2142 2143 2144 2145 2146 2147 2148 2149 2150 2151 2152 2153 2154 2155 2156 2157 2158 2159 2160 2161 2162 2163 2164 2165 2166 2167 2168 2169 2170 2171 2172 2173 2174 2175 2176 2177 2178 2179 2180 2181 2182 2183 2184 2185 2186 2187 2188 2189 2190 2191 2192 2193 2194 2195 2196 2197 2198 2199 2200 |
test string-30.10 {string insert, negative index} {
tcl::string::insert 0123 -1 _
} _0123
test string-30.11 {string insert, index beyond end} {
tcl::string::insert 0123 5 _
} 0123_
test string-30.12 {string insert, start of string, pure byte array} {
tcl::string::insert [makeByteArray 0123] 0 [makeByteArray _]
} _0123
test string-30.13 {string insert, middle of string, pure byte array} {
tcl::string::insert [makeByteArray 0123] 2 [makeByteArray _]
} 01_23
test string-30.14 {string insert, end of string, pure byte array} {
tcl::string::insert [makeByteArray 0123] 4 [makeByteArray _]
} 0123_
test string-30.15 {string insert, pure byte array, neither shared} {
tcl::string::insert [makeByteArray 0123] 2 [makeByteArray _]
} 01_23
test string-30.16 {string insert, pure byte array, first shared} {
tcl::string::insert [makeShared [makeByteArray 0123]] 2 [makeByteArray _]
} 01_23
test string-30.17 {string insert, pure byte array, second shared} {
tcl::string::insert [makeByteArray 0123] 2 [makeShared [makeByteArray _]]
} 01_23
test string-30.18 {string insert, pure byte array, both shared} {
tcl::string::insert [makeShared [makeByteArray 0123]] 2\
[makeShared [makeByteArray _]]
} 01_23
test string-30.19 {string insert, start of string, pure Unicode} {
tcl::string::insert [makeUnicode 0123] 0 [makeUnicode _]
} _0123
test string-30.20 {string insert, middle of string, pure Unicode} {
tcl::string::insert [makeUnicode 0123] 2 [makeUnicode _]
} 01_23
test string-30.21 {string insert, end of string, pure Unicode} {
tcl::string::insert [makeUnicode 0123] 4 [makeUnicode _]
} 0123_
test string-30.22 {string insert, start of string, pure Unicode, first shared} {
tcl::string::insert [makeShared [makeUnicode 0123]] 0 [makeUnicode _]
} _0123
test string-30.23 {string insert, middle of string, pure Unicode, 2nd shared} {
tcl::string::insert [makeUnicode 0123] 2 [makeShared [makeUnicode _]]
} 01_23
test string-30.24 {string insert, end of string, pure Unicode, both shared} {
tcl::string::insert [makeShared [makeUnicode 0123]] 4\
[makeShared [makeUnicode _]]
} 0123_
test string-30.25 {string insert, neither byte array nor Unicode} {
tcl::string::insert [makeList a b c] 1 zzzzzz
} {azzzzzz b c}
# cleanup
rename MemStress {}
catch {rename foo {}}
::tcltest::cleanupTests
return
# Local Variables:
# mode: tcl
# End:
|