Diff
Not logged in

Differences From Artifact [c2cf8cf9e0]:

To Artifact [b16575dff2]:


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
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







-


+











-
+







#
# DO NOT DELETE THIS LINE

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

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]
testConstraint zlib [llength [info commands zlib]]

# Set up namespaces needed to test operation of "info args", "info body",
# "info default", and "info procs" with imported procedures.

catch {namespace delete test_ns_info1 test_ns_info2}

namespace eval test_ns_info1 {
    namespace export *
    proc p {x} {return "x=$x"}
    proc q {{y 27} {z {}}} {return "y=$y"}
}


test info-1.1 {info args option} {
    proc t1 {a bbb c} {return foo}
    info args t1
} {a bbb c}
test info-1.2 {info args option} {
    proc t1 {{a default1} {bbb default2} {c default3} args} {return foo}
    info a t1
106
107
108
109
110
111
112
113

114
115
116
117
118
119
120
121
122

123
124
125
126
127
128
129
106
107
108
109
110
111
112

113
114
115
116
117
118
119
120
121

122
123
124
125
126
127
128
129







-
+








-
+







    list [string bytelength [info body foo]] \
	    [foo; string bytelength [info body foo]]
} {9 9}

proc testinfocmdcount {} {
    set x [info cmdcount]
    set y 12345
    set z [info cm]
    set z [info cmdc]
    expr {$z-$x}
}
test info-3.1 {info cmdcount compiled} {
    testinfocmdcount
} 4
test info-3.2 {info cmdcount evaled} -body {
    set x [info cmdcount]
    set y 12345
    set z [info cm]
    set z [info cmdc]
    expr {$z-$x}
} -cleanup {unset x y z} -result 4
test info-3.3 {info cmdcount evaled} -body [info body testinfocmdcount] -cleanup {unset x y z} -result 4
test info-3.4 {info cmdcount option} -body {
    info cmdcount 1
} -returnCodes error -result {wrong # args: should be "info cmdcount"}

674
675
676
677
678
679
680
681

682
683
684

685
686
687

688
689
690

691
692
693
694
695
696
697
674
675
676
677
678
679
680

681
682
683

684
685
686

687
688
689

690
691
692
693
694
695
696
697







-
+


-
+


-
+


-
+







unset functions msg

test info-21.1 {miscellaneous error conditions} -returnCodes error -body {
    info
} -result {wrong # args: should be "info subcommand ?arg ...?"}
test info-21.2 {miscellaneous error conditions} -returnCodes error -body {
    info gorp
} -result {unknown or ambiguous subcommand "gorp": must be args, body, class, cmdcount, commands, complete, coroutine, default, errorstack, exists, frame, functions, globals, hostname, level, library, linkedname, loaded, locals, nameofexecutable, object, patchlevel, procs, script, sharedlibextension, tclversion, or vars}
} -result {unknown or ambiguous subcommand "gorp": must be args, body, class, cmdcount, cmdtype, commands, complete, coroutine, default, errorstack, exists, frame, functions, globals, hostname, level, library, linkedname, loaded, locals, nameofexecutable, object, patchlevel, procs, script, sharedlibextension, tclversion, or vars}
test info-21.3 {miscellaneous error conditions} -returnCodes error -body {
    info c
} -result {unknown or ambiguous subcommand "c": must be args, body, class, cmdcount, commands, complete, coroutine, default, errorstack, exists, frame, functions, globals, hostname, level, library, linkedname, loaded, locals, nameofexecutable, object, patchlevel, procs, script, sharedlibextension, tclversion, or vars}
} -result {unknown or ambiguous subcommand "c": must be args, body, class, cmdcount, cmdtype, commands, complete, coroutine, default, errorstack, exists, frame, functions, globals, hostname, level, library, linkedname, loaded, locals, nameofexecutable, object, patchlevel, procs, script, sharedlibextension, tclversion, or vars}
test info-21.4 {miscellaneous error conditions} -returnCodes error -body {
    info l
} -result {unknown or ambiguous subcommand "l": must be args, body, class, cmdcount, commands, complete, coroutine, default, errorstack, exists, frame, functions, globals, hostname, level, library, linkedname, loaded, locals, nameofexecutable, object, patchlevel, procs, script, sharedlibextension, tclversion, or vars}
} -result {unknown or ambiguous subcommand "l": must be args, body, class, cmdcount, cmdtype, commands, complete, coroutine, default, errorstack, exists, frame, functions, globals, hostname, level, library, linkedname, loaded, locals, nameofexecutable, object, patchlevel, procs, script, sharedlibextension, tclversion, or vars}
test info-21.5 {miscellaneous error conditions} -returnCodes error -body {
    info s
} -result {unknown or ambiguous subcommand "s": must be args, body, class, cmdcount, commands, complete, coroutine, default, errorstack, exists, frame, functions, globals, hostname, level, library, linkedname, loaded, locals, nameofexecutable, object, patchlevel, procs, script, sharedlibextension, tclversion, or vars}
} -result {unknown or ambiguous subcommand "s": must be args, body, class, cmdcount, cmdtype, commands, complete, coroutine, default, errorstack, exists, frame, functions, globals, hostname, level, library, linkedname, loaded, locals, nameofexecutable, object, patchlevel, procs, script, sharedlibextension, tclversion, or vars}

