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