summaryrefslogtreecommitdiffstats
path: root/tests/incr.test
blob: af15f5e87501099228dd55b90439f428c09c4e8e (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
# Commands covered:  incr
#
# This file contains a collection of tests for one or more of the Tcl built-in
# commands. Sourcing this file into Tcl runs the tests and generates output
# for errors. No output means no errors were found.
#
# Copyright (c) 1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

unset -nocomplain x i
proc readonly varName {
    upvar 1 $varName var
    trace add variable var write \
	{apply {{args} {error "variable is read-only"}}}
}

# Basic "incr" operation.

test incr-1.1 {TclCompileIncrCmd: missing variable name} -returnCodes error -body {
    incr
} -result {wrong # args: should be "incr varName ?increment?"}
test incr-1.2 {TclCompileIncrCmd: simple variable name} {
    set i 10
    list [incr i] $i
} {11 11}
test incr-1.3 {TclCompileIncrCmd: error compiling variable name} -body {
    set i 10
    incr "i"xxx
} -returnCodes error -result {extra characters after close-quote}
test incr-1.4 {TclCompileIncrCmd: simple variable name in quotes} {
    set i 17
    list [incr "i"] $i
} {18 18}
test incr-1.5 {TclCompileIncrCmd: simple variable name in braces} -setup {
    unset -nocomplain {a simple var}
} -body {
    set {a simple var} 27
    list [incr {a simple var}] ${a simple var}
} -result {28 28}
test incr-1.6 {TclCompileIncrCmd: simple array variable name} -setup {
    unset -nocomplain a
} -body {
    set a(foo) 37
    list [incr a(foo)] $a(foo)
} -result {38 38}
test incr-1.7 {TclCompileIncrCmd: non-simple (computed) variable name} {
    set x "i"
    set i 77
    list [incr $x 2] $i
} {79 79}
test incr-1.8 {TclCompileIncrCmd: non-simple (computed) variable name} {
    set x "i"
    set i 77
    list [incr [set x] +2] $i
} {79 79}
test incr-1.9 {TclCompileIncrCmd: increment given} {
    set i 10
    list [incr i +07] $i
} {17 17}
test incr-1.10 {TclCompileIncrCmd: no increment given} {
    set i 10
    list [incr i] $i
} {11 11}
test incr-1.11 {TclCompileIncrCmd: simple global name} {
    proc p {} {
        global i
        set i 54
        incr i
    }
    p
} {55}
test incr-1.12 {TclCompileIncrCmd: simple local name} {
    proc p {} {
        set foo 100
        incr foo
    }
    p
} {101}
test incr-1.13 {TclCompileIncrCmd: simple but new (unknown) local name} {
    proc p {} {
        incr bar
    }
    p
} 1
test incr-1.14 {TclCompileIncrCmd: simple local name, >255 locals} {
    proc 260locals {} {
        # create 260 locals
        set a0 0; set a1 0; set a2 0; set a3 0; set a4 0
        set a5 0; set a6 0; set a7 0; set a8 0; set a9 0
        set b0 0; set b1 0; set b2 0; set b3 0; set b4 0
        set b5 0; set b6 0; set b7 0; set b8 0; set b9 0
        set c0 0; set c1 0; set c2 0; set c3 0; set c4 0
        set c5 0; set c6 0; set c7 0; set c8 0; set c9 0
        set d0 0; set d1 0; set d2 0; set d3 0; set d4 0
        set d5 0; set d6 0; set d7 0; set d8 0; set d9 0
        set e0 0; set e1 0; set e2 0; set e3 0; set e4 0
        set e5 0; set e6 0; set e7 0; set e8 0; set e9 0
        set f0 0; set f1 0; set f2 0; set f3 0; set f4 0
        set f5 0; set f6 0; set f7 0; set f8 0; set f9 0
        set g0 0; set g1 0; set g2 0; set g3 0; set g4 0
        set g5 0; set g6 0; set g7 0; set g8 0; set g9 0
        set h0 0; set h1 0; set h2 0; set h3 0; set h4 0
        set h5 0; set h6 0; set h7 0; set h8 0; set h9 0
        set i0 0; set i1 0; set i2 0; set i3 0; set i4 0
        set i5 0; set i6 0; set i7 0; set i8 0; set i9 0
        set j0 0; set j1 0; set j2 0; set j3 0; set j4 0
        set j5 0; set j6 0; set j7 0; set j8 0; set j9 0
        set k0 0; set k1 0; set k2 0; set k3 0; set k4 0
        set k5 0; set k6 0; set k7 0; set k8 0; set k9 0
        set l0 0; set l1 0; set l2 0; set l3 0; set l4 0
        set l5 0; set l6 0; set l7 0; set l8 0; set l9 0
        set m0 0; set m1 0; set m2 0; set m3 0; set m4 0
        set m5 0; set m6 0; set m7 0; set m8 0; set m9 0
        set n0 0; set n1 0; set n2 0; set n3 0; set n4 0
        set n5 0; set n6 0; set n7 0; set n8 0; set n9 0
        set o0 0; set o1 0; set o2 0; set o3 0; set o4 0
        set o5 0; set o6 0; set o7 0; set o8 0; set o9 0
        set p0 0; set p1 0; set p2 0; set p3 0; set p4 0
        set p5 0; set p6 0; set p7 0; set p8 0; set p9 0
        set q0 0; set q1 0; set q2 0; set q3 0; set q4 0
        set q5 0; set q6 0; set q7 0; set q8 0; set q9 0
        set r0 0; set r1 0; set r2 0; set r3 0; set r4 0
        set r5 0; set r6 0; set r7 0; set r8 0; set r9 0
        set s0 0; set s1 0; set s2 0; set s3 0; set s4 0
        set s5 0; set s6 0; set s7 0; set s8 0; set s9 0
        set t0 0; set t1 0; set t2 0; set t3 0; set t4 0
        set t5 0; set t6 0; set t7 0; set t8 0; set t9 0
        set u0 0; set u1 0; set u2 0; set u3 0; set u4 0
        set u5 0; set u6 0; set u7 0; set u8 0; set u9 0
        set v0 0; set v1 0; set v2 0; set v3 0; set v4 0
        set v5 0; set v6 0; set v7 0; set v8 0; set v9 0
        set w0 0; set w1 0; set w2 0; set w3 0; set w4 0
        set w5 0; set w6 0; set w7 0; set w8 0; set w9 0
        set x0 0; set x1 0; set x2 0; set x3 0; set x4 0
        set x5 0; set x6 0; set x7 0; set x8 0; set x9 0
        set y0 0; set y1 0; set y2 0; set y3 0; set y4 0
        set y5 0; set y6 0; set y7 0; set y8 0; set y9 0
        set z0 0; set z1 0; set z2 0; set z3 0; set z4 0
        set z5 0; set z6 0; set z7 0; set z8 0; set z9 0
        # now increment the last one (local var index > 255)
        incr z9
    }
    260locals
} {1}
test incr-1.15 {TclCompileIncrCmd: variable is array} -setup {
    unset -nocomplain a
} -body {
    set a(foo) 27
    incr a(foo) 11
} -cleanup {
    unset -nocomplain a
} -result 38
test incr-1.16 {TclCompileIncrCmd: variable is array, elem substitutions} -setup {
    unset -nocomplain a
} -body {
    set i 5
    set a(foo5) 27
    incr a(foo$i) 11
} -cleanup {
    unset -nocomplain a
} -result 38
test incr-1.17 {TclCompileIncrCmd: increment given, simple int} {
    set i 5
    incr i 123
} 128
test incr-1.18 {TclCompileIncrCmd: increment given, simple int} {
    set i 5
    incr i -100
} -95
test incr-1.19 {TclCompileIncrCmd: increment given, but erroneous} -body {
    set i 5
    catch {incr i [set]} -> opts
    dict get $opts -errorinfo
} -match glob -result {wrong # args: should be "set varName ?newValue?"
    while *ing
"set"*}
test incr-1.20 {TclCompileIncrCmd: increment given, in quotes} {
    set i 25
    incr i "-100"
} -75
test incr-1.21 {TclCompileIncrCmd: increment given, in braces} {
    set i 24
    incr i {126}
} 150
test incr-1.22 {TclCompileIncrCmd: increment given, large int} {
    set i 5
    incr i 200000
} 200005
test incr-1.23 {TclCompileIncrCmd: increment given, formatted int != int} {
    set i 25
    incr i 0o00012345     ;# an octal literal
} 5374
test incr-1.24 {TclCompileIncrCmd: increment given, formatted int != int} -body {
    set i 25
    incr i 1a
} -returnCodes error -result {expected integer but got "1a"}
test incr-1.25 {TclCompileIncrCmd: too many arguments} -body {
    set i 10
    incr i 10 20
} -returnCodes error -result {wrong # args: should be "incr varName ?increment?"}
test incr-1.26 {TclCompileIncrCmd: runtime error, bad variable name} {
    unset -nocomplain {"foo}
    incr {"foo}
} 1
test incr-1.27 {TclCompileIncrCmd: runtime error, bad variable name} -body {
    list [catch {incr [set]} msg] $msg $::errorInfo
} -match glob -result {1 {wrong # args: should be "set varName ?newValue?"} {wrong # args: should be "set varName ?newValue?"
    while *ing
"set"*}}
test incr-1.28 {TclCompileIncrCmd: runtime error, readonly variable} -body {
    set x 123
    readonly x
    list [catch {incr x 1} msg] $msg $::errorInfo
} -match glob -cleanup {
    unset -nocomplain x
} -result {1 {can't set "x": variable is read-only} {*variable is read-only
    while executing
*
"incr x 1"}}
test incr-1.29 {TclCompileIncrCmd: runtime error, bad variable value} -body {
    set x "  -  "
    incr x 1
} -returnCodes error -result {expected integer but got "  -  "}
test incr-1.30 {TclCompileIncrCmd: array var, braced (no subs)} -setup {
    catch {unset array}
} -body {
    set array(\$foo) 4
    incr {array($foo)}
} -result 5

# Check "incr" and computed command names.

unset -nocomplain x i
test incr-2.0 {incr and computed command names} {
    set i 5
    set z incr
    $z i -1
    return $i
} 4
test incr-2.1 {incr command (not compiled): missing variable name} -body {
    set z incr
    $z
} -returnCodes error -result {wrong # args: should be "incr varName ?increment?"}
test incr-2.2 {incr command (not compiled): simple variable name} {
    set z incr
    set i 10
    list [$z i] $i
} {11 11}
test incr-2.3 {incr command (not compiled): error compiling variable name} -body {
    set z incr
    set i 10
    $z "i"xxx
} -returnCodes error -result {extra characters after close-quote}
test incr-2.4 {incr command (not compiled): simple variable name in quotes} {
    set z incr
    set i 17
    list [$z "i"] $i
} {18 18}
test incr-2.5 {incr command (not compiled): simple variable name in braces} -setup {
    unset -nocomplain {a simple var}
} -body {
    set z incr
    set {a simple var} 27
    list [$z {a simple var}] ${a simple var}
} -result {28 28}
test incr-2.6 {incr command (not compiled): simple array variable name} -setup {
    unset -nocomplain a
} -body {
    set z incr
    set a(foo) 37
    list [$z a(foo)] $a(foo)
} -result {38 38}
test incr-2.7 {incr command (not compiled): non-simple (computed) variable name} {
    set z incr
    set x "i"
    set i 77
    list [$z $x 2] $i
} {79 79}
test incr-2.8 {incr command (not compiled): non-simple (computed) variable name} {
    set z incr
    set x "i"
    set i 77
    list [$z [set x] +2] $i
} {79 79}
test incr-2.9 {incr command (not compiled): increment given} {
    set z incr
    set i 10
    list [$z i +07] $i
} {17 17}
test incr-2.10 {incr command (not compiled): no increment given} {
    set z incr
    set i 10
    list [$z i] $i
} {11 11}
test incr-2.11 {incr command (not compiled): simple global name} {
    proc p {} {
	set z incr
        global i
        set i 54
        $z i
    }
    p
} {55}
test incr-2.12 {incr command (not compiled): simple local name} {
    proc p {} {
	set z incr
        set foo 100
        $z foo
    }
    p
} {101}
test incr-2.13 {incr command (not compiled): simple but new (unknown) local name} {
    proc p {} {
	set z incr
        $z bar
    }
    p
} 1
test incr-2.14 {incr command (not compiled): simple local name, >255 locals} {
   proc 260locals {} {
        set z incr
        # create 260 locals
        set a0 0; set a1 0; set a2 0; set a3 0; set a4 0
        set a5 0; set a6 0; set a7 0; set a8 0; set a9 0
        set b0 0; set b1 0; set b2 0; set b3 0; set b4 0
        set b5 0; set b6 0; set b7 0; set b8 0; set b9 0
        set c0 0; set c1 0; set c2 0; set c3 0; set c4 0
        set c5 0; set c6 0; set c7 0; set c8 0; set c9 0
        set d0 0; set d1 0; set d2 0; set d3 0; set d4 0
        set d5 0; set d6 0; set d7 0; set d8 0; set d9 0
        set e0 0; set e1 0; set e2 0; set e3 0; set e4 0
        set e5 0; set e6 0; set e7 0; set e8 0; set e9 0
        set f0 0; set f1 0; set f2 0; set f3 0; set f4 0
        set f5 0; set f6 0; set f7 0; set f8 0; set f9 0
        set g0 0; set g1 0; set g2 0; set g3 0; set g4 0
        set g5 0; set g6 0; set g7 0; set g8 0; set g9 0
        set h0 0; set h1 0; set h2 0; set h3 0; set h4 0
        set h5 0; set h6 0; set h7 0; set h8 0; set h9 0
        set i0 0; set i1 0; set i2 0; set i3 0; set i4 0
        set i5 0; set i6 0; set i7 0; set i8 0; set i9 0
        set j0 0; set j1 0; set j2 0; set j3 0; set j4 0
        set j5 0; set j6 0; set j7 0; set j8 0; set j9 0
        set k0 0; set k1 0; set k2 0; set k3 0; set k4 0
        set k5 0; set k6 0; set k7 0; set k8 0; set k9 0
        set l0 0; set l1 0; set l2 0; set l3 0; set l4 0
        set l5 0; set l6 0; set l7 0; set l8 0; set l9 0
        set m0 0; set m1 0; set m2 0; set m3 0; set m4 0
        set m5 0; set m6 0; set m7 0; set m8 0; set m9 0
        set n0 0; set n1 0; set n2 0; set n3 0; set n4 0
        set n5 0; set n6 0; set n7 0; set n8 0; set n9 0
        set o0 0; set o1 0; set o2 0; set o3 0; set o4 0
        set o5 0; set o6 0; set o7 0; set o8 0; set o9 0
        set p0 0; set p1 0; set p2 0; set p3 0; set p4 0
        set p5 0; set p6 0; set p7 0; set p8 0; set p9 0
        set q0 0; set q1 0; set q2 0; set q3 0; set q4 0
        set q5 0; set q6 0; set q7 0; set q8 0; set q9 0
        set r0 0; set r1 0; set r2 0; set r3 0; set r4 0
        set r5 0; set r6 0; set r7 0; set r8 0; set r9 0
        set s0 0; set s1 0; set s2 0; set s3 0; set s4 0
        set s5 0; set s6 0; set s7 0; set s8 0; set s9 0
        set t0 0; set t1 0; set t2 0; set t3 0; set t4 0
        set t5 0; set t6 0; set t7 0; set t8 0; set t9 0
        set u0 0; set u1 0; set u2 0; set u3 0; set u4 0
        set u5 0; set u6 0; set u7 0; set u8 0; set u9 0
        set v0 0; set v1 0; set v2 0; set v3 0; set v4 0
        set v5 0; set v6 0; set v7 0; set v8 0; set v9 0
        set w0 0; set w1 0; set w2 0; set w3 0; set w4 0
        set w5 0; set w6 0; set w7 0; set w8 0; set w9 0
        set x0 0; set x1 0; set x2 0; set x3 0; set x4 0
        set x5 0; set x6 0; set x7 0; set x8 0; set x9 0
        set y0 0; set y1 0; set y2 0; set y3 0; set y4 0
        set y5 0; set y6 0; set y7 0; set y8 0; set y9 0
        set z0 0; set z1 0; set z2 0; set z3 0; set z4 0
        set z5 0; set z6 0; set z7 0; set z8 0; set z9 0
        # now increment the last one (local var index > 255)
        $z z9
    }
    260locals
} {1}
test incr-2.15 {incr command (not compiled): variable is array} -setup {
    unset -nocomplain a
} -body {
    set z incr
    set a(foo) 27
    $z a(foo) 11
} -cleanup {
    unset -nocomplain a
} -result 38
test incr-2.16 {incr command (not compiled): variable is array, elem substitutions} -setup {
    unset -nocomplain a
} -body {
    set z incr
    set i 5
    set a(foo5) 27
    $z a(foo$i) 11
} -cleanup {
    unset -nocomplain a
} -result 38
test incr-2.17 {incr command (not compiled): increment given, simple int} {
    set z incr
    set i 5
    $z i 123
} 128
test incr-2.18 {incr command (not compiled): increment given, simple int} {
    set z incr
    set i 5
    $z i -100
} -95
test incr-2.19 {incr command (not compiled): increment given, but erroneous} -body {
    set z incr
    set i 5
    catch {$z i [set]} -> opts
    dict get $opts -errorinfo
} -match glob -result {wrong # args: should be "set varName ?newValue?"
    while *ing
"set"*}
test incr-2.20 {incr command (not compiled): increment given, in quotes} {
    set z incr
    set i 25
    $z i "-100"
} -75
test incr-2.21 {incr command (not compiled): increment given, in braces} {
    set z incr
    set i 24
    $z i {126}
} 150
test incr-2.22 {incr command (not compiled): increment given, large int} {
    set z incr
    set i 5
    $z i 200000
} 200005
test incr-2.23 {incr command (not compiled): increment given, formatted int != int} {
    set z incr
    set i 25
    $z i 0o00012345     ;# an octal literal
} 5374
test incr-2.24 {incr command (not compiled): increment given, formatted int != int} -body {
    set z incr
    set i 25
    $z i 1a
} -returnCodes error -result {expected integer but got "1a"}
test incr-2.25 {incr command (not compiled): too many arguments} -body {
    set z incr
    set i 10
    $z i 10 20
} -returnCodes error -result {wrong # args: should be "incr varName ?increment?"}
test incr-2.26 {incr command (not compiled): runtime error, bad variable name} -setup {
    unset -nocomplain {"foo}
} -body {
    set z incr
    $z {"foo}
} -result 1
test incr-2.27 {incr command (not compiled): runtime error, bad variable name} -body {
    set z incr
    list [catch {$z [set]} msg] $msg $::errorInfo
} -match glob -result {1 {wrong # args: should be "set varName ?newValue?"} {wrong # args: should be "set varName ?newValue?"
    while *ing
"set"*}}
test incr-2.28 {incr command (not compiled): runtime error, readonly variable} -body {
    set z incr
    set x 123
    readonly x
    list [catch {$z x 1} msg] $msg $::errorInfo
} -match glob -cleanup {
    unset -nocomplain x
} -result {1 {can't set "x": variable is read-only} {*variable is read-only
    while executing
*
"$z x 1"}}
test incr-2.29 {incr command (not compiled): runtime error, bad variable value} -body {
    set z incr
    set x "  -  "
    $z x 1
} -returnCodes error -result {expected integer but got "  -  "}
test incr-2.30 {incr command (not compiled): bad increment} {
    set z incr
    set x 0
    list [catch {$z x 1a} msg] $msg $::errorInfo
} {1 {expected integer but got "1a"} {expected integer but got "1a"
    (reading increment)
    invoked from within
"$z x 1a"}}
test incr-2.31 {incr command (compiled): bad increment} {
    list [catch {incr x 1a} msg] $msg $::errorInfo
} {1 {expected integer but got "1a"} {expected integer but got "1a"
    (reading increment)
    invoked from within
"incr x 1a"}}

test incr-3.1 {increment by wide amount: bytecode route} {
    set x 0
    incr x 123123123123
} 123123123123
test incr-3.2 {increment by wide amount: command route} {
    set z incr
    set x 0
    $z x 123123123123
} 123123123123

test incr-4.1 {increment non-existing array element [Bug 1445454]} -body {
    proc x {} {incr a(1)}
    x
} -cleanup {
    rename x {}
} -result 1

# cleanup
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# fill-column: 78
# End: