1 2 3 4 5 6 7 8 9 10 11 12 13 14 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 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172
|
# stack.test: tests for the stack package.
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands. Sourcing this file into Tcl runs the tests and
# generates output for errors. No output means no errors were found.
#
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
namespace import ::tcltest::*
}
if { [ lsearch [ namespace children ] "::textutil" ] == -1 } then {
source [file join [file dirname [info script]] textutil.tcl]
}
###################################################
test trim-0.1 {trim string on left} {
set str [ ::textutil::trimleft "\t\t hello, world \t " ]
set str
} "hello, world \t "
test trim-0.2 {trim string on right} {
set str [ ::textutil::trimright "\t\t hello, world \t " ]
set str
} "\t\t hello, world"
test trim-0.3 {trim string on both side} {
set str [ ::textutil::trim "\t\t hello, world \t " ]
set str
} "hello, world"
test trim-0.4 {trim string with embedded spaces and tabs on both side} {
set str [ ::textutil::trim "\t\t hello, \t\t world \t " ]
set str
} "hello, \t\t world"
test trim-1.1 {trim text on left} {
set str [ ::textutil::trimleft "\t\t hello, \t\n \tworld \t " ]
set str
} "hello, \t
world \t "
test trim-1.2 {trim text on right} {
set str [ ::textutil::trimright "\t\t hello, \t\n \tworld \t " ]
set str
} "\t\t hello,
\tworld"
test trim-1.3 {trim string on both side} {
set str [ ::textutil::trim "\t\t hello, \t\n \tworld \t " ]
set str
} "hello,
world"
test trim-1.4 {trim string with embedded spaces and tabs on both side} {
set str [ ::textutil::trim "\t\t hello\t \t, \t\n \tthe\t \t world \t " ]
set str
} "hello\t \t,
the\t \t world"
test trim-2.1 {trim text on left with regexp} {
set str [ ::textutil::trimleft "\t\t hello, \t\n \tworld \t " "\[ \thwdo\]+" ]
set str
} "ello, \t
rld \t "
test trim-2.2 {trim text on right} {
set str [ ::textutil::trimright "\t\t hello, \t\n \tworld \t " "\[ \thwdo\]+" ]
set str
} "\t\t hello,
\tworl"
test trim-2.3 {trim string on both side} {
set str [ ::textutil::trim "\t\t hello, \t\n \tworld \t " "\[ \thwdo\]+" ]
set str
} "ello,
rl"
test trim-2.4 {trim string with embedded spaces and tabs on both side} {
set str [ ::textutil::trim "\t\t hello\t \t, \t\n \tthe\t \t world \t " "\[ \thwdo\]+" ]
set str
} "ello\t \t,
the\t \t worl"
# Not the real parray proc, because the default value of pattern is intentionnally omitted
set myparray "\t \tproc myparray {a pattern} {
# print nicely an associated array sorted by element
upvar 1 \$a array \t
if {!\[array exists array\]} {
error \"\\\"\$a\\\" isn't an array\" \t
}
set maxl 0 ; # used to find the longest name of element
foreach name \[lsort \[array names array \$pattern\]\] {
if {\[string length \$name\] > \$maxl} { \t\t\t
set maxl \[string length \$name\]
}
}
set maxl \[expr {\$maxl + \[string length \$a\] + 2}\] \t
foreach name \[lsort \[array names array \$pattern\]\] {
set nameString \[format %s(%s) \$a \$name\]
puts stdout \[format \"%-*s = %s\" \$maxl \$nameString \$array(\$name)\]
}
\t\t}\t\t"
test trim-3.1 {trim block of Tcl code} {
set code [ ::textutil::trim $myparray ]
set code
} "proc myparray {a pattern} {
# print nicely an associated array sorted by element
upvar 1 \$a array
if {!\[array exists array\]} {
error \"\\\"\$a\\\" isn't an array\"
}
set maxl 0 ; # used to find the longest name of element
foreach name \[lsort \[array names array \$pattern\]\] {
if {\[string length \$name\] > \$maxl} {
set maxl \[string length \$name\]
}
}
set maxl \[expr {\$maxl + \[string length \$a\] + 2}\]
foreach name \[lsort \[array names array \$pattern\]\] {
set nameString \[format %s(%s) \$a \$name\]
puts stdout \[format \"%-*s = %s\" \$maxl \$nameString \$array(\$name)\]
}
}"
test trim-3.2 {trim block of Tcl code with regexp} {
set code [ ::textutil::trim $myparray "\[\] \t{}pu\]+" ]
set code
} "roc myparray {a pattern
# print nicely an associated array sorted by element
var 1 \$a array
if {!\[array exists array
error \"\\\"\$a\\\" isn't an array\"
set maxl 0 ; # used to find the longest name of element
foreach name \[lsort \[array names array \$pattern
if {\[string length \$name\] > \$maxl
set maxl \[string length \$name
set maxl \[expr {\$maxl + \[string length \$a\] + 2
foreach name \[lsort \[array names array \$pattern
set nameString \[format %s(%s) \$a \$name
ts stdout \[format \"%-*s = %s\" \$maxl \$nameString \$array(\$name)
"
test trim-3.3 {trim block of commented Tcl code with regexp} {
set code [ ::textutil::trim $myparray "(\[ \t\]+)|(\[ \t;\]*#.*)" ]
set code
} "proc myparray {a pattern} {
upvar 1 \$a array
if {!\[array exists array\]} {
error \"\\\"\$a\\\" isn't an array\"
}
set maxl 0
foreach name \[lsort \[array names array \$pattern\]\] {
if {\[string length \$name\] > \$maxl} {
set maxl \[string length \$name\]
}
}
set maxl \[expr {\$maxl + \[string length \$a\] + 2}\]
foreach name \[lsort \[array names array \$pattern\]\] {
set nameString \[format %s(%s) \$a \$name\]
puts stdout \[format \"%-*s = %s\" \$maxl \$nameString \$array(\$name)\]
}
}"
|