##
# ### ### ### ######### ######### #########
## info frame

## Helper
# For the more complex results we cut the file name down to remove path
2391
2392
2393
2394
2395
2396
2397
2398








































































































































































2399
2400
2401

2402
2403
2404
2405
2406
2407
2408
2391
2392
2393
2394
2395
2396
2397
2398
2399
2400
2401
2402
2403
2404
2405
2406
2407
2408
2409
2410
2411
2412
2413
2414
2415
2416
2417
2418
2419
2420
2421
2422
2423
2424
2425
2426
2427
2428
2429
2430
2431
2432
2433
2434
2435
2436
2437
2438
2439
2440
2441
2442
2443
2444
2445
2446
2447
2448
2449
2450
2451
2452
2453
2454
2455
2456
2457
2458
2459
2460
2461
2462
2463
2464
2465
2466
2467
2468
2469
2470
2471
2472
2473
2474
2475
2476
2477
2478
2479
2480
2481
2482
2483
2484
2485
2486
2487
2488
2489
2490
2491
2492
2493
2494
2495
2496
2497
2498
2499
2500
2501
2502
2503
2504
2505
2506
2507
2508
2509
2510
2511
2512
2513
2514
2515
2516
2517
2518
2519
2520
2521
2522
2523
2524
2525
2526
2527
2528
2529
2530
2531
2532
2533
2534
2535
2536
2537
2538
2539
2540
2541
2542
2543
2544
2545
2546
2547
2548
2549
2550
2551
2552
2553
2554
2555
2556
2557
2558
2559
2560
2561
2562
2563
2564
2565
2566
2567
2568

2569
2570
2571
2572
2573
2574
2575
2576








+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+


-
+







}
test info-33.35 {{*}, literal, simple, bytecompiled} -body {
    reduce [foo::bar]
} -cleanup {
    namespace delete foo
} -result {type source line 2389 file info.test cmd {info frame 0} proc ::foo::bar level 0}

