tclx/tests/string.test

#
# string.test
#
# Tests for the string-related commands.
#---------------------------------------------------------------------------
# Copyright 1992-1999 Karl Lehenbauer and Mark Diekhans.
#
# Permission to use, copy, modify, and distribute this software and its
# documentation for any purpose and without fee is hereby granted, provided
# that the above copyright notice appear in all copies.  Karl Lehenbauer and
# Mark Diekhans make no representations about the suitability of this
# software for any purpose.  It is provided "as is" without express or
# implied warranty.
#------------------------------------------------------------------------------
# $Id: string.test,v 1.3 2002/09/26 00:19:02 hobbs Exp $
#------------------------------------------------------------------------------
#

if {[cequal [info procs Test] {}]} {
    source [file join [file dirname [info script]] testlib.tcl]
}

# Test the 'cindex' command.

Test string-1.1 {cindex tests} {
    cindex ABCDEFG 1
} 0 {B}

Test string-1.2 {cindex tests} {
    cindex ABCDEFG 3+1
} 0 {E}

Test string-1.3 {cindex tests} {
    cindex ABCDEFG 3*2
} 0 {G}

Test string-1.4 {cindex tests} {
    cindex ABCDEFG 7
} 0 {}

Test string-1.5 {cindex tests} {
    cindex ABCDEFG end-2
} 0 {E}

Test string-1.6 {cindex tests} {
    cindex ABCDEFG len-3
} 0 {E}

Test string-1.7 {cindex tests} {
    cindex ABCDEFG lenx-3
} 1 "syntax error in expression \"7x-3\"[expr {
    ($tcl_version>8.3) ? ": extra tokens at end of expression" : ""
}]"

