tests/prefix.test

   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
  15 source [file dirname [info script]]/testing.tcl
  16
  17 needs cmd tcl::prefix prefix
  18 testConstraint namespace [expr {[info commands namespace] ne ""}]
  19
  20 test 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"}
  23 test string-26.2 {tcl::prefix, bad args} -body {
  24     tcl::prefix match a b c
  25 } -returnCodes 1 -result {bad option "a": must be -error, -exact, or -message}
  26 test string-26.2.1 {tcl::prefix, empty table} -body {
  27     tcl::prefix match {} foo
  28 } -returnCodes 1 -result {bad option "foo": no valid options}
  29
  30
  31
  32 test string-26.3.1 {tcl::prefix, bad args} -body {
  33     tcl::prefix match -error "x" -exact str1 str2
  34 } -returnCodes 1 -match glob -result *
  35 test string-26.3.2 {tcl::prefix, bad args} -body {
  36     tcl::prefix match -error str1 str2
  37 } -returnCodes 1 -result {missing error options}
  38 test string-26.4 {tcl::prefix, bad args} -body {
  39     tcl::prefix match -message str1 str2
  40 } -returnCodes 1 -result {missing message}
  41 test string-26.5 {tcl::prefix} {
  42     tcl::prefix match {apa bepa cepa depa} cepa
  43 } cepa
  44 test string-26.6 {tcl::prefix} {
  45     tcl::prefix match {apa bepa cepa depa} be
  46 } bepa
  47 test string-26.7 {tcl::prefix} -body {
  48     tcl::prefix match -exact {apa bepa cepa depa} be
  49 } -returnCodes 1 -result {bad option "be": must be apa, bepa, cepa, or depa}
  50 test string-26.8 {tcl::prefix} -body {
  51     tcl::prefix match -message switch {apa bear bepa depa} be
  52 } -returnCodes 1 -result {ambiguous switch "be": must be apa, bear, bepa, or depa}
  53 test string-26.9 {tcl::prefix} -body {
  54     tcl::prefix match -error {} {apa bepa bear depa} be
  55 } -returnCodes 0 -result {}
  56 test string-26.10 {tcl::prefix} -body {
  57     tcl::prefix match -error {-level 1} {apa bear bepa depa} be
  58 } -returnCodes 2 -result {ambiguous option "be": must be apa, bear, bepa, or depa}
  59
  60
  61
  62
  63
  64
  65
  66
  67
  68
  69
  70
  71
  72
  73
  74
  75
  76
  77
  78 test string-27.1 {tcl::prefix all, too few args} -body {
  79     tcl::prefix all a
  80 } -returnCodes 1 -result {wrong # args: should be "tcl::prefix all table string"}
  81 test string-27.2 {tcl::prefix all, bad args} -body {
  82     tcl::prefix all a b c
  83 } -returnCodes 1 -result {wrong # args: should be "tcl::prefix all table string"}
  84
  85
  86
  87 test string-27.4 {tcl::prefix all} {
  88     tcl::prefix all {apa bepa cepa depa} c
  89 } cepa
  90 test string-27.5 {tcl::prefix all} {
  91     tcl::prefix all {apa bepa cepa depa} cepa
  92 } cepa
  93 test string-27.6 {tcl::prefix all} {
  94     tcl::prefix all {apa bepa cepa depa} cepax
  95 } {}
  96 test string-27.7 {tcl::prefix all} {
  97     tcl::prefix all {apa aska appa} a
  98 } {apa aska appa}
  99 test string-27.8 {tcl::prefix all} {
 100     tcl::prefix all {apa aska appa} ap
 101 } {apa appa}
 102 test string-27.9 {tcl::prefix all} {
 103     tcl::prefix all {apa aska appa} p
 104 } {}
 105 test string-27.10 {tcl::prefix all} {
 106     tcl::prefix all {apa aska appa} {}
 107 } {apa aska appa}
 108
 109 test string-28.1 {tcl::prefix longest, too few args} -body {
 110     tcl::prefix longest a
 111 } -returnCodes 1 -result {wrong # args: should be "tcl::prefix longest table string"}
 112 test string-28.2 {tcl::prefix longest, bad args} -body {
 113     tcl::prefix longest a b c
 114 } -returnCodes 1 -result {wrong # args: should be "tcl::prefix longest table string"}
 115
 116
 117
 118 test string-28.4 {tcl::prefix longest} {
 119     tcl::prefix longest {apa bepa cepa depa} c
 120 } cepa
 121 test string-28.5 {tcl::prefix longest} {
 122     tcl::prefix longest {apa bepa cepa depa} cepa
 123 } cepa
 124 test string-28.6 {tcl::prefix longest} {
 125     tcl::prefix longest {apa bepa cepa depa} cepax
 126 } {}
 127 test string-28.7 {tcl::prefix longest} {
 128     tcl::prefix longest {apa aska appa} a
 129 } a
 130 test string-28.8 {tcl::prefix longest} {
 131     tcl::prefix longest {apa aska appa} ap
 132 } ap
 133 test string-28.9 {tcl::prefix longest} {
 134     tcl::prefix longest {apa bska appa} a
 135 } ap
 136 test string-28.10 {tcl::prefix longest} {
 137     tcl::prefix longest {apa bska appa} {}
 138 } {}
 139 test string-28.11 {tcl::prefix longest} {
 140     tcl::prefix longest {{} bska appa} {}
 141 } {}
 142 test string-28.12 {tcl::prefix longest} {
 143     tcl::prefix longest {apa {} appa} {}
 144 } {}
 145 test string-28.13 {tcl::prefix longest} {
 146     # Test UTF8 handling
 147     tcl::prefix longest {ax\x90 bep ax\x91} a
 148 } ax
 149
 150 test string-29.1 {tcl::prefix from another namespace} namespace {
 151     namespace eval abc {
 152         tcl::prefix longest {apa bepa cepa depa} cepa
 153     }
 154 } cepa
 155
 156 testreport