util/src/TclTk/tcl8.6.12/tests/lindex.test

   1 # Commands covered:  lindex
   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 if {"::tcltest" ni [namespace children]} {
  16     package require tcltest 2.5
  17     namespace import -force ::tcltest::*
  18 }
  19
  20 ::tcltest::loadTestedCommands
  21 catch [list package require -exact Tcltest [info patchlevel]]
  22
  23 set minus -
  24 testConstraint testevalex [llength [info commands testevalex]]
  25
  26 # Tests of Tcl_LindexObjCmd, NOT COMPILED
  27
  28 test lindex-1.1 {wrong # args} testevalex {
  29     list [catch {testevalex lindex} result] $result
  30 } "1 {wrong # args: should be \"lindex list ?index ...?\"}"
  31
  32 # Indices that are lists or convertible to lists
  33
  34 test lindex-2.1 {empty index list} testevalex {
  35     set x {}
  36     list [testevalex {lindex {a b c} $x}] [testevalex {lindex {a b c} $x}]
  37 } {{a b c} {a b c}}
  38 test lindex-2.2 {singleton index list} testevalex {
  39     set x { 1 }
  40     list [testevalex {lindex {a b c} $x}] [testevalex {lindex {a b c} $x}]
  41 } {b b}
  42 test lindex-2.3 {multiple indices in list} testevalex {
  43     set x {1 2}
  44     list [testevalex {lindex {{a b c} {d e f}} $x}] \
  45         [testevalex {lindex {{a b c} {d e f}} $x}]
  46 } {f f}
  47 test lindex-2.4 {malformed index list} testevalex {
  48     set x \{
  49     list [catch { testevalex {lindex {a b c} $x} } result] $result
  50 } {1 bad\ index\ \"\{\":\ must\ be\ integer?\[+-\]integer?\ or\ end?\[+-\]integer?}
  51
  52 # Indices that are integers or convertible to integers
  53
  54 test lindex-3.1 {integer -1} testevalex {
  55     set x ${minus}1
  56     list [testevalex {lindex {a b c} $x}] [testevalex {lindex {a b c} $x}]
  57 } {{} {}}
  58 test lindex-3.2 {integer 0} testevalex {
  59     set x [string range 00 0 0]
  60     list [testevalex {lindex {a b c} $x}] [testevalex {lindex {a b c} $x}]
  61 } {a a}
  62 test lindex-3.3 {integer 2} testevalex {
  63     set x [string range 22 0 0]
  64     list [testevalex {lindex {a b c} $x}] [testevalex {lindex {a b c} $x}]
  65 } {c c}
  66 test lindex-3.4 {integer 3} testevalex {
  67     set x [string range 33 0 0]
  68     list [testevalex {lindex {a b c} $x}] [testevalex {lindex {a b c} $x}]
  69 } {{} {}}
  70 test lindex-3.5 {bad octal} -constraints testevalex -body {
  71     set x 0o8
  72     list [catch { testevalex {lindex {a b c} $x} } result] $result
  73 } -match glob -result {1 {*invalid octal number*}}
  74 test lindex-3.6 {bad octal} -constraints testevalex -body {
  75     set x -0o9
  76     list [catch { testevalex {lindex {a b c} $x} } result] $result
  77 } -match glob -result {1 {*invalid octal number*}}
  78 test lindex-3.7 {indexes don't shimmer wide ints} {
  79     set x [expr {(wide(1)<<31) - 2}]
  80     list $x [lindex {1 2 3} $x] [incr x] [incr x]
  81 } {2147483646 {} 2147483647 2147483648}
  82 test lindex-3.8 {compiled with static indices out of range, negative} {
  83     list [lindex {a b c} -1] [lindex {a b c} -2] [lindex {a b c} -3]
  84 } [lrepeat 3 {}]
  85 test lindex-3.9 {compiled with calculated indices out of range, negative constant} {
  86     list [lindex {a b c} -1-1] [lindex {a b c} -2+0] [lindex {a b c} -2+1]
  87 } [lrepeat 3 {}]
  88 test lindex-3.10 {compiled with calculated indices out of range, after end} {
  89     list [lindex {a b c} end+1] [lindex {a b c} end+2] [lindex {a b c} end+3]
  90 } [lrepeat 3 {}]
  91
  92 # Indices relative to end
  93
  94 test lindex-4.1 {index = end} testevalex {
  95     set x end
  96     list [testevalex {lindex {a b c} $x}] [testevalex {lindex {a b c} $x}]
  97 } {c c}
  98 test lindex-4.2 {index = end--1} testevalex {
  99     set x end--1
 100     list [testevalex {lindex {a b c} $x}] [testevalex {lindex {a b c} $x}]
 101 } {{} {}}
 102 test lindex-4.3 {index = end-0} testevalex {
 103     set x end-0
 104     list [testevalex {lindex {a b c} $x}] [testevalex {lindex {a b c} $x}]
 105 } {c c}
 106 test lindex-4.4 {index = end-2} testevalex {
 107     set x end-2
 108     list [testevalex {lindex {a b c} $x}] [testevalex {lindex {a b c} $x}]
 109 } {a a}
 110 test lindex-4.5 {index = end-3} testevalex {
 111     set x end-3
 112     list [testevalex {lindex {a b c} $x}] [testevalex {lindex {a b c} $x}]
 113 } {{} {}}
 114 test lindex-4.6 {bad octal} -constraints testevalex -body {
 115     set x end-0o8
 116     list [catch { testevalex {lindex {a b c} $x} } result] $result
 117 } -match glob -result {1 {*invalid octal number*}}
 118 test lindex-4.7 {bad octal} -constraints testevalex -body {
 119     set x end--0o9
 120     list [catch { testevalex {lindex {a b c} $x} } result] $result
 121 } -match glob -result {1 {*invalid octal number*}}
 122 test lindex-4.8 {bad integer, not octal} testevalex {
 123     set x end-0a2
 124     list [catch { testevalex {lindex {a b c} $x} } result] $result
 125 } {1 {bad index "end-0a2": must be integer?[+-]integer? or end?[+-]integer?}}
 126 test lindex-4.9 {obsolete test} testevalex {
 127     set x end
 128     list [testevalex {lindex {a b c} $x}] [testevalex {lindex {a b c} $x}]
 129 } {c c}
 130 test lindex-4.10 {incomplete end-} testevalex {
 131     set x end-
 132     list [catch { testevalex {lindex {a b c} $x} } result] $result
 133 } {1 {bad index "end-": must be integer?[+-]integer? or end?[+-]integer?}}
 134
 135 test lindex-5.1 {bad second index} testevalex {
 136     list [catch { testevalex {lindex {a b c} 0 0a2} } result] $result
 137 } {1 {bad index "0a2": must be integer?[+-]integer? or end?[+-]integer?}}
 138 test lindex-5.2 {good second index} testevalex {
 139     testevalex {lindex {{a b c} {d e f} {g h i}} 1 2}
 140 } f
 141 test lindex-5.3 {three indices} testevalex {
 142     testevalex {lindex {{{a b} {c d}} {{e f} {g h}}} 1 0 1}
 143 } f
 144
 145 test lindex-6.1 {error conditions in parsing list} testevalex {
 146     list [catch {testevalex {lindex "a \{" 2}} msg] $msg
 147 } {1 {unmatched open brace in list}}
 148 test lindex-6.2 {error conditions in parsing list} testevalex {
 149     list [catch {testevalex {lindex {a {b c}d e} 2}} msg] $msg
 150 } {1 {list element in braces followed by "d" instead of space}}
 151 test lindex-6.3 {error conditions in parsing list} testevalex {
 152     list [catch {testevalex {lindex {a "b c"def ghi} 2}} msg] $msg
 153 } {1 {list element in quotes followed by "def" instead of space}}
 154
 155 test lindex-7.1 {quoted elements} testevalex {
 156     testevalex {lindex {a "b c" d} 1}
 157 } {b c}
 158 test lindex-7.2 {quoted elements} testevalex {
 159     testevalex {lindex {"{}" b c} 0}
 160 } {{}}
 161 test lindex-7.3 {quoted elements} testevalex {
 162     testevalex {lindex {ab "c d \" x" y} 1}
 163 } {c d " x}
 164 test lindex-7.4 {quoted elements} {
 165     lindex {a b {c d "e} {f g"}} 2
 166 } {c d "e}
 167
 168 test lindex-8.1 {data reuse} testevalex {
 169     set x 0
 170     testevalex {lindex $x $x}
 171 } {0}
 172 test lindex-8.2 {data reuse} testevalex {
 173     set a 0
 174     testevalex {lindex $a $a $a}
 175 } 0
 176 test lindex-8.3 {data reuse} testevalex {
 177     set a 1
 178     testevalex {lindex $a $a $a}
 179 } {}
 180 test lindex-8.4 {data reuse} testevalex {
 181     set x [list 0 0]
 182     testevalex {lindex $x $x}
 183 } {0}
 184 test lindex-8.5 {data reuse} testevalex {
 185     set x 0
 186     testevalex {lindex $x [list $x $x]}
 187 } {0}
 188 test lindex-8.6 {data reuse} testevalex {
 189     set x [list 1 1]
 190     testevalex {lindex $x $x}
 191 } {}
 192 test lindex-8.7 {data reuse} testevalex {
 193     set x 1
 194     testevalex {lindex $x [list $x $x]}
 195 } {}
 196
 197 #----------------------------------------------------------------------
 198
 199 # Compilation tests for lindex
 200
 201 test lindex-9.1 {wrong # args} {
 202     list [catch {lindex} result] $result
 203 } "1 {wrong # args: should be \"lindex list ?index ...?\"}"
 204 test lindex-9.2 {ensure that compilation works in the right order} {
 205     proc foo {} {
 206         rename foo {}
 207         lindex 1 0
 208     }
 209     foo
 210 } 1
 211
 212 # Indices that are lists or convertible to lists
 213
 214 test lindex-10.1 {empty index list} {
 215     set x {}
 216     catch {
 217         list [lindex {a b c} $x] [lindex {a b c} $x]
 218     } result
 219     set result
 220 } {{a b c} {a b c}}
 221 test lindex-10.2 {singleton index list} {
 222     set x { 1 }
 223     catch {
 224         list [lindex {a b c} $x] [lindex {a b c} $x]
 225     } result
 226     set result
 227 } {b b}
 228 test lindex-10.3 {multiple indices in list} {
 229     set x {1 2}
 230     catch {
 231         list [lindex {{a b c} {d e f}} $x] [lindex {{a b c} {d e f}} $x]
 232     } result
 233     set result
 234 } {f f}
 235 test lindex-10.4 {malformed index list} {
 236     set x \{
 237     list [catch { lindex {a b c} $x } result] $result
 238 } {1 bad\ index\ \"\{\":\ must\ be\ integer?\[+-\]integer?\ or\ end?\[+-\]integer?}
 239
 240 # Indices that are integers or convertible to integers
 241
 242 test lindex-11.1 {integer -1} {
 243     set x ${minus}1
 244     catch {
 245         list [lindex {a b c} $x] [lindex {a b c} $x]
 246     } result
 247     set result
 248 } {{} {}}
 249 test lindex-11.2 {integer 0} {
 250     set x [string range 00 0 0]
 251     catch {
 252         list [lindex {a b c} $x] [lindex {a b c} $x]
 253     } result
 254     set result
 255 } {a a}
 256 test lindex-11.3 {integer 2} {
 257     set x [string range 22 0 0]
 258     catch {
 259         list [lindex {a b c} $x] [lindex {a b c} $x]
 260     } result
 261     set result
 262 } {c c}
 263 test lindex-11.4 {integer 3} {
 264     set x [string range 33 0 0]
 265     catch {
 266         list [lindex {a b c} $x] [lindex {a b c} $x]
 267     } result
 268     set result
 269 } {{} {}}
 270 test lindex-11.5 {bad octal} -body {
 271     set x 0o8
 272     list [catch { lindex {a b c} $x } result] $result
 273 } -match glob -result {1 {*invalid octal number*}}
 274 test lindex-11.6 {bad octal} -body {
 275     set x -0o9
 276     list [catch { lindex {a b c} $x } result] $result
 277 } -match glob -result {1 {*invalid octal number*}}
 278
 279 # Indices relative to end
 280
 281 test lindex-12.1 {index = end} {
 282     set x end
 283     catch {
 284         list [lindex {a b c} $x] [lindex {a b c} $x]
 285     } result
 286     set result
 287 } {c c}
 288 test lindex-12.2 {index = end--1} {
 289     set x end--1
 290     catch {
 291         list [lindex {a b c} $x] [lindex {a b c} $x]
 292     } result
 293     set result
 294 } {{} {}}
 295 test lindex-12.3 {index = end-0} {
 296     set x end-0
 297     catch {
 298         list [lindex {a b c} $x] [lindex {a b c} $x]
 299     } result
 300     set result
 301 } {c c}
 302 test lindex-12.4 {index = end-2} {
 303     set x end-2
 304     catch {
 305         list [lindex {a b c} $x] [lindex {a b c} $x]
 306     } result
 307     set result
 308 } {a a}
 309 test lindex-12.5 {index = end-3} {
 310     set x end-3
 311     catch {
 312         list [lindex {a b c} $x] [lindex {a b c} $x]
 313     } result
 314     set result
 315 } {{} {}}
 316 test lindex-12.6 {bad octal} -body {
 317     set x end-0o8
 318     list [catch { lindex {a b c} $x } result] $result
 319 } -match glob -result {1 {*invalid octal number*}}
 320 test lindex-12.7 {bad octal} -body {
 321     set x end--0o9
 322     list [catch { lindex {a b c} $x } result] $result
 323 } -match glob -result {1 {*invalid octal number*}}
 324 test lindex-12.8 {bad integer, not octal} {
 325     set x end-0a2
 326     list [catch { lindex {a b c} $x } result] $result
 327 } {1 {bad index "end-0a2": must be integer?[+-]integer? or end?[+-]integer?}}
 328 test lindex-12.9 {obsolete test} {
 329     set x end
 330     catch {
 331         list [lindex {a b c} $x] [lindex {a b c} $x]
 332     } result
 333     set result
 334 } {c c}
 335 test lindex-12.10 {incomplete end-} {
 336     set x end-
 337     list [catch { lindex {a b c} $x } result] $result
 338 } {1 {bad index "end-": must be integer?[+-]integer? or end?[+-]integer?}}
 339
 340 test lindex-13.1 {bad second index} {
 341     list [catch { lindex {a b c} 0 0a2 } result] $result
 342 } {1 {bad index "0a2": must be integer?[+-]integer? or end?[+-]integer?}}
 343 test lindex-13.2 {good second index} {
 344     catch {
 345         lindex {{a b c} {d e f} {g h i}} 1 2
 346     } result
 347     set result
 348 } f
 349 test lindex-13.3 {three indices} {
 350     catch {
 351         lindex {{{a b} {c d}} {{e f} {g h}}} 1 0 1
 352     } result
 353     set result
 354 } f
 355
 356 test lindex-14.1 {error conditions in parsing list} {
 357     list [catch { lindex "a \{" 2 } msg] $msg
 358 } {1 {unmatched open brace in list}}
 359 test lindex-14.2 {error conditions in parsing list} {
 360     list [catch { lindex {a {b c}d e} 2 } msg] $msg
 361 } {1 {list element in braces followed by "d" instead of space}}
 362 test lindex-14.3 {error conditions in parsing list} {
 363     list [catch { lindex {a "b c"def ghi} 2 } msg] $msg
 364 } {1 {list element in quotes followed by "def" instead of space}}
 365
 366 test lindex-15.1 {quoted elements} {
 367     catch {
 368         lindex {a "b c" d} 1
 369     } result
 370     set result
 371 } {b c}
 372 test lindex-15.2 {quoted elements} {
 373     catch {
 374         lindex {"{}" b c} 0
 375     } result
 376     set result
 377 } {{}}
 378 test lindex-15.3 {quoted elements} {
 379     catch {
 380         lindex {ab "c d \" x" y} 1
 381     } result
 382     set result
 383 } {c d " x}
 384 test lindex-15.4 {quoted elements} {
 385     catch {
 386         lindex {a b {c d "e} {f g"}} 2
 387     } result
 388     set result
 389 } {c d "e}
 390
 391 test lindex-16.1 {data reuse} {
 392     set x 0
 393     catch {
 394         lindex $x $x
 395     } result
 396     set result
 397 } {0}
 398 test lindex-16.2 {data reuse} {
 399     set a 0
 400     catch {
 401         lindex $a $a $a
 402     } result
 403     set result
 404 } 0
 405 test lindex-16.3 {data reuse} {
 406     set a 1
 407     catch {
 408         lindex $a $a $a
 409     } result
 410     set result
 411 } {}
 412 test lindex-16.4 {data reuse} {
 413     set x [list 0 0]
 414     catch {
 415         lindex $x $x
 416     } result
 417     set result
 418 } {0}
 419 test lindex-16.5 {data reuse} {
 420     set x 0
 421     catch {
 422         lindex $x [list $x $x]
 423     } result
 424     set result
 425 } {0}
 426 test lindex-16.6 {data reuse} {
 427     set x [list 1 1]
 428     catch {
 429         lindex $x $x
 430     } result
 431     set result
 432 } {}
 433 test lindex-16.7 {data reuse} {
 434     set x 1
 435     catch {
 436         lindex $x [list $x $x]
 437     } result
 438     set result
 439 } {}
 440
 441 test lindex-17.0 {Bug 1718580} {*}{
 442     -body {
 443         lindex {} end foo
 444     }
 445     -match glob
 446     -result {bad index "foo"*}
 447     -returnCodes 1
 448 }
 449
 450 test lindex-17.1 {Bug 1718580} {*}{
 451     -body {
 452         lindex a end foo
 453     }
 454     -match glob
 455     -result {bad index "foo"*}
 456     -returnCodes 1
 457 }
 458
 459 catch { unset minus }
 460
 461 # cleanup
 462 ::tcltest::cleanupTests
 463 return
 464
 465 # Local Variables:
 466 # mode: tcl
 467 # End: