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
173
174
175
176
177
|
# -*- tcl -*-
# trim.test: tests for the trim command of the textutil 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.
#
# -------------------------------------------------------------------------
source [file join \
[file dirname [file dirname [file join [pwd] [info script]]]] \
devtools testutilities.tcl]
testsNeedTcl 8.5
testsNeedTcltest 1.0
testing {
useLocal trim.tcl textutil::trim
}
# -------------------------------------------------------------------------
test trim-0.1 {trim string on left} {
set str [::textutil::trim::trimleft "\t\t hello, world \t " ]
set str
} "hello, world \t "
test trim-0.2 {trim string on right} {
set str [::textutil::trim::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::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::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::trim::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::trim::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::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::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::trim::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::trim::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::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::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::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::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::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)\]
}
}"
|
