1# Commands covered: incr 2# 3# This file contains a collection of tests for one or more of the Tcl built-in 4# commands. Sourcing this file into Tcl runs the tests and generates output 5# for errors. No output means no errors were found. 6# 7# Copyright © 1996 Sun Microsystems, Inc. 8# Copyright © 1998-1999 Scriptics Corporation. 9# 10# See the file "license.terms" for information on usage and redistribution of 11# this file, and for a DISCLAIMER OF ALL WARRANTIES. 12 13if {"::tcltest" ni [namespace children]} { 14 package require tcltest 2.5 15 namespace import -force ::tcltest::* 16} 17 18unset -nocomplain x i 19proc readonly varName { 20 upvar 1 $varName var 21 trace add variable var write \ 22 {apply {{args} {error "variable is read-only"}}} 23} 24 25# Basic "incr" operation. 26 27test incr-1.1 {TclCompileIncrCmd: missing variable name} -returnCodes error -body { 28 incr 29} -result {wrong # args: should be "incr varName ?increment?"} 30test incr-1.2 {TclCompileIncrCmd: simple variable name} { 31 set i 10 32 list [incr i] $i 33} {11 11} 34test incr-1.3 {TclCompileIncrCmd: error compiling variable name} -body { 35 set i 10 36 incr "i"xxx 37} -returnCodes error -result {extra characters after close-quote} 38test incr-1.4 {TclCompileIncrCmd: simple variable name in quotes} { 39 set i 17 40 list [incr "i"] $i 41} {18 18} 42test incr-1.5 {TclCompileIncrCmd: simple variable name in braces} -setup { 43 unset -nocomplain {a simple var} 44} -body { 45 set {a simple var} 27 46 list [incr {a simple var}] ${a simple var} 47} -result {28 28} 48test incr-1.6 {TclCompileIncrCmd: simple array variable name} -setup { 49 unset -nocomplain a 50} -body { 51 set a(foo) 37 52 list [incr a(foo)] $a(foo) 53} -result {38 38} 54test incr-1.7 {TclCompileIncrCmd: non-simple (computed) variable name} { 55 set x "i" 56 set i 77 57 list [incr $x 2] $i 58} {79 79} 59test incr-1.8 {TclCompileIncrCmd: non-simple (computed) variable name} { 60 set x "i" 61 set i 77 62 list [incr [set x] +2] $i 63} {79 79} 64test incr-1.9 {TclCompileIncrCmd: increment given} { 65 set i 10 66 list [incr i +07] $i 67} {17 17} 68test incr-1.10 {TclCompileIncrCmd: no increment given} { 69 set i 10 70 list [incr i] $i 71} {11 11} 72test incr-1.11 {TclCompileIncrCmd: simple global name} { 73 proc p {} { 74 global i 75 set i 54 76 incr i 77 } 78 p 79} {55} 80test incr-1.12 {TclCompileIncrCmd: simple local name} { 81 proc p {} { 82 set foo 100 83 incr foo 84 } 85 p 86} {101} 87test incr-1.13 {TclCompileIncrCmd: simple but new (unknown) local name} { 88 proc p {} { 89 incr bar 90 } 91 p 92} 1 93test incr-1.14 {TclCompileIncrCmd: simple local name, >255 locals} { 94 proc 260locals {} { 95 # create 260 locals 96 set a0 0; set a1 0; set a2 0; set a3 0; set a4 0 97 set a5 0; set a6 0; set a7 0; set a8 0; set a9 0 98 set b0 0; set b1 0; set b2 0; set b3 0; set b4 0 99 set b5 0; set b6 0; set b7 0; set b8 0; set b9 0 100 set c0 0; set c1 0; set c2 0; set c3 0; set c4 0 101 set c5 0; set c6 0; set c7 0; set c8 0; set c9 0 102 set d0 0; set d1 0; set d2 0; set d3 0; set d4 0 103 set d5 0; set d6 0; set d7 0; set d8 0; set d9 0 104 set e0 0; set e1 0; set e2 0; set e3 0; set e4 0 105 set e5 0; set e6 0; set e7 0; set e8 0; set e9 0 106 set f0 0; set f1 0; set f2 0; set f3 0; set f4 0 107 set f5 0; set f6 0; set f7 0; set f8 0; set f9 0 108 set g0 0; set g1 0; set g2 0; set g3 0; set g4 0 109 set g5 0; set g6 0; set g7 0; set g8 0; set g9 0 110 set h0 0; set h1 0; set h2 0; set h3 0; set h4 0 111 set h5 0; set h6 0; set h7 0; set h8 0; set h9 0 112 set i0 0; set i1 0; set i2 0; set i3 0; set i4 0 113 set i5 0; set i6 0; set i7 0; set i8 0; set i9 0 114 set j0 0; set j1 0; set j2 0; set j3 0; set j4 0 115 set j5 0; set j6 0; set j7 0; set j8 0; set j9 0 116 set k0 0; set k1 0; set k2 0; set k3 0; set k4 0 117 set k5 0; set k6 0; set k7 0; set k8 0; set k9 0 118 set l0 0; set l1 0; set l2 0; set l3 0; set l4 0 119 set l5 0; set l6 0; set l7 0; set l8 0; set l9 0 120 set m0 0; set m1 0; set m2 0; set m3 0; set m4 0 121 set m5 0; set m6 0; set m7 0; set m8 0; set m9 0 122 set n0 0; set n1 0; set n2 0; set n3 0; set n4 0 123 set n5 0; set n6 0; set n7 0; set n8 0; set n9 0 124 set o0 0; set o1 0; set o2 0; set o3 0; set o4 0 125 set o5 0; set o6 0; set o7 0; set o8 0; set o9 0 126 set p0 0; set p1 0; set p2 0; set p3 0; set p4 0 127 set p5 0; set p6 0; set p7 0; set p8 0; set p9 0 128 set q0 0; set q1 0; set q2 0; set q3 0; set q4 0 129 set q5 0; set q6 0; set q7 0; set q8 0; set q9 0 130 set r0 0; set r1 0; set r2 0; set r3 0; set r4 0 131 set r5 0; set r6 0; set r7 0; set r8 0; set r9 0 132 set s0 0; set s1 0; set s2 0; set s3 0; set s4 0 133 set s5 0; set s6 0; set s7 0; set s8 0; set s9 0 134 set t0 0; set t1 0; set t2 0; set t3 0; set t4 0 135 set t5 0; set t6 0; set t7 0; set t8 0; set t9 0 136 set u0 0; set u1 0; set u2 0; set u3 0; set u4 0 137 set u5 0; set u6 0; set u7 0; set u8 0; set u9 0 138 set v0 0; set v1 0; set v2 0; set v3 0; set v4 0 139 set v5 0; set v6 0; set v7 0; set v8 0; set v9 0 140 set w0 0; set w1 0; set w2 0; set w3 0; set w4 0 141 set w5 0; set w6 0; set w7 0; set w8 0; set w9 0 142 set x0 0; set x1 0; set x2 0; set x3 0; set x4 0 143 set x5 0; set x6 0; set x7 0; set x8 0; set x9 0 144 set y0 0; set y1 0; set y2 0; set y3 0; set y4 0 145 set y5 0; set y6 0; set y7 0; set y8 0; set y9 0 146 set z0 0; set z1 0; set z2 0; set z3 0; set z4 0 147 set z5 0; set z6 0; set z7 0; set z8 0; set z9 0 148 # now increment the last one (local var index > 255) 149 incr z9 150 } 151 260locals 152} {1} 153test incr-1.15 {TclCompileIncrCmd: variable is array} -setup { 154 unset -nocomplain a 155} -body { 156 set a(foo) 27 157 incr a(foo) 11 158} -cleanup { 159 unset -nocomplain a 160} -result 38 161test incr-1.16 {TclCompileIncrCmd: variable is array, elem substitutions} -setup { 162 unset -nocomplain a 163} -body { 164 set i 5 165 set a(foo5) 27 166 incr a(foo$i) 11 167} -cleanup { 168 unset -nocomplain a 169} -result 38 170test incr-1.17 {TclCompileIncrCmd: increment given, simple int} { 171 set i 5 172 incr i 123 173} 128 174test incr-1.18 {TclCompileIncrCmd: increment given, simple int} { 175 set i 5 176 incr i -100 177} -95 178test incr-1.19 {TclCompileIncrCmd: increment given, but erroneous} -body { 179 set i 5 180 catch {incr i [set]} -> opts 181 dict get $opts -errorinfo 182} -match glob -result {wrong # args: should be "set varName ?newValue?" 183 while *ing 184"set"*} 185test incr-1.20 {TclCompileIncrCmd: increment given, in quotes} { 186 set i 25 187 incr i "-100" 188} -75 189test incr-1.21 {TclCompileIncrCmd: increment given, in braces} { 190 set i 24 191 incr i {126} 192} 150 193test incr-1.22 {TclCompileIncrCmd: increment given, large int} { 194 set i 5 195 incr i 200000 196} 200005 197test incr-1.23 {TclCompileIncrCmd: increment given, formatted int != int} { 198 set i 25 199 incr i 0o00012345 ;# an octal literal 200} 5374 201test incr-1.24 {TclCompileIncrCmd: increment given, formatted int != int} -body { 202 set i 25 203 incr i 1a 204} -returnCodes error -result {expected integer but got "1a"} 205test incr-1.25 {TclCompileIncrCmd: too many arguments} -body { 206 set i 10 207 incr i 10 20 208} -returnCodes error -result {wrong # args: should be "incr varName ?increment?"} 209test incr-1.26 {TclCompileIncrCmd: runtime error, bad variable name} { 210 unset -nocomplain {"foo} 211 incr {"foo} 212} 1 213test incr-1.27 {TclCompileIncrCmd: runtime error, bad variable name} -body { 214 list [catch {incr [set]} msg] $msg $::errorInfo 215} -match glob -result {1 {wrong # args: should be "set varName ?newValue?"} {wrong # args: should be "set varName ?newValue?" 216 while *ing 217"set"*}} 218test incr-1.28 {TclCompileIncrCmd: runtime error, readonly variable} -body { 219 set x 123 220 readonly x 221 list [catch {incr x 1} msg] $msg $::errorInfo 222} -match glob -cleanup { 223 unset -nocomplain x 224} -result {1 {can't set "x": variable is read-only} {*variable is read-only 225 while executing 226* 227"incr x 1"}} 228test incr-1.29 {TclCompileIncrCmd: runtime error, bad variable value} -body { 229 set x " - " 230 incr x 1 231} -returnCodes error -result {expected integer but got " - "} 232test incr-1.30 {TclCompileIncrCmd: array var, braced (no subs)} -setup { 233 catch {unset array} 234} -body { 235 set array(\$foo) 4 236 incr {array($foo)} 237} -result 5 238 239# Check "incr" and computed command names. 240 241unset -nocomplain x i 242test incr-2.0 {incr and computed command names} { 243 set i 5 244 set z incr 245 $z i -1 246 return $i 247} 4 248test incr-2.1 {incr command (not compiled): missing variable name} -body { 249 set z incr 250 $z 251} -returnCodes error -result {wrong # args: should be "incr varName ?increment?"} 252test incr-2.2 {incr command (not compiled): simple variable name} { 253 set z incr 254 set i 10 255 list [$z i] $i 256} {11 11} 257test incr-2.3 {incr command (not compiled): error compiling variable name} -body { 258 set z incr 259 set i 10 260 $z "i"xxx 261} -returnCodes error -result {extra characters after close-quote} 262test incr-2.4 {incr command (not compiled): simple variable name in quotes} { 263 set z incr 264 set i 17 265 list [$z "i"] $i 266} {18 18} 267test incr-2.5 {incr command (not compiled): simple variable name in braces} -setup { 268 unset -nocomplain {a simple var} 269} -body { 270 set z incr 271 set {a simple var} 27 272 list [$z {a simple var}] ${a simple var} 273} -result {28 28} 274test incr-2.6 {incr command (not compiled): simple array variable name} -setup { 275 unset -nocomplain a 276} -body { 277 set z incr 278 set a(foo) 37 279 list [$z a(foo)] $a(foo) 280} -result {38 38} 281test incr-2.7 {incr command (not compiled): non-simple (computed) variable name} { 282 set z incr 283 set x "i" 284 set i 77 285 list [$z $x 2] $i 286} {79 79} 287test incr-2.8 {incr command (not compiled): non-simple (computed) variable name} { 288 set z incr 289 set x "i" 290 set i 77 291 list [$z [set x] +2] $i 292} {79 79} 293test incr-2.9 {incr command (not compiled): increment given} { 294 set z incr 295 set i 10 296 list [$z i +07] $i 297} {17 17} 298test incr-2.10 {incr command (not compiled): no increment given} { 299 set z incr 300 set i 10 301 list [$z i] $i 302} {11 11} 303test incr-2.11 {incr command (not compiled): simple global name} { 304 proc p {} { 305 set z incr 306 global i 307 set i 54 308 $z i 309 } 310 p 311} {55} 312test incr-2.12 {incr command (not compiled): simple local name} { 313 proc p {} { 314 set z incr 315 set foo 100 316 $z foo 317 } 318 p 319} {101} 320test incr-2.13 {incr command (not compiled): simple but new (unknown) local name} { 321 proc p {} { 322 set z incr 323 $z bar 324 } 325 p 326} 1 327test incr-2.14 {incr command (not compiled): simple local name, >255 locals} { 328 proc 260locals {} { 329 set z incr 330 # create 260 locals 331 set a0 0; set a1 0; set a2 0; set a3 0; set a4 0 332 set a5 0; set a6 0; set a7 0; set a8 0; set a9 0 333 set b0 0; set b1 0; set b2 0; set b3 0; set b4 0 334 set b5 0; set b6 0; set b7 0; set b8 0; set b9 0 335 set c0 0; set c1 0; set c2 0; set c3 0; set c4 0 336 set c5 0; set c6 0; set c7 0; set c8 0; set c9 0 337 set d0 0; set d1 0; set d2 0; set d3 0; set d4 0 338 set d5 0; set d6 0; set d7 0; set d8 0; set d9 0 339 set e0 0; set e1 0; set e2 0; set e3 0; set e4 0 340 set e5 0; set e6 0; set e7 0; set e8 0; set e9 0 341 set f0 0; set f1 0; set f2 0; set f3 0; set f4 0 342 set f5 0; set f6 0; set f7 0; set f8 0; set f9 0 343 set g0 0; set g1 0; set g2 0; set g3 0; set g4 0 344 set g5 0; set g6 0; set g7 0; set g8 0; set g9 0 345 set h0 0; set h1 0; set h2 0; set h3 0; set h4 0 346 set h5 0; set h6 0; set h7 0; set h8 0; set h9 0 347 set i0 0; set i1 0; set i2 0; set i3 0; set i4 0 348 set i5 0; set i6 0; set i7 0; set i8 0; set i9 0 349 set j0 0; set j1 0; set j2 0; set j3 0; set j4 0 350 set j5 0; set j6 0; set j7 0; set j8 0; set j9 0 351 set k0 0; set k1 0; set k2 0; set k3 0; set k4 0 352 set k5 0; set k6 0; set k7 0; set k8 0; set k9 0 353 set l0 0; set l1 0; set l2 0; set l3 0; set l4 0 354 set l5 0; set l6 0; set l7 0; set l8 0; set l9 0 355 set m0 0; set m1 0; set m2 0; set m3 0; set m4 0 356 set m5 0; set m6 0; set m7 0; set m8 0; set m9 0 357 set n0 0; set n1 0; set n2 0; set n3 0; set n4 0 358 set n5 0; set n6 0; set n7 0; set n8 0; set n9 0 359 set o0 0; set o1 0; set o2 0; set o3 0; set o4 0 360 set o5 0; set o6 0; set o7 0; set o8 0; set o9 0 361 set p0 0; set p1 0; set p2 0; set p3 0; set p4 0 362 set p5 0; set p6 0; set p7 0; set p8 0; set p9 0 363 set q0 0; set q1 0; set q2 0; set q3 0; set q4 0 364 set q5 0; set q6 0; set q7 0; set q8 0; set q9 0 365 set r0 0; set r1 0; set r2 0; set r3 0; set r4 0 366 set r5 0; set r6 0; set r7 0; set r8 0; set r9 0 367 set s0 0; set s1 0; set s2 0; set s3 0; set s4 0 368 set s5 0; set s6 0; set s7 0; set s8 0; set s9 0 369 set t0 0; set t1 0; set t2 0; set t3 0; set t4 0 370 set t5 0; set t6 0; set t7 0; set t8 0; set t9 0 371 set u0 0; set u1 0; set u2 0; set u3 0; set u4 0 372 set u5 0; set u6 0; set u7 0; set u8 0; set u9 0 373 set v0 0; set v1 0; set v2 0; set v3 0; set v4 0 374 set v5 0; set v6 0; set v7 0; set v8 0; set v9 0 375 set w0 0; set w1 0; set w2 0; set w3 0; set w4 0 376 set w5 0; set w6 0; set w7 0; set w8 0; set w9 0 377 set x0 0; set x1 0; set x2 0; set x3 0; set x4 0 378 set x5 0; set x6 0; set x7 0; set x8 0; set x9 0 379 set y0 0; set y1 0; set y2 0; set y3 0; set y4 0 380 set y5 0; set y6 0; set y7 0; set y8 0; set y9 0 381 set z0 0; set z1 0; set z2 0; set z3 0; set z4 0 382 set z5 0; set z6 0; set z7 0; set z8 0; set z9 0 383 # now increment the last one (local var index > 255) 384 $z z9 385 } 386 260locals 387} {1} 388test incr-2.15 {incr command (not compiled): variable is array} -setup { 389 unset -nocomplain a 390} -body { 391 set z incr 392 set a(foo) 27 393 $z a(foo) 11 394} -cleanup { 395 unset -nocomplain a 396} -result 38 397test incr-2.16 {incr command (not compiled): variable is array, elem substitutions} -setup { 398 unset -nocomplain a 399} -body { 400 set z incr 401 set i 5 402 set a(foo5) 27 403 $z a(foo$i) 11 404} -cleanup { 405 unset -nocomplain a 406} -result 38 407test incr-2.17 {incr command (not compiled): increment given, simple int} { 408 set z incr 409 set i 5 410 $z i 123 411} 128 412test incr-2.18 {incr command (not compiled): increment given, simple int} { 413 set z incr 414 set i 5 415 $z i -100 416} -95 417test incr-2.19 {incr command (not compiled): increment given, but erroneous} -body { 418 set z incr 419 set i 5 420 catch {$z i [set]} -> opts 421 dict get $opts -errorinfo 422} -match glob -result {wrong # args: should be "set varName ?newValue?" 423 while *ing 424"set"*} 425test incr-2.20 {incr command (not compiled): increment given, in quotes} { 426 set z incr 427 set i 25 428 $z i "-100" 429} -75 430test incr-2.21 {incr command (not compiled): increment given, in braces} { 431 set z incr 432 set i 24 433 $z i {126} 434} 150 435test incr-2.22 {incr command (not compiled): increment given, large int} { 436 set z incr 437 set i 5 438 $z i 200000 439} 200005 440test incr-2.23 {incr command (not compiled): increment given, formatted int != int} { 441 set z incr 442 set i 25 443 $z i 0o00012345 ;# an octal literal 444} 5374 445test incr-2.24 {incr command (not compiled): increment given, formatted int != int} -body { 446 set z incr 447 set i 25 448 $z i 1a 449} -returnCodes error -result {expected integer but got "1a"} 450test incr-2.25 {incr command (not compiled): too many arguments} -body { 451 set z incr 452 set i 10 453 $z i 10 20 454} -returnCodes error -result {wrong # args: should be "incr varName ?increment?"} 455test incr-2.26 {incr command (not compiled): runtime error, bad variable name} -setup { 456 unset -nocomplain {"foo} 457} -body { 458 set z incr 459 $z {"foo} 460} -result 1 461test incr-2.27 {incr command (not compiled): runtime error, bad variable name} -body { 462 set z incr 463 list [catch {$z [set]} msg] $msg $::errorInfo 464} -match glob -result {1 {wrong # args: should be "set varName ?newValue?"} {wrong # args: should be "set varName ?newValue?" 465 while *ing 466"set"*}} 467test incr-2.28 {incr command (not compiled): runtime error, readonly variable} -body { 468 set z incr 469 set x 123 470 readonly x 471 list [catch {$z x 1} msg] $msg $::errorInfo 472} -match glob -cleanup { 473 unset -nocomplain x 474} -result {1 {can't set "x": variable is read-only} {*variable is read-only 475 while executing 476* 477"$z x 1"}} 478test incr-2.29 {incr command (not compiled): runtime error, bad variable value} -body { 479 set z incr 480 set x " - " 481 $z x 1 482} -returnCodes error -result {expected integer but got " - "} 483test incr-2.30 {incr command (not compiled): bad increment} { 484 set z incr 485 set x 0 486 list [catch {$z x 1a} msg] $msg $::errorInfo 487} {1 {expected integer but got "1a"} {expected integer but got "1a" 488 (reading increment) 489 invoked from within 490"$z x 1a"}} 491test incr-2.31 {incr command (compiled): bad increment} { 492 list [catch {incr x 1a} msg] $msg $::errorInfo 493} {1 {expected integer but got "1a"} {expected integer but got "1a" 494 (reading increment) 495 invoked from within 496"incr x 1a"}} 497test incr-2.32 {incr command (compiled): bad pure list increment} { 498 list [catch {incr x [list 1 2]} msg] $msg $::errorInfo 499} {1 {expected integer but got "1 2"} {expected integer but got "1 2" 500 (reading increment) 501 invoked from within 502"incr x [list 1 2]"}} 503test incr-2.33 {incr command (compiled): bad pure dict increment} { 504 list [catch {incr x [dict create 1 2]} msg] $msg $::errorInfo 505} {1 {expected integer but got "1 2"} {expected integer but got "1 2" 506 (reading increment) 507 invoked from within 508"incr x [dict create 1 2]"}} 509 510test incr-3.1 {increment by wide amount: bytecode route} { 511 set x 0 512 incr x 123123123123 513} 123123123123 514test incr-3.2 {increment by wide amount: command route} { 515 set z incr 516 set x 0 517 $z x 123123123123 518} 123123123123 519 520test incr-4.1 {increment non-existing array element [Bug 1445454]} -body { 521 proc x {} {incr a(1)} 522 x 523} -cleanup { 524 rename x {} 525} -result 1 526 527# cleanup 528::tcltest::cleanupTests 529return 530 531# Local Variables: 532# mode: tcl 533# fill-column: 78 534# End: 535