Check-in [7996507bc0]
Not logged in

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Merge 8.6
Timelines: family | ancestors | descendants | both | core-8-branch
Files: files | file ages | folders
SHA3-256: 7996507bc0ba51dea7d4a2c8350ed78f7492353b5301d0189a72d151f7dc3948
User & Date: jan.nijtmans 2024-12-18 12:33:21.173
Context
2024-12-23
12:06
Add missing NULLs check-in: 37cd7aaf4a user: dkf tags: core-8-branch
2024-12-18
13:20
Don't shorten "info locals" in testcases. check-in: 903799065b user: jan.nijtmans tags: trunk, main
12:33
Merge 8.6 check-in: 7996507bc0 user: jan.nijtmans tags: core-8-branch
12:07
Don't shorten "info locals" in testcases. check-in: fe2aead830 user: jan.nijtmans tags: core-8-6-branch
2024-12-16
11:12
Remove experimental (and untested) code related to BREAK_NAMESPACE_COMPAT check-in: 78da2fa1f6 user: jan.nijtmans tags: core-8-branch
Changes
Unified Diff Ignore Whitespace Patch
Changes to tests/info.test.
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
    proc t1 {a b} {set c 123; set d $c}
    t1 1 2
    info args t1
} {a b}
test info-1.7 {info args option} {
    catch {namespace delete test_ns_info2}
    namespace eval test_ns_info2 {
        namespace import ::test_ns_info1::*
        list [info args p] [info args q]
    }
} {x {y z}}

