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 tclprefix
  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.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 ...?"}
  26 test 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}
  29 test 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
  33 test 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
  38 test string-26.3.1 {tcl::prefix, bad args} -body {
  39     tcl::prefix match -error "x" -exact str1 str2
  40 } -returnCodes 1 -match glob -result *
  41 test string-26.3.2 {tcl::prefix, bad args} -body {
  42     tcl::prefix match -error str1 str2
  43 } -returnCodes 1 -result {missing error options}
  44 test string-26.4 {tcl::prefix, bad args} -body {
  45     tcl::prefix match -message str1 str2
  46 } -returnCodes 1 -result {missing message}
  47 test string-26.5 {tcl::prefix} {
  48     tcl::prefix match {apa bepa cepa depa} cepa
  49 } cepa
  50 test string-26.6 {tcl::prefix} {
  51     tcl::prefix match {apa bepa cepa depa} be
  52 } bepa
  53 test 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}
  56 test 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}
  59 test string-26.9 {tcl::prefix} -body {
  60     tcl::prefix match -error {} {apa bepa bear depa} be
  61 } -returnCodes 0 -result {}
  62 test 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
  84 test 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"}
  87 test 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
  93 test string-27.4 {tcl::prefix all} {
  94     tcl::prefix all {apa bepa cepa depa} c
  95 } cepa
  96 test string-27.5 {tcl::prefix all} {
  97     tcl::prefix all {apa bepa cepa depa} cepa
  98 } cepa
  99 test string-27.6 {tcl::prefix all} {
 100     tcl::prefix all {apa bepa cepa depa} cepax
 101 } {}
 102 test string-27.7 {tcl::prefix all} {
 103     tcl::prefix all {apa aska appa} a
 104 } {apa aska appa}
 105 test string-27.8 {tcl::prefix all} {
 106     tcl::prefix all {apa aska appa} ap
 107 } {apa appa}
 108 test string-27.9 {tcl::prefix all} {
 109     tcl::prefix all {apa aska appa} p
 110 } {}
 111 test string-27.10 {tcl::prefix all} {
 112     tcl::prefix all {apa aska appa} {}
 113 } {apa aska appa}
 114
 115 test 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"}
 118 test 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
 124 test string-28.4 {tcl::prefix longest} {
 125     tcl::prefix longest {apa bepa cepa depa} c
 126 } cepa
 127 test string-28.5 {tcl::prefix longest} {
 128     tcl::prefix longest {apa bepa cepa depa} cepa
 129 } cepa
 130 test string-28.6 {tcl::prefix longest} {
 131     tcl::prefix longest {apa bepa cepa depa} cepax
 132 } {}
 133 test string-28.7 {tcl::prefix longest} {
 134     tcl::prefix longest {apa aska appa} a
 135 } a
 136 test string-28.8 {tcl::prefix longest} {
 137     tcl::prefix longest {apa aska appa} ap
 138 } ap
 139 test string-28.9 {tcl::prefix longest} {
 140     tcl::prefix longest {apa bska appa} a
 141 } ap
 142 test string-28.10 {tcl::prefix longest} {
 143     tcl::prefix longest {apa bska appa} {}
 144 } {}
 145 test string-28.11 {tcl::prefix longest} {
 146     tcl::prefix longest {{} bska appa} {}
 147 } {}
 148 test string-28.12 {tcl::prefix longest} {
 149     tcl::prefix longest {apa {} appa} {}
 150 } {}
 151 test string-28.13 {tcl::prefix longest} {
 152     # Test UTF8 handling
 153     tcl::prefix longest {ax\x90 bep ax\x91} a
 154 } ax
 155
 156 test 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
 162 testreport