info.test

tcl是工具命令语言

test info-9.5 {info level option} {
    list [catch {info level 1 2} msg] $msg
} {1 {wrong # args: should be "info level ?number?"}}
test info-9.6 {info level option} {
    list [catch {info level 123a} msg] $msg
} {1 {expected integer but got "123a"}}
test info-9.7 {info level option} {
    list [catch {info level 0} msg] $msg
} {1 {bad level "0"}}
test info-9.8 {info level option} {
    proc t1 {} {info level -1}
    list [catch {t1} msg] $msg
} {1 {bad level "-1"}}
test info-9.9 {info level option} {
    proc t1 {x} {info level $x}
    list [catch {t1 -3} msg] $msg
} {1 {bad level "-3"}}
test info-9.10 {info level option, namespaces} {
    set msg [namespace eval t {info level 0}]
    namespace delete t
    set msg
} {namespace eval t {info level 0}}

set savedLibrary $tcl_library
test info-10.1 {info library option} {
    list [catch {info library x} msg] $msg
} {1 {wrong # args: should be "info library"}}
test info-10.2 {info library option} {
    set tcl_library 12345
    info library
} {12345}
test info-10.3 {info library option} {
    unset tcl_library
    list [catch {info library} msg] $msg
} {1 {no library has been specified for Tcl}}
set tcl_library $savedLibrary

test info-11.1 {info loaded option} {
    list [catch {info loaded a b} msg] $msg
} {1 {wrong # args: should be "info loaded ?interp?"}}
test info-11.2 {info loaded option} {
    list [catch {info loaded {}}] [catch {info loaded gorp} msg] $msg
} {0 1 {could not find interpreter "gorp"}}

test info-12.1 {info locals option} {
    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]
} {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} {
    list [catch {info locals 1 2} msg] $msg
} {1 {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} {
    list [catch {info nameofexecutable foo} msg] $msg
} {1 {wrong # args: should be "info nameofexecutable"}}

test info-14.1 {info patchlevel option} {
    set a [info patchlevel]
    regexp {[0-9]+\.[0-9]+([p[0-9]+)?} $a
} 1
test info-14.2 {info patchlevel option} {
    list [catch {info patchlevel a} msg] $msg
} {1 {wrong # args: should be "info patchlevel"}}
test info-14.3 {info patchlevel option} {
    set t $tcl_patchLevel
    unset tcl_patchLevel
    set result [list [catch {info patchlevel} msg] $msg]
    set tcl_patchLevel $t
    set result
} {1 {can't read "tcl_patchLevel": no such variable}}

test info-15.1 {info procs option} {
    proc t1 {} {}
    proc t2 {} {}
    set x " [info procs] "
    list [string match {* t1 *} $x] [string match {* t2 *} $x] \
            [string match {* _undefined_ *} $x]
} {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} {
    list [catch {info procs 2 3} msg] $msg
} {1 {wrong # args: should be "info procs ?pattern?"}}
test info-15.4 {info procs option} {
    catch {namespace delete test_ns_info2}
    namespace eval test_ns_info2 {
        namespace import ::test_ns_info1::*
        proc r {} {}
        list [info procs] [info procs p*]
    }
} {{p q r} p}
test info-15.5 {info procs option with a proc in a namespace} {
    catch {namespace delete test_ns_info2}
    namespace eval test_ns_info2 {
	proc p1 { arg } {
	    puts cmd
	}
        proc p2 { arg } {
	    puts cmd
	}
    }
    info procs ::test_ns_info2::p1
} {::test_ns_info2::p1}
test info-15.6 {info procs option with a pattern in a namespace} {
    catch {namespace delete test_ns_info2}
    namespace eval test_ns_info2 {
	proc p1 { arg } {
	    puts cmd
	}
        proc p2 { arg } {
	    puts cmd
	}
    }
    lsort [info procs ::test_ns_info2::p*]
} [lsort [list ::test_ns_info2::p1 ::test_ns_info2::p2]]
test info-15.7 {info procs option with a global shadowing proc} {
    catch {namespace delete test_ns_info2}
    proc string_cmd { arg } {
        puts cmd
    }
    namespace eval test_ns_info2 {
	proc string_cmd { arg } {
	    puts cmd
	}
    }
    info procs test_ns_info2::string*
} {::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")
if {0} {
test info-15.8 {info procs option with a global shadowing proc} {
    catch {namespace delete test_ns_info2}
    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*]
    }
} [lsort [list string_cmd string_cmd2]]
}

test info-16.1 {info script option} {
    list [catch {info script x x} msg] $msg
} {1 {wrong # args: should be "info script ?filename?"}}
test info-16.2 {info script option} {
    file tail [info sc]
} "info.test"
set gorpfile [makeFile "info script\n" gorp.info]
test info-16.3 {info script option} {
    list [source $gorpfile] [file tail [info script]]
} [list $gorpfile info.test]
test info-16.4 {resetting "info script" after errors} {
    catch {source ~_nobody_/foo}
    file tail [info script]
} "info.test"
test info-16.5 {resetting "info script" after errors} {
    catch {source _nonexistent_}
    file tail [info script]
} "info.test"
test info-16.6 {info script option} {
    set script [info script]
    list [file tail [info script]] \
	    [info script newname.txt] \
	    [file tail [info script $script]]
} [list info.test newname.txt info.test]
test info-16.7 {info script option} {
    set script [info script]
    info script newname.txt
    list [source $gorpfile] [file tail [info script]] \
	    [file tail [info script $script]]
} [list $gorpfile newname.txt info.test]
removeFile gorp.info
set gorpfile [makeFile {list [info script] [info script foo.bar]} gorp.info]
test info-16.8 {info script option} {
    list [source $gorpfile] [file tail [info script]]
} [list [list $gorpfile foo.bar] info.test]
removeFile gorp.info

test info-17.1 {info sharedlibextension option} {
    list [catch {info sharedlibextension foo} msg] $msg
} {1 {wrong # args: should be "info sharedlibextension"}}

test info-18.1 {info tclversion option} {
    set x [info tclversion]
    scan $x "%d.%d%c" a b c
} 2
test info-18.2 {info tclversion option} {
    list [catch {info t 2} msg] $msg
} {1 {wrong # args: should be "info tclversion"}}
test info-18.3 {info tclversion option} {
    set t $tcl_version
    unset tcl_version
    set result [list [catch {info tclversion} msg] $msg]
    set tcl_version $t
    set result
} {1 {can't read "tcl_version": no such variable}}

test info-19.1 {info vars option} {
    set a 1
    set b 2
    proc t1 {x y} {
        global a b
        set c 33
        return [info vars]
    }
    lsort [t1 18 19]
} {a b c x y}
test info-19.2 {info vars option} {
    set xxx1 1
    set xxx2 2
    proc t1 {xxa y} {
        global xxx1 xxx2
        set c 33
        return [info vars x*]
    }
    lsort [t1 18 19]
} {xxa xxx1 xxx2}
test info-19.3 {info vars option} {
    lsort [info vars]
} [lsort [info globals]]
test info-19.4 {info vars option} {
    list [catch {info vars a b} msg] $msg
} {1 {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}

# Check whether the extra testing functions are defined...
if {([catch {expr T1()} msg] == 1) && ($msg == {unknown math function "T1"})} {
    set functions {abs acos asin atan atan2 ceil cos cosh double exp floor fmod hypot int log log10 pow rand round sin sinh sqrt srand tan tanh wide}
} else {
    set functions {T1 T2 T3 abs acos asin atan atan2 ceil cos cosh double exp floor fmod hypot int log log10 pow rand round sin sinh sqrt srand tan tanh wide}
}
test info-20.1 {info functions option} {info functions sin} sin
test info-20.2 {info functions option} {lsort [info functions]} $functions
test info-20.3 {info functions option} {
    lsort [info functions a*]
} {abs acos asin atan atan2}
test info-20.4 {info functions option} {
    lsort [info functions *tan*]
} {atan atan2 tan tanh}
test info-20.5 {info functions option} {
    list [catch {info functions raise an error} msg] $msg
} {1 {wrong # args: should be "info functions ?pattern?"}}

test info-21.1 {miscellaneous error conditions} {
    list [catch {info} msg] $msg
} {1 {wrong # args: should be "info option ?arg arg ...?"}}
test info-21.2 {miscellaneous error conditions} {
    list [catch {info gorp} msg] $msg
} {1 {bad option "gorp": must be args, body, cmdcount, commands, complete, default, exists, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, patchlevel, procs, script, sharedlibextension, tclversion, or vars}}
test info-21.3 {miscellaneous error conditions} {
    list [catch {info c} msg] $msg
} {1 {ambiguous option "c": must be args, body, cmdcount, commands, complete, default, exists, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, patchlevel, procs, script, sharedlibextension, tclversion, or vars}}
test info-21.4 {miscellaneous error conditions} {
    list [catch {info l} msg] $msg
} {1 {ambiguous option "l": must be args, body, cmdcount, commands, complete, default, exists, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, patchlevel, procs, script, sharedlibextension, tclversion, or vars}}
test info-21.5 {miscellaneous error conditions} {
    list [catch {info s} msg] $msg
} {1 {ambiguous option "s": must be args, body, cmdcount, commands, complete, default, exists, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, patchlevel, procs, script, sharedlibextension, tclversion, or vars}}

# cleanup
catch {namespace delete test_ns_info1 test_ns_info2}
::tcltest::cleanupTests
return