test info-2.1 {info body option} {
    proc t1 {} {body of t1}
    info body t1
} {body of t1}
test info-2.2 {info body option} -body {
    info body set
} -returnCodes error -result {"set" isn't a procedure}
test info-2.3 {info body option} -body {
    info args set 1
} -returnCodes error -result {wrong # args: should be "info args procname"}
test info-2.4 {info body option} {
    catch {namespace delete test_ns_info2}
    namespace eval test_ns_info2 {
        namespace import ::test_ns_info1::*
        list [info body p] [info body q]
    }
} {{return "x=$x"} {return "y=$y"}}
# Prior to 8.3.0 this would cause a crash because [info body]
# would return the bytecompiled version of foo, which the catch
# would then try and eval out of the foo context, accessing
# compiled local indices
test info-2.5 {info body option, returning bytecompiled bodies} -body {







|
|
















|
|







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
    proc t1 {a b} {set c 123; set d $c}
    t1 1 2
    info args t1
} {a b}
test info-1.7 {info args option} {
    catch {namespace delete test_ns_info2}
    namespace eval test_ns_info2 {
	namespace import ::test_ns_info1::*
	list [info args p] [info args q]
    }
} {x {y z}}

test info-2.1 {info body option} {
    proc t1 {} {body of t1}
    info body t1
} {body of t1}
test info-2.2 {info body option} -body {
    info body set
} -returnCodes error -result {"set" isn't a procedure}
test info-2.3 {info body option} -body {
    info args set 1
} -returnCodes error -result {wrong # args: should be "info args procname"}
test info-2.4 {info body option} {
    catch {namespace delete test_ns_info2}
    namespace eval test_ns_info2 {
	namespace import ::test_ns_info1::*
	list [info body p] [info body q]
    }
} {{return "x=$x"} {return "y=$y"}}
# Prior to 8.3.0 this would cause a crash because [info body]
# would return the bytecompiled version of foo, which the catch
# would then try and eval out of the foo context, accessing
# compiled local indices
test info-2.5 {info body option, returning bytecompiled bodies} -body {
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
} -returnCodes error -result {wrong # args: should be "info cmdcount"}

test info-4.1 {info commands option} -body {
    proc t1 {} {}
    proc t2 {} {}
    set x " [info commands] "
    list [string match {* t1 *} $x] [string match {* t2 *} $x] \
            [string match {* set *} $x] [string match {* list *} $x]
} -cleanup {unset x} -result {1 1 1 1}
test info-4.2 {info commands option} -body {
    proc t1 {} {}
    rename t1 {}
    string match {* t1 *} \
	[info comm]
} -result 0







|







128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
} -returnCodes error -result {wrong # args: should be "info cmdcount"}

test info-4.1 {info commands option} -body {
    proc t1 {} {}
    proc t2 {} {}
    set x " [info commands] "
    list [string match {* t1 *} $x] [string match {* t2 *} $x] \
	    [string match {* set *} $x] [string match {* list *} $x]
} -cleanup {unset x} -result {1 1 1 1}
test info-4.2 {info commands option} -body {
    proc t1 {} {}
    rename t1 {}
    string match {* t1 *} \
	[info comm]
} -result 0
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
    set a(0) 88
    proc t1 {{a 18} b} {}
    info default t1 a a
} -returnCodes error -result {can't set "a": variable is array}
test info-6.11 {info default option} {
    catch {namespace delete test_ns_info2}
    namespace eval test_ns_info2 {
        namespace import ::test_ns_info1::*
        list [info default p x foo] $foo [info default q y bar] $bar
    }
} {0 {} 1 27}

test info-7.1 {info exists option} -body {
    set value foo
    info exists value
} -cleanup {unset value} -result 1

test info-7.2 {info exists option} -setup {catch {unset _nonexistent_}} -body {
    info exists _nonexistent_
} -result 0
test info-7.3 {info exists option} {
    proc t1 {x} {return [info exists x]}
    t1 2
} 1
test info-7.4 {info exists option} -body {
    proc t1 {x} {
        global _nonexistent_
        return [info exists _nonexistent_]
    }
    t1 2
} -setup {unset -nocomplain _nonexistent_} -result 0
test info-7.5 {info exists option} {
    proc t1 {x} {
        set y 47
        return [info exists y]
    }
    t1 2
} 1
test info-7.6 {info exists option} {
    proc t1 {x} {return [info exists value]}
    t1 2
} 0







|
|

















|
|





|
|







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
    set a(0) 88
    proc t1 {{a 18} b} {}
    info default t1 a a
} -returnCodes error -result {can't set "a": variable is array}
test info-6.11 {info default option} {
    catch {namespace delete test_ns_info2}
    namespace eval test_ns_info2 {
	namespace import ::test_ns_info1::*
	list [info default p x foo] $foo [info default q y bar] $bar
    }
} {0 {} 1 27}

test info-7.1 {info exists option} -body {
    set value foo
    info exists value
} -cleanup {unset value} -result 1

test info-7.2 {info exists option} -setup {catch {unset _nonexistent_}} -body {
    info exists _nonexistent_
} -result 0
test info-7.3 {info exists option} {
    proc t1 {x} {return [info exists x]}
    t1 2
} 1
test info-7.4 {info exists option} -body {
    proc t1 {x} {
	global _nonexistent_
	return [info exists _nonexistent_]
    }
    t1 2
} -setup {unset -nocomplain _nonexistent_} -result 0
test info-7.5 {info exists option} {
    proc t1 {x} {
	set y 47
	return [info exists y]
    }
    t1 2
} 1
test info-7.6 {info exists option} {
    proc t1 {x} {return [info exists value]}
    t1 2
} 0
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294

test info-8.1 {info globals option} -body {
    set x 1
    set y 2
    set value 23
    set a " [info globals] "
    list [string match {* x *} $a] [string match {* y *} $a] \
            [string match {* value *} $a] [string match {* _foobar_ *} $a]
} -cleanup {unset x y value a} -result {1 1 1 0}
test info-8.2 {info globals option} -body {
    set _xxx1 1
    set _xxx2 2
    lsort [info g _xxx*]
} -cleanup {unset _xxx1 _xxx2} -result {_xxx1 _xxx2}
test info-8.3 {info globals option} -returnCodes error -body {







|







280
281
282
283
284
285
286
287
288
289
290
291
292
293
294

test info-8.1 {info globals option} -body {
    set x 1
    set y 2
    set value 23
    set a " [info globals] "
    list [string match {* x *} $a] [string match {* y *} $a] \
	    [string match {* value *} $a] [string match {* _foobar_ *} $a]
} -cleanup {unset x y value a} -result {1 1 1 0}
test info-8.2 {info globals option} -body {
    set _xxx1 1
    set _xxx2 2
    lsort [info g _xxx*]
} -cleanup {unset _xxx1 _xxx2} -result {_xxx1 _xxx2}
test info-8.3 {info globals option} -returnCodes error -body {
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
}

test info-9.1 {info level option} {
    info level
} 0
test info-9.2 {info level option} {
    proc t1 {a b} {
        set x [info le]
        set y [info level 1]
        list $x $y
    }
    t1 146 testString
} {1 {t1 146 testString}}
test info-9.3 {info level option} {
    proc t1 {a b} {
        t2 [expr {$a*2}] $b
    }
    proc t2 {x y} {
        list [info level] [info level 1] [info level 2] [info level -1] \
                [info level 0]
    }
    t1 146 {a {b c} {{{c}}}}
} {2 {t1 146 {a {b c} {{{c}}}}} {t2 292 {a {b c} {{{c}}}}} {t1 146 {a {b c} {{{c}}}}} {t2 292 {a {b c} {{{c}}}}}}
test info-9.4 {info level option} {
    proc t1 {} {
        set x [info level]
        set y [info level 1]
        list $x $y
    }
    t1
} {1 t1}
test info-9.5 {info level option} -body {
    info level 1 2
} -returnCodes error -result {wrong # args: should be "info level ?number?"}
test info-9.6 {info level option} -body {







|
|
|





|


|
|





|
|
|







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
}

test info-9.1 {info level option} {
    info level
} 0
test info-9.2 {info level option} {
    proc t1 {a b} {
	set x [info le]
	set y [info level 1]
	list $x $y
    }
    t1 146 testString
} {1 {t1 146 testString}}
test info-9.3 {info level option} {
    proc t1 {a b} {
	t2 [expr {$a*2}] $b
    }
    proc t2 {x y} {
	list [info level] [info level 1] [info level 2] [info level -1] \
		[info level 0]
    }
    t1 146 {a {b c} {{{c}}}}
} {2 {t1 146 {a {b c} {{{c}}}}} {t2 292 {a {b c} {{{c}}}}} {t1 146 {a {b c} {{{c}}}}} {t2 292 {a {b c} {{{c}}}}}}
test info-9.4 {info level option} {
    proc t1 {} {
	set x [info level]
	set y [info level 1]
	list $x $y
    }
    t1
} {1 t1}
test info-9.5 {info level option} -body {
    info level 1 2
} -returnCodes error -result {wrong # args: should be "info level ?number?"}
test info-9.6 {info level option} -body {
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
test info-11.2 {info loaded option} -body {
    info loaded {}; info loaded gorp
} -returnCodes error -result {could not find interpreter "gorp"}

test info-12.1 {info locals option} -body {
    set a 22
    proc t1 {x y} {
        set b 13
        set c testing
        global a
	global aa
	set aa 23
        return [info locals]
    }
    lsort [t1 23 24]
} -cleanup {unset a aa} -result {b c x y}
test info-12.2 {info locals option} {
    proc t1 {x y} {
        set xx1 2
        set xx2 3
        set y 4
        return [info loc x*]
    }
    lsort [t1 2 3]
} {x xx1 xx2}
test info-12.3 {info locals option} -body {
    info locals 1 2
} -returnCodes error -result {wrong # args: should be "info locals ?pattern?"}
test info-12.4 {info locals option} {
    info locals
} {}
test info-12.5 {info locals option} {
    proc t1 {} {return [info locals]}
    t1
} {}
test info-12.6 {info locals vs unset compiled locals} {
    proc t1 {lst} {
        foreach $lst $lst {}
        unset lst
        return [info locals]
    }
    lsort [t1 {a b c c d e f}]
} {a b c d e f}
test info-12.7 {info locals with temporary variables} {
    proc t1 {} {
        foreach a {b c} {}
        info locals
    }
    t1
} {a}

test info-13.1 {info nameofexecutable option} -returnCodes error -body {
    info nameofexecutable foo
} -result {wrong # args: should be "info nameofexecutable"}







|
|
|


|





|
|
|
|















|
|
|





|
|







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
test info-11.2 {info loaded option} -body {
    info loaded {}; info loaded gorp
} -returnCodes error -result {could not find interpreter "gorp"}

test info-12.1 {info locals option} -body {
    set a 22
    proc t1 {x y} {
	set b 13
	set c testing
	global a
	global aa
	set aa 23
	return [info locals]
    }
    lsort [t1 23 24]
} -cleanup {unset a aa} -result {b c x y}
test info-12.2 {info locals option} {
    proc t1 {x y} {
	set xx1 2
	set xx2 3
	set y 4
	return [info locals x*]
    }
    lsort [t1 2 3]
} {x xx1 xx2}
test info-12.3 {info locals option} -body {
    info locals 1 2
} -returnCodes error -result {wrong # args: should be "info locals ?pattern?"}
test info-12.4 {info locals option} {
    info locals
} {}
test info-12.5 {info locals option} {
    proc t1 {} {return [info locals]}
    t1
} {}
test info-12.6 {info locals vs unset compiled locals} {
    proc t1 {lst} {
	foreach $lst $lst {}
	unset lst
	return [info locals]
    }
    lsort [t1 {a b c c d e f}]
} {a b c d e f}
test info-12.7 {info locals with temporary variables} {
    proc t1 {} {
	foreach a {b c} {}
	info locals
    }
    t1
} {a}

test info-13.1 {info nameofexecutable option} -returnCodes error -body {
    info nameofexecutable foo
} -result {wrong # args: should be "info nameofexecutable"}
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
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
} -returnCodes error -result {can't read "tcl_patchLevel": no such variable}

test info-15.1 {info procs option} -body {
    proc t1 {} {}
    proc t2 {} {}
    set x " [info procs] "
    list [string match {* t1 *} $x] [string match {* t2 *} $x] \
            [string match {* _undefined_ *} $x]
} -cleanup {unset x} -result {1 1 0}
test info-15.2 {info procs option} {
    proc _tt1 {} {}
    proc _tt2 {} {}
    lsort [info pr _tt*]
} {_tt1 _tt2}
catch {rename _tt1 {}}
catch {rename _tt2 {}}
test info-15.3 {info procs option} -body {
    info procs 2 3
} -returnCodes error -result {wrong # args: should be "info procs ?pattern?"}
test info-15.4 {info procs option} -setup {
    catch {namespace delete test_ns_info2}
} -body {
    namespace eval test_ns_info2 {
        namespace import ::test_ns_info1::*
        proc r {} {}
        list [lsort [info procs]] [info procs p*]
    }
} -result {{p q r} p}
test info-15.5 {info procs option with a proc in a namespace} -setup {
    catch {namespace delete test_ns_info2}
} -body {
    namespace eval test_ns_info2 {
	proc p1 { arg } {
	    puts cmd
	}
        proc p2 { arg } {
	    puts cmd
	}
    }
    info procs ::test_ns_info2::p1
} -result {::test_ns_info2::p1}
test info-15.6 {info procs option with a pattern in a namespace} -setup {
    catch {namespace delete test_ns_info2}
} -body {
    namespace eval test_ns_info2 {
	proc p1 { arg } {
	    puts cmd
	}
        proc p2 { arg } {
	    puts cmd
	}
    }
    lsort [info procs ::test_ns_info2::p*]
} -result [lsort [list ::test_ns_info2::p1 ::test_ns_info2::p2]]
test info-15.7 {info procs option with a global shadowing proc} -setup {
    catch {namespace delete test_ns_info2}
} -body {
    proc string_cmd { arg } {
        puts cmd
    }
    namespace eval test_ns_info2 {
	proc string_cmd { arg } {
	    puts cmd
	}
    }
    info procs test_ns_info2::string*
} -result {::test_ns_info2::string_cmd}
# This regression test is currently commented out because it requires
# that the implementation of "info procs" looks into the global namespace,
# which it does not (in contrast to "info commands")
test info-15.8 {info procs option with a global shadowing proc} -setup {
    catch {namespace delete test_ns_info2}
} -constraints knownBug -body {
    proc string_cmd { arg } {
        puts cmd
    }
    proc string_cmd2 { arg } {
        puts cmd
    }
    namespace eval test_ns_info2 {
	proc string_cmd { arg } {
	    puts cmd
	}
    }
    namespace eval test_ns_info2 {
        lsort [info procs string*]
    }
} -result [lsort [list string_cmd string_cmd2]]

test info-16.1 {info script option} -returnCodes error -body {
    info script x x
} -result {wrong # args: should be "info script ?filename?"}
test info-16.2 {info script option} {







|















|
|
|









|












|









|















|


|







|







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
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
} -returnCodes error -result {can't read "tcl_patchLevel": no such variable}

test info-15.1 {info procs option} -body {
    proc t1 {} {}
    proc t2 {} {}
    set x " [info procs] "
    list [string match {* t1 *} $x] [string match {* t2 *} $x] \
	    [string match {* _undefined_ *} $x]
} -cleanup {unset x} -result {1 1 0}
test info-15.2 {info procs option} {
    proc _tt1 {} {}
    proc _tt2 {} {}
    lsort [info pr _tt*]
} {_tt1 _tt2}
catch {rename _tt1 {}}
catch {rename _tt2 {}}
test info-15.3 {info procs option} -body {
    info procs 2 3
} -returnCodes error -result {wrong # args: should be "info procs ?pattern?"}
test info-15.4 {info procs option} -setup {
    catch {namespace delete test_ns_info2}
} -body {
    namespace eval test_ns_info2 {
	namespace import ::test_ns_info1::*
	proc r {} {}
	list [lsort [info procs]] [info procs p*]
    }
} -result {{p q r} p}
test info-15.5 {info procs option with a proc in a namespace} -setup {
    catch {namespace delete test_ns_info2}
} -body {
    namespace eval test_ns_info2 {
	proc p1 { arg } {
	    puts cmd
	}
	proc p2 { arg } {
	    puts cmd
	}
    }
    info procs ::test_ns_info2::p1
} -result {::test_ns_info2::p1}
test info-15.6 {info procs option with a pattern in a namespace} -setup {
    catch {namespace delete test_ns_info2}
} -body {
    namespace eval test_ns_info2 {
	proc p1 { arg } {
	    puts cmd
	}
	proc p2 { arg } {
	    puts cmd
	}
    }
    lsort [info procs ::test_ns_info2::p*]
} -result [lsort [list ::test_ns_info2::p1 ::test_ns_info2::p2]]
test info-15.7 {info procs option with a global shadowing proc} -setup {
    catch {namespace delete test_ns_info2}
} -body {
    proc string_cmd { arg } {
	puts cmd
    }
    namespace eval test_ns_info2 {
	proc string_cmd { arg } {
	    puts cmd
	}
    }
    info procs test_ns_info2::string*
} -result {::test_ns_info2::string_cmd}
# This regression test is currently commented out because it requires
# that the implementation of "info procs" looks into the global namespace,
# which it does not (in contrast to "info commands")
test info-15.8 {info procs option with a global shadowing proc} -setup {
    catch {namespace delete test_ns_info2}
} -constraints knownBug -body {
    proc string_cmd { arg } {
	puts cmd
    }
    proc string_cmd2 { arg } {
	puts cmd
    }
    namespace eval test_ns_info2 {
	proc string_cmd { arg } {
	    puts cmd
	}
    }
    namespace eval test_ns_info2 {
	lsort [info procs string*]
    }
} -result [lsort [list string_cmd string_cmd2]]

test info-16.1 {info script option} -returnCodes error -body {
    info script x x
} -result {wrong # args: should be "info script ?filename?"}
test info-16.2 {info script option} {
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
    info sharedlibextension foo
} -result {wrong # args: should be "info sharedlibextension"}

test info-18.1 {info tclversion option} -body {
    scan [info tclversion] "%d.%d%c" a b c
} -cleanup {unset -nocomplain a b c} -result 2
test info-18.2 {info tclversion option} -body {
    info t 2
} -returnCodes error -result {wrong # args: should be "info tclversion"}
test info-18.3 {info tclversion option} -body {
    unset tcl_version
    info tclversion
} -returnCodes error -setup {
    set t $tcl_version
} -cleanup {
    set tcl_version $t; unset t
} -result {can't read "tcl_version": no such variable}

test info-19.1 {info vars option} -body {
    set a 1
    set b 2
    proc t1 {x y} {
        global a b
        set c 33
        return [info vars]
    }
    lsort [t1 18 19]
} -cleanup {unset a b} -result {a b c x y}
test info-19.2 {info vars option} -body {
    set xxx1 1
    set xxx2 2
    proc t1 {xxa y} {
        global xxx1 xxx2
        set c 33
        return [info vars x*]
    }
    lsort [t1 18 19]
} -cleanup {unset xxx1 xxx2} -result {xxa xxx1 xxx2}
test info-19.3 {info vars option} {
    lsort [info vars]
} [lsort [info globals]]
test info-19.4 {info vars option} -returnCodes error -body {
    info vars a b
} -result {wrong # args: should be "info vars ?pattern?"}
test info-19.5 {info vars with temporary variables} {
    proc t1 {} {
        foreach a {b c} {}
        info vars
    }
    t1
} {a}
test info-19.6 {info vars: Bug 1072654} -setup {
    namespace eval :: unset -nocomplain foo
    catch {namespace delete x}
} -body {







|














|
|
|







|
|
|











|
|







598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
    info sharedlibextension foo
} -result {wrong # args: should be "info sharedlibextension"}

test info-18.1 {info tclversion option} -body {
    scan [info tclversion] "%d.%d%c" a b c
} -cleanup {unset -nocomplain a b c} -result 2
test info-18.2 {info tclversion option} -body {
    info tclv 2
} -returnCodes error -result {wrong # args: should be "info tclversion"}
test info-18.3 {info tclversion option} -body {
    unset tcl_version
    info tclversion
} -returnCodes error -setup {
    set t $tcl_version
} -cleanup {
    set tcl_version $t; unset t
} -result {can't read "tcl_version": no such variable}

test info-19.1 {info vars option} -body {
    set a 1
    set b 2
    proc t1 {x y} {
	global a b
	set c 33
	return [info vars]
    }
    lsort [t1 18 19]
} -cleanup {unset a b} -result {a b c x y}
test info-19.2 {info vars option} -body {
    set xxx1 1
    set xxx2 2
    proc t1 {xxa y} {
	global xxx1 xxx2
	set c 33
	return [info vars x*]
    }
    lsort [t1 18 19]
} -cleanup {unset xxx1 xxx2} -result {xxa xxx1 xxx2}
test info-19.3 {info vars option} {
    lsort [info vars]
} [lsort [info globals]]
test info-19.4 {info vars option} -returnCodes error -body {
    info vars a b
} -result {wrong # args: should be "info vars ?pattern?"}
test info-19.5 {info vars with temporary variables} {
    proc t1 {} {
	foreach a {b c} {}
	info vars
    }
    t1
} {a}
test info-19.6 {info vars: Bug 1072654} -setup {
    namespace eval :: unset -nocomplain foo
    catch {namespace delete x}
} -body {
1595
1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
} {
type source line 1587 file info.test cmd {info frame 0} proc ::a level 0
type source line 1589 file info.test cmd {info frame 0} proc ::a level 0}

test info-30.17 {bs+nl in multi-body switch, direct} {
    switch -regexp -- {key    } \
	^key     { reduce [info frame 0] ;# 1601 } \
        \t###    { } \
        {[0-9]*} { }
} {type source line 1601 file info.test cmd {info frame 0} proc ::tcltest::RunTest}

test info-30.18 {bs+nl, literal word, uplevel through proc, appended, loss of primary tracking data} {
    proc abra {script} {
	append script "\n# end of script"
	uplevel 1 $script
    }







|
|







1595
1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
} {
type source line 1587 file info.test cmd {info frame 0} proc ::a level 0
type source line 1589 file info.test cmd {info frame 0} proc ::a level 0}

test info-30.17 {bs+nl in multi-body switch, direct} {
    switch -regexp -- {key    } \
	^key     { reduce [info frame 0] ;# 1601 } \
	\t###    { } \
	{[0-9]*} { }
} {type source line 1601 file info.test cmd {info frame 0} proc ::tcltest::RunTest}

test info-30.18 {bs+nl, literal word, uplevel through proc, appended, loss of primary tracking data} {
    proc abra {script} {
	append script "\n# end of script"
	uplevel 1 $script
    }
1638
1639
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652

test info-30.20 {bs+nl in single-body switch, direct} {
    switch -regexp -- {key    } { \

	^key     { reduce \
		       [info frame 0] }
	\t###    { }
        {[0-9]*} { }
    }
} {type source line 1643 file info.test cmd {info frame 0} proc ::tcltest::RunTest}

test info-30.21 {bs+nl in if, full compiled} {
    proc a {value} {
	if {$value} \
	    {info frame 0} \







|







1638
1639
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652

test info-30.20 {bs+nl in single-body switch, direct} {
    switch -regexp -- {key    } { \

	^key     { reduce \
		       [info frame 0] }
	\t###    { }
	{[0-9]*} { }
    }
} {type source line 1643 file info.test cmd {info frame 0} proc ::tcltest::RunTest}

test info-30.21 {bs+nl in if, full compiled} {
    proc a {value} {
	if {$value} \
	    {info frame 0} \
Changes to tests/oo.test.
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
	package require tcl::oo
	namespace delete ::
    }
    interp delete $i
} {}
test oo-0.3 {basic test of OO's ability to clean up its initial state} -body {
    leaktest {
        [oo::object new] destroy
    }
} -constraints memory -result 0
test oo-0.4 {basic test of OO's ability to clean up its initial state} -body {
    leaktest {
	oo::class create foo
	foo new
	foo destroy







|







62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
	package require tcl::oo
	namespace delete ::
    }
    interp delete $i
} {}
test oo-0.3 {basic test of OO's ability to clean up its initial state} -body {
    leaktest {
	[oo::object new] destroy
    }
} -constraints memory -result 0
test oo-0.4 {basic test of OO's ability to clean up its initial state} -body {
    leaktest {
	oo::class create foo
	foo new
	foo destroy
1577
1578
1579
1580
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
	oo::class create spong {superclass boo}
	return
    }
} -result {}
test oo-7.10 {OO: next after object deletion, bug [135804138e]} -setup {
    set ::result ""
    oo::class create c1 {
        method m1 {} {
           lappend ::result c1::m1
        }
    }
    oo::class create c2 {
        superclass c1
        destructor {
            lappend ::result c2::destructor
            my m1
            lappend ::result /c2::destructor
        }
        method m1 {} {
            lappend ::result c2::m1
            rename [self] {}
            lappend ::result no-self
            next
            lappend ::result /c2::m1
        }
    }
} -body {
    c2 create o
    lappend ::result [catch {o m1} msg] $msg
} -cleanup {
    c1 destroy
    unset ::result







|
|
|


|
|
|
|
|
|
|
|
|
|
|
|
|







1577
1578
1579
1580
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
	oo::class create spong {superclass boo}
	return
    }
} -result {}
test oo-7.10 {OO: next after object deletion, bug [135804138e]} -setup {
    set ::result ""
    oo::class create c1 {
	method m1 {} {
	   lappend ::result c1::m1
	}
    }
    oo::class create c2 {
	superclass c1
	destructor {
	    lappend ::result c2::destructor
	    my m1
	    lappend ::result /c2::destructor
	}
	method m1 {} {
	    lappend ::result c2::m1
	    rename [self] {}
	    lappend ::result no-self
	    next
	    lappend ::result /c2::m1
	}
    }
} -body {
    c2 create o
    lappend ::result [catch {o m1} msg] $msg
} -cleanup {
    c1 destroy
    unset ::result
3098
3099
3100
3101
3102
3103
3104
3105
3106
3107
3108
3109
3110
3111
3112
"self {error foobar}"
    (in definition script for class "::bar" line 1)
    invoked from within
"oo::define foo {rename ::foo ::bar; self {error foobar}}"}
test oo-18.9 {OO: define/self command support} -setup {
    oo::class create parent
    set c [oo::class create now_this_is_a_very_very_long_class_name_indeed {
        superclass parent
    }]
} -body {
    catch {oo::define $c {error err}} msg opt
    dict get $opt -errorinfo
} -cleanup {
    parent destroy
} -result {err







|







3098
3099
3100
3101
3102
3103
3104
3105
3106
3107
3108
3109
3110
3111
3112
"self {error foobar}"
    (in definition script for class "::bar" line 1)
    invoked from within
"oo::define foo {rename ::foo ::bar; self {error foobar}}"}
test oo-18.9 {OO: define/self command support} -setup {
    oo::class create parent
    set c [oo::class create now_this_is_a_very_very_long_class_name_indeed {
	superclass parent
    }]
} -body {
    catch {oo::define $c {error err}} msg opt
    dict get $opt -errorinfo
} -cleanup {
    parent destroy
} -result {err
3981
3982
3983
3984
3985
3986
3987
3988
3989
3990
3991
3992
3993
3994
3995
	variable x!
	constructor {} {set x! 1}
	method y {} {incr x!}
    }
    foo create bar
    oo::objdefine bar {
	variable y!
	method y {} {list [next] [incr y!] [info var] [info local]}
	export eval
    }
    bar y
    list [bar y] [lsort [info object vars bar]] [bar eval {info vars *!}]
} -result {{3 2 y! {}} {x! y!} {x! y!}}
test oo-27.7 {variables declaration - one underlying variable space} -setup {
    oo::class create parent







|







3981
3982
3983
3984
3985
3986
3987
3988
3989
3990
3991
3992
3993
3994
3995
	variable x!
	constructor {} {set x! 1}
	method y {} {incr x!}
    }
    foo create bar
    oo::objdefine bar {
	variable y!
	method y {} {list [next] [incr y!] [info var] [info locals]}
	export eval
    }
    bar y
    list [bar y] [lsort [info object vars bar]] [bar eval {info vars *!}]
} -result {{3 2 y! {}} {x! y!} {x! y!}}
test oo-27.7 {variables declaration - one underlying variable space} -setup {
    oo::class create parent