Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
| Comment: | New "string" subcommands: "nextchar", "nextword", "prevchar", "prevword". Not implemented yet (for now same as "wordstart"/"wordend"). Deprecate "string bytelength". |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | tip-575 |
| Files: | files | file ages | folders |
| SHA3-256: |
04d41e57ba43b86e764c673cdf2766d0 |
| User & Date: | jan.nijtmans 2020-05-22 15:27:43 |
Context
|
2020-05-22
| ||
| 21:28 | Split more "string" functions. New helper function TclUniCharToUCS4(), not used yet but that's the n... check-in: ec03d6f62d user: jan.nijtmans tags: tip-575 | |
| 15:27 | New "string" subcommands: "nextchar", "nextword", "prevchar", "prevword". Not implemented yet (for n... check-in: 04d41e57ba user: jan.nijtmans tags: tip-575 | |
| 14:36 | Merge 8.7 Add function Tcl_UniCharFold(). It's the same as Tcl_UniCharToLower() for now, but that wi... check-in: c338858460 user: jan.nijtmans tags: tip-575 | |
Changes
Changes to generic/tclCmdMZ.c.
2827 2828 2829 2830 2831 2832 2833 2834 2835 2836 2837 2838 2839 2840 .... 2845 2846 2847 2848 2849 2850 2851 2852 2853 2854 2855 2856 2857 2858 .... 3301 3302 3303 3304 3305 3306 3307 3308 3309 3310 3311 3312 3313 3314 3315 3316 3317 3318 3319 3320 3321 3322 3323 3324 3325 3326 |
* A standard Tcl result.
*
* Side effects:
* See the user documentation.
*
*----------------------------------------------------------------------
*/
static int
StringBytesCmd(
TCL_UNUSED(ClientData),
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
................................................................................
return TCL_ERROR;
}
(void) TclGetStringFromObj(objv[1], &length);
Tcl_SetObjResult(interp, Tcl_NewWideIntObj(length));
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
* StringLenCmd --
*
* This procedure is invoked to process the "string length" Tcl command.
................................................................................
*/
Tcl_Command
TclInitStringCmd(
Tcl_Interp *interp) /* Current interpreter. */
{
static const EnsembleImplMap stringImplMap[] = {
{"bytelength", StringBytesCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
{"cat", StringCatCmd, TclCompileStringCatCmd, NULL, NULL, 0},
{"compare", StringCmpCmd, TclCompileStringCmpCmd, NULL, NULL, 0},
{"equal", StringEqualCmd, TclCompileStringEqualCmd, NULL, NULL, 0},
{"first", StringFirstCmd, TclCompileStringFirstCmd, NULL, NULL, 0},
{"index", StringIndexCmd, TclCompileStringIndexCmd, NULL, NULL, 0},
{"insert", StringInsertCmd, TclCompileStringInsertCmd, NULL, NULL, 0},
{"is", StringIsCmd, TclCompileStringIsCmd, NULL, NULL, 0},
{"last", StringLastCmd, TclCompileStringLastCmd, NULL, NULL, 0},
{"length", StringLenCmd, TclCompileStringLenCmd, NULL, NULL, 0},
{"map", StringMapCmd, TclCompileStringMapCmd, NULL, NULL, 0},
{"match", StringMatchCmd, TclCompileStringMatchCmd, NULL, NULL, 0},
{"range", StringRangeCmd, TclCompileStringRangeCmd, NULL, NULL, 0},
{"repeat", StringReptCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0},
{"replace", StringRplcCmd, TclCompileStringReplaceCmd, NULL, NULL, 0},
{"reverse", StringRevCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
{"tolower", StringLowerCmd, TclCompileStringToLowerCmd, NULL, NULL, 0},
{"toupper", StringUpperCmd, TclCompileStringToUpperCmd, NULL, NULL, 0},
{"totitle", StringTitleCmd, TclCompileStringToTitleCmd, NULL, NULL, 0},
|
> > > > > > > > |
2827 2828 2829 2830 2831 2832 2833 2834 2835 2836 2837 2838 2839 2840 2841 .... 2846 2847 2848 2849 2850 2851 2852 2853 2854 2855 2856 2857 2858 2859 2860 .... 3303 3304 3305 3306 3307 3308 3309 3310 3311 3312 3313 3314 3315 3316 3317 3318 3319 3320 3321 3322 3323 3324 3325 3326 3327 3328 3329 3330 3331 3332 3333 3334 |
* A standard Tcl result. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ #if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 static int StringBytesCmd( TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { ................................................................................ return TCL_ERROR; } (void) TclGetStringFromObj(objv[1], &length); Tcl_SetObjResult(interp, Tcl_NewWideIntObj(length)); return TCL_OK; } #endif /* *---------------------------------------------------------------------- * * StringLenCmd -- * * This procedure is invoked to process the "string length" Tcl command. ................................................................................ */ Tcl_Command TclInitStringCmd( Tcl_Interp *interp) /* Current interpreter. */ { static const EnsembleImplMap stringImplMap[] = { #if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 {"bytelength", StringBytesCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, #endif {"cat", StringCatCmd, TclCompileStringCatCmd, NULL, NULL, 0}, {"compare", StringCmpCmd, TclCompileStringCmpCmd, NULL, NULL, 0}, {"equal", StringEqualCmd, TclCompileStringEqualCmd, NULL, NULL, 0}, {"first", StringFirstCmd, TclCompileStringFirstCmd, NULL, NULL, 0}, {"index", StringIndexCmd, TclCompileStringIndexCmd, NULL, NULL, 0}, {"insert", StringInsertCmd, TclCompileStringInsertCmd, NULL, NULL, 0}, {"is", StringIsCmd, TclCompileStringIsCmd, NULL, NULL, 0}, {"last", StringLastCmd, TclCompileStringLastCmd, NULL, NULL, 0}, {"length", StringLenCmd, TclCompileStringLenCmd, NULL, NULL, 0}, {"map", StringMapCmd, TclCompileStringMapCmd, NULL, NULL, 0}, {"match", StringMatchCmd, TclCompileStringMatchCmd, NULL, NULL, 0}, {"nextchar", StringEndCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0}, {"nextword", StringEndCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0}, {"prevchar", StringStartCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0}, {"prevword", StringStartCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0}, {"range", StringRangeCmd, TclCompileStringRangeCmd, NULL, NULL, 0}, {"repeat", StringReptCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0}, {"replace", StringRplcCmd, TclCompileStringReplaceCmd, NULL, NULL, 0}, {"reverse", StringRevCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, {"tolower", StringLowerCmd, TclCompileStringToLowerCmd, NULL, NULL, 0}, {"toupper", StringUpperCmd, TclCompileStringToUpperCmd, NULL, NULL, 0}, {"totitle", StringTitleCmd, TclCompileStringToTitleCmd, NULL, NULL, 0}, |
Changes to tests/info.test.
99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 |
eval [info body foo]
} -returnCodes error -result {can't read "args": no such variable}
# Fix for problem tested for in info-2.5 caused problems when
# procedure body had no string rep (i.e. was not yet bytecode)
# causing an empty string to be returned [Bug #545644]
test info-2.6 {info body option, returning list bodies} {
proc foo args [list subst bar]
list [string bytelength [info body foo]] \
[foo; string bytelength [info body foo]]
} {9 9}
proc testinfocmdcount {} {
set x [info cmdcount]
set y 12345
set z [info cmdc]
expr {$z-$x}
|
| | |
99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 |
eval [info body foo]
} -returnCodes error -result {can't read "args": no such variable}
# Fix for problem tested for in info-2.5 caused problems when
# procedure body had no string rep (i.e. was not yet bytecode)
# causing an empty string to be returned [Bug #545644]
test info-2.6 {info body option, returning list bodies} {
proc foo args [list subst bar]
list [string length [info body foo]] \
[foo; string length [info body foo]]
} {9 9}
proc testinfocmdcount {} {
set x [info cmdcount]
set y 12345
set z [info cmdc]
expr {$z-$x}
|
Changes to tests/regexp.test.
756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 |
test regexp-20.1 {regsub shared object shimmering} -body {
# Bug #461322
set a abcdefghijklmnopqurstuvwxyz
set b $a
set c abcdefghijklmnopqurstuvwxyz0123456789
regsub $a $c $b d
list $d [string length $d] [string bytelength $d]
} -result [list abcdefghijklmnopqurstuvwxyz0123456789 37 37]
test regexp-20.2 {regsub shared object shimmering with -about} -body {
eval regexp -about abc
} -result {0 {}}
test regexp-21.1 {regsub works with empty string} -body {
regsub -- ^ {} foo
} -result {foo}
|
| | |
756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 |
test regexp-20.1 {regsub shared object shimmering} -body {
# Bug #461322
set a abcdefghijklmnopqurstuvwxyz
set b $a
set c abcdefghijklmnopqurstuvwxyz0123456789
regsub $a $c $b d
list $d [string length $d]
} -result [list abcdefghijklmnopqurstuvwxyz0123456789 37]
test regexp-20.2 {regsub shared object shimmering with -about} -body {
eval regexp -about abc
} -result {0 {}}
test regexp-21.1 {regsub works with empty string} -body {
regsub -- ^ {} foo
} -result {foo}
|
Changes to tests/regexpComp.test.
794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 |
test regexpComp-20.1 {regsub shared object shimmering} {
evalInProc {
# Bug #461322
set a abcdefghijklmnopqurstuvwxyz
set b $a
set c abcdefghijklmnopqurstuvwxyz0123456789
regsub $a $c $b d
list $d [string length $d] [string bytelength $d]
}
} [list abcdefghijklmnopqurstuvwxyz0123456789 37 37]
test regexpComp-20.2 {regsub shared object shimmering with -about} {
evalInProc {
eval regexp -about abc
}
} {0 {}}
test regexpComp-21.1 {regexp command compiling tests} {
|
| | |
794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 |
test regexpComp-20.1 {regsub shared object shimmering} {
evalInProc {
# Bug #461322
set a abcdefghijklmnopqurstuvwxyz
set b $a
set c abcdefghijklmnopqurstuvwxyz0123456789
regsub $a $c $b d
list $d [string length $d]
}
} [list abcdefghijklmnopqurstuvwxyz0123456789 37]
test regexpComp-20.2 {regsub shared object shimmering with -about} {
evalInProc {
eval regexp -about abc
}
} {0 {}}
test regexpComp-21.1 {regexp command compiling tests} {
|
Changes to tests/string.test.
29 30 31 32 33 34 35 36 37 38 39 40 41 42 .. 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 .... 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 .... 1795 1796 1797 1798 1799 1800 1801 1802 1803 1804 1805 1806 1807 1808 1809 1810 1811 .... 1890 1891 1892 1893 1894 1895 1896 1897 1898 1899 1900 1901 1902 1903 1904 |
# Some tests require the testobj command
testConstraint testobj [expr {[info commands testobj] ne {}}]
testConstraint testindexobj [expr {[info commands testindexobj] ne {}}]
testConstraint testevalex [expr {[info commands testevalex] ne {}}]
testConstraint utf16 [expr {[string length \U010000] == 2}]
testConstraint testbytestring [llength [info commands testbytestring]]
# Used for constraining memory leak tests
testConstraint memory [llength [info commands memory]]
if {[testConstraint memory]} {
proc getbytes {} {
set lines [split [memory info] \n]
return [lindex $lines 3 3]
................................................................................
set constraints testevalex
} else {
interp alias {} run {} try
set constraints {}
}
test string-1.1.$noComp {error conditions} {
list [catch {run {string gorp a b}} msg] $msg
} {1 {unknown or ambiguous subcommand "gorp": must be bytelength, cat, compare, equal, first, index, insert, is, last, length, map, match, range, repeat, replace, reverse, tolower, totitle, toupper, trim, trimleft, trimright, wordend, or wordstart}}
test string-1.2.$noComp {error conditions} {
list [catch {run {string}} msg] $msg
} {1 {wrong # args: should be "string subcommand ?arg ...?"}}
test stringComp-1.3.$noComp {error condition - undefined method during compile} {
# We don't want this to complain about 'never' because it may never
# be called, or string may get redefined. This must compile OK.
proc foo {str i} {
................................................................................
test string-7.15.$noComp {string last, start index} {
run {string last \334a \334ad\334ad 0}
} -1
test string-7.16.$noComp {string last, start index} {
run {string last \334a \334ad\334ad end-1}
} 3
test string-8.1.$noComp {string bytelength} {
list [catch {run {string bytelength}} msg] $msg
} {1 {wrong # args: should be "string bytelength string"}}
test string-8.2.$noComp {string bytelength} {
list [catch {run {string bytelength a b}} msg] $msg
} {1 {wrong # args: should be "string bytelength string"}}
test string-8.3.$noComp {string bytelength} {
run {string bytelength "\xC7"}
} 2
test string-8.4.$noComp {string bytelength} {
run {string b ""}
} 0
test string-9.1.$noComp {string length} {
list [catch {run {string length}} msg] $msg
} {1 {wrong # args: should be "string length string"}}
test string-9.2.$noComp {string length} {
................................................................................
test string-19.3.$noComp {string trimleft, unicode default} {
run {string trimleft \uFEFF\x85\xA0\x00\u1680\u180E\u2000\u2001\u2002\u2003\u2004\u2005\u2006\u2007\u2008\u2009\u200A\u200B\u2028\u2029\u202F\u205F\u3000\u1361ABC}
} \u1361ABC
test string-20.1.$noComp {string trimright errors} {
list [catch {run {string trimright}} msg] $msg
} {1 {wrong # args: should be "string trimright string ?chars?"}}
test string-20.2.$noComp {string trimright errors} {
list [catch {run {string trimg a}} msg] $msg
} {1 {unknown or ambiguous subcommand "trimg": must be bytelength, cat, compare, equal, first, index, insert, is, last, length, map, match, range, repeat, replace, reverse, tolower, totitle, toupper, trim, trimleft, trimright, wordend, or wordstart}}
test string-20.3.$noComp {string trimright} {
run {string trimright " XYZ "}
} { XYZ}
test string-20.4.$noComp {string trimright} {
run {string trimright " "}
} {}
test string-20.5.$noComp {string trimright} {
................................................................................
} -result 2
test string-21.16.$noComp {string wordend, unicode} -constraints utf16 -body {
run {string wordend "\U1D7CA\U1D7CA abc" 10}
} -result 8
test string-22.1.$noComp {string wordstart} -body {
list [catch {run {string word a}} msg] $msg
} -result {1 {unknown or ambiguous subcommand "word": must be bytelength, cat, compare, equal, first, index, insert, is, last, length, map, match, range, repeat, replace, reverse, tolower, totitle, toupper, trim, trimleft, trimright, wordend, or wordstart}}
test string-22.2.$noComp {string wordstart} -body {
list [catch {run {string wordstart a}} msg] $msg
} -result {1 {wrong # args: should be "string wordstart string index"}}
test string-22.3.$noComp {string wordstart} -body {
list [catch {run {string wordstart a b c}} msg] $msg
} -result {1 {wrong # args: should be "string wordstart string index"}}
test string-22.4.$noComp {string wordstart} -body {
|
> | | | | | | | | | |
29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 .. 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 .... 1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 .... 1796 1797 1798 1799 1800 1801 1802 1803 1804 1805 1806 1807 1808 1809 1810 1811 1812 .... 1891 1892 1893 1894 1895 1896 1897 1898 1899 1900 1901 1902 1903 1904 1905 |
# Some tests require the testobj command
testConstraint testobj [expr {[info commands testobj] ne {}}]
testConstraint testindexobj [expr {[info commands testindexobj] ne {}}]
testConstraint testevalex [expr {[info commands testevalex] ne {}}]
testConstraint utf16 [expr {[string length \U010000] == 2}]
testConstraint testbytestring [llength [info commands testbytestring]]
testConstraint nodep [info exists tcl_precision]
# Used for constraining memory leak tests
testConstraint memory [llength [info commands memory]]
if {[testConstraint memory]} {
proc getbytes {} {
set lines [split [memory info] \n]
return [lindex $lines 3 3]
................................................................................
set constraints testevalex
} else {
interp alias {} run {} try
set constraints {}
}
test string-1.1.$noComp {error conditions} -body {
list [catch {run {string gorp a b}} msg] $msg
} -match regexp -result {1 {unknown or ambiguous subcommand "gorp": must be (bytelength, |)cat, compare, equal, first, index, insert, is, last, length, map, match, nextchar, nextword, prevchar, prevword, range, repeat, replace, reverse, tolower, totitle, toupper, trim, trimleft, trimright, wordend, or wordstart}}
test string-1.2.$noComp {error conditions} {
list [catch {run {string}} msg] $msg
} {1 {wrong # args: should be "string subcommand ?arg ...?"}}
test stringComp-1.3.$noComp {error condition - undefined method during compile} {
# We don't want this to complain about 'never' because it may never
# be called, or string may get redefined. This must compile OK.
proc foo {str i} {
................................................................................
test string-7.15.$noComp {string last, start index} {
run {string last \334a \334ad\334ad 0}
} -1
test string-7.16.$noComp {string last, start index} {
run {string last \334a \334ad\334ad end-1}
} 3
test string-8.1.$noComp {string bytelength} nodep {
list [catch {run {string bytelength}} msg] $msg
} {1 {wrong # args: should be "string bytelength string"}}
test string-8.2.$noComp {string bytelength} nodep {
list [catch {run {string bytelength a b}} msg] $msg
} {1 {wrong # args: should be "string bytelength string"}}
test string-8.3.$noComp {string bytelength} nodep {
run {string bytelength "\xC7"}
} 2
test string-8.4.$noComp {string bytelength} nodep {
run {string b ""}
} 0
test string-9.1.$noComp {string length} {
list [catch {run {string length}} msg] $msg
} {1 {wrong # args: should be "string length string"}}
test string-9.2.$noComp {string length} {
................................................................................
test string-19.3.$noComp {string trimleft, unicode default} {
run {string trimleft \uFEFF\x85\xA0\x00\u1680\u180E\u2000\u2001\u2002\u2003\u2004\u2005\u2006\u2007\u2008\u2009\u200A\u200B\u2028\u2029\u202F\u205F\u3000\u1361ABC}
} \u1361ABC
test string-20.1.$noComp {string trimright errors} {
list [catch {run {string trimright}} msg] $msg
} {1 {wrong # args: should be "string trimright string ?chars?"}}
test string-20.2.$noComp {string trimright errors} -body {
list [catch {run {string trimg a}} msg] $msg
} -match regexp -result {1 {unknown or ambiguous subcommand "trimg": must be (bytelength, |)cat, compare, equal, first, index, insert, is, last, length, map, match, nextchar, nextword, prevchar, prevword, range, repeat, replace, reverse, tolower, totitle, toupper, trim, trimleft, trimright, wordend, or wordstart}}
test string-20.3.$noComp {string trimright} {
run {string trimright " XYZ "}
} { XYZ}
test string-20.4.$noComp {string trimright} {
run {string trimright " "}
} {}
test string-20.5.$noComp {string trimright} {
................................................................................
} -result 2
test string-21.16.$noComp {string wordend, unicode} -constraints utf16 -body {
run {string wordend "\U1D7CA\U1D7CA abc" 10}
} -result 8
test string-22.1.$noComp {string wordstart} -body {
list [catch {run {string word a}} msg] $msg
} -match regexp -result {1 {unknown or ambiguous subcommand "word": must be (bytelength, |)cat, compare, equal, first, index, insert, is, last, length, map, match, nextchar, nextword, prevchar, prevword, range, repeat, replace, reverse, tolower, totitle, toupper, trim, trimleft, trimright, wordend, or wordstart}}
test string-22.2.$noComp {string wordstart} -body {
list [catch {run {string wordstart a}} msg] $msg
} -result {1 {wrong # args: should be "string wordstart string index"}}
test string-22.3.$noComp {string wordstart} -body {
list [catch {run {string wordstart a b c}} msg] $msg
} -result {1 {wrong # args: should be "string wordstart string index"}}
test string-22.4.$noComp {string wordstart} -body {
|