Test string-1.8 {cindex tests} {
    cindex ABCDEFG
} 1 {wrong # args: cindex string indexExpr}

Test string-1.9 {cindex tests} {
    cindex ABCDEFG 1 10
} 1 {wrong # args: cindex string indexExpr}

Test string-1.10 {cindex tests} {
    cindex A\0BCDEFG 2
} 0 {B}

Test string-1.11 {cindex tests} {
    cindex A\0BCDEFG 1
} 0 "\0"

Test string-1.12 {cindex unicode tests} {
    cindex \u7266abc\u7266x 1
} 0 "a"

Test string-1.13 {cindex unicode tests} {
    cindex \u7266abc\u7266x 0
} 0 "\u7266"

Test string-1.14 {cindex unicode tests} {
    cindex \u7266abc\u7266x 4
} 0 "\u7266"

Test string-1.15 {cindex unicode tests} {
    cindex \u7266abc\u7266x 5
} 0 "x"


# Test the 'clength' command.

Test string-2.1 {clength tests} {
    clength ABCDEFG
} 0 7

Test string-2.2 {clength tests} {
    clength "ABCD XYZ"
} 0 8

Test string-2.3 {clength tests} {
    clength
} 1 {wrong # args: clength string}

Test string-2.4 {clength tests} {
    clength "AB\0D X\0Z"
} 0 8

Test string-2.5 {clength unicode tests} {
    clength \u7266abc\u7266x
} 0 6

Test string-2.6 {clength unicode tests} {
    clength abc\u7266x\u7266
} 0 6

# Test the crange command.

Test string-3.1 {crange tests} {
    crange ABCDEFG 1 3
} 0 {BCD}

Test string-3.2 {crange tests} {
    crange ABCDEFG 2 end
} 0 {CDEFG}

Test string-3.3 {crange tests} {
    set foo [replicate ABCD 500]
    crange $foo 25*4 500-1
} 0 [replicate ABCD 100]

Test string-3.4 {crange tests} {
    crange
} 1 {wrong # args: crange string firstExpr lastExpr}

Test string-3.5 {crange tests} {
    crange ABCD 4 1
} 0 {}

Test string-3.6 {crange tests} {
    crange ABCD end-2 len-1
} 0 {BCD}

Test string-3.7 {crange tests} {
    crange ABCD len-3 end-1
} 0 {BC}

Test string-3.8 {crange tests} {
    # 8.4+ enhanced the error return from expressions
    crange ABCD lenx-3 end-1
}  1 "syntax error in expression \"4x-3\"[expr {
    ($tcl_version>8.3) ? ": extra tokens at end of expression" : ""
}]"

Test string-3.9 {crange tests} {
    set text .tex
    set l 4
    crange $text $l+1 end
} 0 {}

Test string-3.10 {crange tests} {
    crange AB\0DEFG 1 3
} 0 "B\0D"

Test string-3.11 {crange tests} {
    crange ABC\0E\0G 2 end
} 0 "C\0E\0G"


Test string-3.12 {crange unicode tests} {
    crange \u7266abc\u7266x 2 end
} 0 "bc\u7266x"


# Test the 'replicate' command

Test string-4.1 {replicate tests} {
    replicate AbCd 4
} 0 {AbCdAbCdAbCdAbCd}

Test string-4.2 {replicate tests} {
    replicate X 1000
} 0 "[replicate X 250][replicate X 250][replicate X 250][replicate X 250]"

Test string-4.3 {replicate tests} {
    replicate X
} 1 {wrong # args: replicate string countExpr}

Test string-4.4 {replicate tests} {
    replicate Ab\0d 4
} 0 "Ab\0dAb\0dAb\0dAb\0d"

Test string-4.5 {replicate unicode tests} {
    replicate \u7266abc\u7266x  3
} 0 "\u7266abc\u7266x\u7266abc\u7266x\u7266abc\u7266x"

# Test the csubstr command.

Test string-5.1 {csubstr tests} {
    csubstr ABCDEFG 1 2+1
} 0 {BCD}

Test string-5.2 {csubstr tests} {
    csubstr ABCDEFG 1+1 end
} 0 {CDEFG}

Test string-5.3 {csubstr tests} {
    set foo [replicate ABCD 500]
    csubstr $foo 25*4 100*4
} 0 [replicate ABCD 100]

Test string-5.4 {csubstr tests} {
    csubstr
} 1 {wrong # args: csubstr string firstExpr lengthExpr}

Test string-5.5 {csubstr tests} {
    csubstr ABCD 4 1
} 0 {}

Test string-5.6 {csubstr tests} {
    csubstr ABCD 1 end-1
} 0 {BC}

Test string-5.7 {csubstr tests} {
    csubstr ABCD len-2 end
} 0 {CD}

Test string-5.8 {csubstr tests} {
    csubstr ABCD 0 len
} 0 {ABCD}

Test string-5.9 {csubstr tests} {
    csubstr AB\0D len-2 end
} 0 "\0D"

Test string-5.8 {csubstr tests} {
    csubstr AB\0D 0 len
} 0 "AB\0D"

Test string-5.9 {csubstr unicode tests} {
    csubstr \u7266abc\u7266x 0 1
} 0 \u7266

Test string-5.10 {csubstr unicode tests} {
    csubstr \u7266abc\u7266x 1 end-1
} 0 abc\u7266

# Test the translit command.

Test string-6.1 {translit tests} {
    set str "Captain Midnight Secret Decoder Ring"
    translit {A-MN-Za-mn-z} {N-ZA-Mn-za-m} $str
} 0 {Pncgnva Zvqavtug Frperg Qrpbqre Evat}

Test string-6.2 {translit tests} {
    set str "Captain Midnight Secret Decoder Ring"
    set str2 [translit {A-MN-Za-mn-z} {N-ZA-Mn-za-m} $str]
    translit {A-MN-Za-mn-z} {N-ZA-Mn-za-m} $str2
} 0 {Captain Midnight Secret Decoder Ring}

Test string-6.4 {translit tests} {
    translit
} 1 {wrong # args: translit from to string}

# Type conversion was broken.
Test string-6.5 {translit tests} {
    catch {unset xxx}
    set s [list This_is_a_test value]
    array set xxx [translit _ - $s]
    array get xxx
} 0 {This-is-a-test value}
catch {unset xxx}

# Check for detection of unsupported UniCode
Test string-6.6 {translit tests} {
    set str "Captain Midnight Secret Decoder Ring"
    translit "A-MN-Za-m\u1234-z" "N-ZA-Mn-za-m" $str
} 1 {Unicode character found in in-range, the translit command does not yet support Unicode}

Test string-6.7 {translit tests} {
    set str "Captain Midnight Secret Decoder Ring"
    translit "A-MN-Za-mn-z" "N-ZA-Mn-za-\u5134" $str
} 1 {Unicode character found in out-range, the translit command does not yet support Unicode}

Test string-6.8 {translit tests} {
    set str "Captain Midnight Secret \u1543ecoder Ring"
    translit "A-MN-Za-mn-z" "N-ZA-Mn-za-m" $str
} 1 {Unicode character found in string to translate, the translit command does not yet support Unicode}


# Test the ctoken command

Test string-7.1 {ctoken tests} {
    ctoken
} 1 {wrong # args: ctoken strvar separators}

Test string-7.2 {ctoken tests} {
    ctoken a b c
} 1 {wrong # args: ctoken strvar separators}

Test string-7.3 {ctoken tests} {
    set orgstr "  \t  this\tis \n  a   test   "
    set s1 [ctoken orgstr " \t\n"]
    set s1v $orgstr
    set s2 [ctoken orgstr " \t\n"]
    set s2v $orgstr
    set s3 [ctoken orgstr " \t\n"]
    set s3v $orgstr
    set s4 [ctoken orgstr " \t\n"]
    set s4v $orgstr
    set s5 [ctoken orgstr " \t\n"]
    set s5v $orgstr
    list $s1 $s1v $s2 $s2v $s3 $s3v $s4 $s4v $s5 $s5v
} 0 [list "this"  "\tis \n  a   test   " \
          "is"    " \n  a   test   " \
          "a"     "   test   " \
          "test"  "   " \
          ""      ""]
Test string-7.2 {ctoken tests} {
    ctoken "No such variable" " \t"
} 1 {can't read "No such variable": no such variable}


Test string-9.1 {cequal tests} {
    cequal
} 1 {wrong # args: cequal string1 string2}

Test string-9.2 {cequal tests} {
    cequal a b c
} 1 {wrong # args: cequal string1 string2}

Test string-9.3 {cequal tests} {
    cequal ab c
} 0 0

Test string-9.4 {cequal tests} {
    cequal abcded abcded
} 0 1

Test string-9.5 {cequal tests} {
    cequal a\0 a
} 0 0

Test string-9.6 {cequal tests} {
    cequal ab\0cd\0ed ab\0cd\0ed
} 0 1

Test string-9.7 {cequal tests} {
    cequal file5 file4
} 0 0

Test string-9.8 {cequal unicode tests} {
    cequal \u7266abc\u7266x \u7266abc\u7266x
} 0 1

Test string-9.9 {cequal unicode tests} {
    cequal \u7266abc\u7267x \u7266abc\u7266x
} 0 0

# ccollate command

Test string-10.1 {ccollate tests} {
    ccollate
} 1 {wrong # args: ccollate ?options? string1 string2}

Test string-10.2 {ccollate tests} {
    ccollate aaa bbb ccc ddd
} 1 {wrong # args: ccollate ?options? string1 string2}

Test string-10.3 {ccollate tests} {
    ccollate -bbb ccc ddd
} 1 {Invalid option "-bbb", expected "-local"}

Test string-10.4 {ccollate tests} {
    ccollate nnn ccc ddd
} 1 {Invalid option "nnn", expected "-local"}

Test string-10.5 {ccollate tests} {
    ccollate abcdef abcdef
} 0 0

Test string-10.6 {ccollate tests} {
    ccollate abcdefg abcdef
} 0 1

Test string-10.7 {ccollate tests} {
    ccollate abcde abcdef
} 0 -1

Test string-10.8 {ccollate tests} {
    ccollate -local abcdefg abcdef
} 0 1

Test string-10.9 {ccollate tests} {
    ccollate -local abcde abcdef
} 0 -1

Test string-11.1 {cconcat tests} {
    cconcat
} 0 {}

Test string-11.2 {cconcat tests} {
    cconcat Aaa Bbb
} 0 {AaaBbb}


Test string-11.3 {cconcat tests} {
    cconcat Aaa " " Bbb
} 0 {Aaa Bbb}

Test string-11.4 {cconcat tests} {
    cconcat A\0a B\0b
} 0 "A\0aB\0b"


Test string-11.4 {cconcat tests} {
    cconcat Aaa " " \0 Bbb
} 0 "Aaa \0Bbb"


# cleanup
::tcltest::cleanupTests
return