163 lines
5.1 KiB
Plaintext
163 lines
5.1 KiB
Plaintext
# 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
|