1# Commands covered:  tcl::prefix
2#
3# This file contains a collection of tests for one or more of the Tcl
4# built-in commands.  Sourcing this file into Tcl runs the tests and
5# generates output for errors.  No output means no errors were found.
6#
7# Copyright (c) 1991-1993 The Regents of the University of California.
8# Copyright (c) 1994 Sun Microsystems, Inc.
9# Copyright (c) 1998-1999 by Scriptics Corporation.
10# Copyright (c) 2001 by Kevin B. Kenny.  All rights reserved.
11#
12# See the file "license.terms" for information on usage and redistribution
13# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
14
15source [file dirname [info script]]/testing.tcl
16
17needs cmd tcl::prefix tclprefix
18testConstraint namespace [expr {[info commands namespace] ne ""}]
19
20test string-26.1 {tcl::prefix, too few args} -body {
21    tcl::prefix match a
22} -returnCodes 1 -match glob -result {wrong # args: should be "tcl::prefix match ?options*? table string"}
23test string-26.1.1 {tcl::prefix, too few args} -body {
24    tcl::prefix
25} -returnCodes 1 -match glob -result {wrong # args: should be "tcl::prefix subcommand ?arg ...?"}
26test string-26.2 {tcl::prefix, bad args} -body {
27    tcl::prefix match a b c
28} -returnCodes 1 -result {bad option "a": must be -error, -exact, or -message}
29test string-26.2.1 {tcl::prefix, empty table} -body {
30    tcl::prefix match {} foo
31} -returnCodes 1 -result {bad option "foo": no valid options}
32
33test string-26.2.2 {tcl::prefix, bad args} -body {
34    tcl::prefix badoption
35} -returnCodes 1 -result {bad option "badoption": must be all, longest, or match}
36
37
38test string-26.3.1 {tcl::prefix, bad args} -body {
39    tcl::prefix match -error "x" -exact str1 str2
40} -returnCodes 1 -match glob -result *
41test string-26.3.2 {tcl::prefix, bad args} -body {
42    tcl::prefix match -error str1 str2
43} -returnCodes 1 -result {missing error options}
44test string-26.4 {tcl::prefix, bad args} -body {
45    tcl::prefix match -message str1 str2
46} -returnCodes 1 -result {missing message}
47test string-26.5 {tcl::prefix} {
48    tcl::prefix match {apa bepa cepa depa} cepa
49} cepa
50test string-26.6 {tcl::prefix} {
51    tcl::prefix match {apa bepa cepa depa} be
52} bepa
53test string-26.7 {tcl::prefix} -body {
54    tcl::prefix match -exact {apa bepa cepa depa} be
55} -returnCodes 1 -result {bad option "be": must be apa, bepa, cepa, or depa}
56test string-26.8 {tcl::prefix} -body {
57    tcl::prefix match -message switch {apa bear bepa depa} be
58} -returnCodes 1 -result {ambiguous switch "be": must be apa, bear, bepa, or depa}
59test string-26.9 {tcl::prefix} -body {
60    tcl::prefix match -error {} {apa bepa bear depa} be
61} -returnCodes 0 -result {}
62test string-26.10 {tcl::prefix} -body {
63    tcl::prefix match -error {-level 1} {apa bear bepa depa} be
64} -returnCodes 2 -result {ambiguous option "be": must be apa, bear, bepa, or depa}
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84test string-27.1 {tcl::prefix all, too few args} -body {
85    tcl::prefix all a
86} -returnCodes 1 -result {wrong # args: should be "tcl::prefix all table string"}
87test string-27.2 {tcl::prefix all, bad args} -body {
88    tcl::prefix all a b c
89} -returnCodes 1 -result {wrong # args: should be "tcl::prefix all table string"}
90
91
92
93test string-27.4 {tcl::prefix all} {
94    tcl::prefix all {apa bepa cepa depa} c
95} cepa
96test string-27.5 {tcl::prefix all} {
97    tcl::prefix all {apa bepa cepa depa} cepa
98} cepa
99test string-27.6 {tcl::prefix all} {
100    tcl::prefix all {apa bepa cepa depa} cepax
101} {}
102test string-27.7 {tcl::prefix all} {
103    tcl::prefix all {apa aska appa} a
104} {apa aska appa}
105test string-27.8 {tcl::prefix all} {
106    tcl::prefix all {apa aska appa} ap
107} {apa appa}
108test string-27.9 {tcl::prefix all} {
109    tcl::prefix all {apa aska appa} p
110} {}
111test string-27.10 {tcl::prefix all} {
112    tcl::prefix all {apa aska appa} {}
113} {apa aska appa}
114
115test string-28.1 {tcl::prefix longest, too few args} -body {
116    tcl::prefix longest a
117} -returnCodes 1 -result {wrong # args: should be "tcl::prefix longest table string"}
118test string-28.2 {tcl::prefix longest, bad args} -body {
119    tcl::prefix longest a b c
120} -returnCodes 1 -result {wrong # args: should be "tcl::prefix longest table string"}
121
122
123
124test string-28.4 {tcl::prefix longest} {
125    tcl::prefix longest {apa bepa cepa depa} c
126} cepa
127test string-28.5 {tcl::prefix longest} {
128    tcl::prefix longest {apa bepa cepa depa} cepa
129} cepa
130test string-28.6 {tcl::prefix longest} {
131    tcl::prefix longest {apa bepa cepa depa} cepax
132} {}
133test string-28.7 {tcl::prefix longest} {
134    tcl::prefix longest {apa aska appa} a
135} a
136test string-28.8 {tcl::prefix longest} {
137    tcl::prefix longest {apa aska appa} ap
138} ap
139test string-28.9 {tcl::prefix longest} {
140    tcl::prefix longest {apa bska appa} a
141} ap
142test string-28.10 {tcl::prefix longest} {
143    tcl::prefix longest {apa bska appa} {}
144} {}
145test string-28.11 {tcl::prefix longest} {
146    tcl::prefix longest {{} bska appa} {}
147} {}
148test string-28.12 {tcl::prefix longest} {
149    tcl::prefix longest {apa {} appa} {}
150} {}
151test string-28.13 {tcl::prefix longest} {
152    # Test UTF8 handling
153    tcl::prefix longest {ax\x90 bep ax\x91} a
154} ax
155
156test string-29.1 {tcl::prefix from another namespace} namespace {
157    namespace eval abc {
158        tcl::prefix longest {apa bepa cepa depa} cepa
159    }
160} cepa
161
162testreport
163