# -------------------------------------------------------------------------
namespace eval ::testinfocmdtype {
    apply {cmds {
	foreach c $cmds {rename $c {}}
    } ::testinfocmdtype} [info commands ::testinfocmdtype::*]
}
test info-40.1 {info cmdtype: syntax} -body {
    info cmdtype
} -returnCodes error -result {wrong # args: should be "info cmdtype commandName"}
test info-40.2 {info cmdtype: syntax} -body {
    info cmdtype foo bar
} -returnCodes error -result {wrong # args: should be "info cmdtype commandName"}
test info-40.3 {info cmdtype: no such command} -body {
    info cmdtype ::testinfocmdtype::foo
} -returnCodes error -result {unknown command "::testinfocmdtype::foo"}
test info-40.4 {info cmdtype: native commands} -body {
    info cmdtype ::if
} -result native
test info-40.5 {info cmdtype: native commands} -body {
    info cmdtype ::puts
} -result native
test info-40.6 {info cmdtype: native commands} -body {
    info cmdtype ::yield
} -result native
test info-40.7 {info cmdtype: procedures} -setup {
    proc ::testinfocmdtype::someproc {} {}
} -body {
    info cmdtype ::testinfocmdtype::someproc
} -cleanup {
    rename ::testinfocmdtype::someproc {}
} -result proc
test info-40.8 {info cmdtype: aliases} -setup {
    interp alias {} ::testinfocmdtype::somealias {} ::puts
} -body {
    info cmdtype ::testinfocmdtype::somealias
} -cleanup {
    rename ::testinfocmdtype::somealias {}
} -result alias
test info-40.9 {info cmdtype: imports} -setup {
    namespace eval ::testinfocmdtype {
	namespace eval foo {
	    proc bar {} {}
	    namespace export bar
	}
	namespace import foo::bar
    }
} -body {
    info cmdtype ::testinfocmdtype::bar
} -cleanup {
    rename ::testinfocmdtype::bar {}
    namespace delete ::testinfocmdtype::foo
} -result import
test info-40.10 {info cmdtype: slaves} -setup {
    apply {i {
	rename $i ::testinfocmdtype::slave
	variable ::testinfocmdtype::slave $i
    }} [interp create]
} -body {
    info cmdtype ::testinfocmdtype::slave
} -cleanup {
    interp delete $::testinfocmdtype::slave
} -result slave
test info-40.11 {info cmdtype: objects} -setup {
    apply {{} {
	oo::object create obj
    } ::testinfocmdtype}
} -body {
    info cmdtype ::testinfocmdtype::obj
} -cleanup {
    ::testinfocmdtype::obj destroy
} -result object
test info-40.12 {info cmdtype: objects} -setup {
    apply {{} {
	oo::object create obj
    } ::testinfocmdtype}
} -body {
    info cmdtype [info object namespace ::testinfocmdtype::obj]::my
} -cleanup {
    ::testinfocmdtype::obj destroy
} -result privateObject
test info-40.13 {info cmdtype: ensembles} -setup {
    namespace eval ::testinfocmdtype {
	namespace eval ensmbl {
	    proc bar {} {}
	    namespace export *
	    namespace ensemble create
	}
    }
} -body {
    info cmdtype ::testinfocmdtype::ensmbl
} -cleanup {
    namespace delete ::testinfocmdtype::ensmbl
} -result ensemble
test info-40.14 {info cmdtype: zlib streams} -constraints zlib -setup {
    namespace eval ::testinfocmdtype {
	rename [zlib stream gzip] zstream
    }
} -body {
    info cmdtype ::testinfocmdtype::zstream
} -cleanup {
    ::testinfocmdtype::zstream close
} -result zlibStream
test info-40.15 {info cmdtype: coroutines} -setup {
    coroutine ::testinfocmdtype::coro eval yield
} -body {
    info cmdtype ::testinfocmdtype::coro
} -cleanup {
    ::testinfocmdtype::coro
} -result coroutine
test info-40.16 {info cmdtype: dynamic behavior} -setup {
    proc ::testinfocmdtype::foo {} {}
} -body {
    namespace eval ::testinfocmdtype {
	list [catch {info cmdtype foo}] [catch {info cmdtype bar}] \
	    [namespace which foo] [rename foo bar] [namespace which bar] \
	    [catch {info cmdtype foo}] [catch {info cmdtype bar}]
    }
} -cleanup {
    namespace eval ::testinfocmdtype {
	catch {rename foo {}}
	catch {rename bar {}}
    }
} -result {0 1 ::testinfocmdtype::foo {} ::testinfocmdtype::bar 1 0}
test info-40.17 {info cmdtype: aliases in slave interpreters} -setup {
    set i [interp create]
} -body {
    $i alias foo gorp
    $i eval {
	info cmdtype foo
    }
} -cleanup {
    interp delete $i
} -result alias
test info-40.18 {info cmdtype: aliases in slave interpreters} -setup {
    set safe [interp create -safe]
} -body {
    $safe alias foo gorp
    $safe eval {
	info cmdtype foo
    }
} -returnCodes error -cleanup {
    interp delete $safe
} -result {not allowed to invoke subcommand cmdtype of info}
test info-40.19 {info cmdtype: aliases in slave interpreters} -setup {
    set safe [interp create -safe]
} -body {
    set inner [interp create [list $safe bar]]
    interp alias $inner foo $safe gorp
    $safe eval {
	bar eval {
	    info cmdtype foo
	}
    }
} -returnCodes error -cleanup {
    interp delete $safe
} -result {not allowed to invoke subcommand cmdtype of info}
test info-40.20 {info cmdtype: aliases in slave interpreters} -setup {
    set safe [interp create -safe]
} -body {
    $safe eval {
	interp alias {} foo {} gorp
	info cmdtype foo
    }
} -returnCodes error -cleanup {
    interp delete $safe
} -result {not allowed to invoke subcommand cmdtype of info}
namespace delete ::testinfocmdtype

# -------------------------------------------------------------------------
unset -nocomplain res

test info-39.0 {Bug 4b61afd660} -setup {
test info-39.2 {Bug 4b61afd660} -setup {
    proc probe {} {
	return [dict get [info frame -1] line]
    }
    set body {
	set cmd probe
	$cmd
    }