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
|
# Commands covered: tcl::prefix
#
# 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.
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# Copyright (c) 2001 by Kevin B. Kenny. All rights reserved.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
source [file dirname [info script]]/testing.tcl
needs cmd tcl::prefix tclprefix
testConstraint namespace [expr {[info commands namespace] ne ""}]
test string-26.1 {tcl::prefix, too few args} -body {
tcl::prefix match a
} -returnCodes 1 -match glob -result {wrong # args: should be "tcl::prefix match ?options*? table string"}
test string-26.1.1 {tcl::prefix, too few args} -body {
tcl::prefix
} -returnCodes 1 -match glob -result {wrong # args: should be "tcl::prefix subcommand ?arg ...?"}
test string-26.2 {tcl::prefix, bad args} -body {
tcl::prefix match a b c
} -returnCodes 1 -result {bad option "a": must be -error, -exact, or -message}
test string-26.2.1 {tcl::prefix, empty table} -body {
tcl::prefix match {} foo
} -returnCodes 1 -result {bad option "foo": no valid options}
test string-26.2.2 {tcl::prefix, bad args} -body {
tcl::prefix badoption
} -returnCodes 1 -result {bad option "badoption": must be all, longest, or match}
test string-26.3.1 {tcl::prefix, bad args} -body {
tcl::prefix match -error "x" -exact str1 str2
} -returnCodes 1 -match glob -result *
test string-26.3.2 {tcl::prefix, bad args} -body {
tcl::prefix match -error str1 str2
} -returnCodes 1 -result {missing error options}
test string-26.4 {tcl::prefix, bad args} -body {
tcl::prefix match -message str1 str2
} -returnCodes 1 -result {missing message}
test string-26.5 {tcl::prefix} {
tcl::prefix match {apa bepa cepa depa} cepa
} cepa
test string-26.6 {tcl::prefix} {
tcl::prefix match {apa bepa cepa depa} be
} bepa
test string-26.7 {tcl::prefix} -body {
tcl::prefix match -exact {apa bepa cepa depa} be
} -returnCodes 1 -result {bad option "be": must be apa, bepa, cepa, or depa}
test string-26.8 {tcl::prefix} -body {
tcl::prefix match -message switch {apa bear bepa depa} be
} -returnCodes 1 -result {ambiguous switch "be": must be apa, bear, bepa, or depa}
test string-26.9 {tcl::prefix} -body {
tcl::prefix match -error {} {apa bepa bear depa} be
} -returnCodes 0 -result {}
test string-26.10 {tcl::prefix} -body {
tcl::prefix match -error {-level 1} {apa bear bepa depa} be
} -returnCodes 2 -result {ambiguous option "be": must be apa, bear, bepa, or depa}
test string-27.1 {tcl::prefix all, too few args} -body {
tcl::prefix all a
} -returnCodes 1 -result {wrong # args: should be "tcl::prefix all table string"}
test string-27.2 {tcl::prefix all, bad args} -body {
tcl::prefix all a b c
} -returnCodes 1 -result {wrong # args: should be "tcl::prefix all table string"}
test string-27.4 {tcl::prefix all} {
tcl::prefix all {apa bepa cepa depa} c
} cepa
test string-27.5 {tcl::prefix all} {
tcl::prefix all {apa bepa cepa depa} cepa
} cepa
test string-27.6 {tcl::prefix all} {
tcl::prefix all {apa bepa cepa depa} cepax
} {}
test string-27.7 {tcl::prefix all} {
tcl::prefix all {apa aska appa} a
} {apa aska appa}
test string-27.8 {tcl::prefix all} {
tcl::prefix all {apa aska appa} ap
} {apa appa}
test string-27.9 {tcl::prefix all} {
tcl::prefix all {apa aska appa} p
} {}
test string-27.10 {tcl::prefix all} {
tcl::prefix all {apa aska appa} {}
} {apa aska appa}
test string-28.1 {tcl::prefix longest, too few args} -body {
tcl::prefix longest a
} -returnCodes 1 -result {wrong # args: should be "tcl::prefix longest table string"}
test string-28.2 {tcl::prefix longest, bad args} -body {
tcl::prefix longest a b c
} -returnCodes 1 -result {wrong # args: should be "tcl::prefix longest table string"}
test string-28.4 {tcl::prefix longest} {
tcl::prefix longest {apa bepa cepa depa} c
} cepa
test string-28.5 {tcl::prefix longest} {
tcl::prefix longest {apa bepa cepa depa} cepa
} cepa
test string-28.6 {tcl::prefix longest} {
tcl::prefix longest {apa bepa cepa depa} cepax
} {}
test string-28.7 {tcl::prefix longest} {
tcl::prefix longest {apa aska appa} a
} a
test string-28.8 {tcl::prefix longest} {
tcl::prefix longest {apa aska appa} ap
} ap
test string-28.9 {tcl::prefix longest} {
tcl::prefix longest {apa bska appa} a
} ap
test string-28.10 {tcl::prefix longest} {
tcl::prefix longest {apa bska appa} {}
} {}
test string-28.11 {tcl::prefix longest} {
tcl::prefix longest {{} bska appa} {}
} {}
test string-28.12 {tcl::prefix longest} {
tcl::prefix longest {apa {} appa} {}
} {}
test string-28.13 {tcl::prefix longest} {
# Test UTF8 handling
tcl::prefix longest {ax\x90 bep ax\x91} a
} ax
test string-29.1 {tcl::prefix from another namespace} namespace {
namespace eval abc {
tcl::prefix longest {apa bepa cepa depa} cepa
}
} cepa
testreport
|
