archie/tcl7.3/tests/info.test

# Commands covered:  info
#
# 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) 1991-1993 The Regents of the University of California.
# All rights reserved.
#
# Permission is hereby granted, without written agreement and without
# license or royalty fees, to use, copy, modify, and distribute this
# software and its documentation for any purpose, provided that the
# above copyright notice and the following two paragraphs appear in
# all copies of this software.
#
# IN NO EVENT SHALL THE UNIVERSITY OF CALIFORNIA BE LIABLE TO ANY PARTY FOR
# DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT
# OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN IF THE UNIVERSITY OF
# CALIFORNIA HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
#
# THE UNIVERSITY OF CALIFORNIA SPECIFICALLY DISCLAIMS ANY WARRANTIES,
# INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY
# AND FITNESS FOR A PARTICULAR PURPOSE.  THE SOFTWARE PROVIDED HEREUNDER IS
# ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION TO
# PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.
#
# $Header: /user6/ouster/tcl/tests/RCS/info.test,v 1.17 93/10/13 13:02:02 ouster Exp $ (Berkeley)

if {[string compare test [info procs test]] == 1} then {source defs}

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
} {a bbb c args}
test info-1.3 {info args option} {
    proc t1 "" {return foo}
    info args t1
} {}
test info-1.4 {info args option} {
    catch {rename t1 {}}
    list [catch {info args t1} msg] $msg
} {1 {"t1" isn't a procedure}}
test info-1.5 {info args option} {
    list [catch {info args set} msg] $msg
} {1 {"set" isn't a procedure}}

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} {
    list [catch {info body set} msg] $msg
} {1 {"set" isn't a procedure}}
test info-2.3 {info body option} {
    list [catch {info args set 1} msg] $msg
} {1 {wrong # args: should be "info args procname"}}

test info-3.1 {info cmdcount option} {
    set x [info cmdcount]
    set y 12345
    set z [info cm]
    expr $z-$x
} 3
test info-3.2 {info body option} {
    list [catch {info cmdcount 1} msg] $msg
} {1 {wrong # args: should be "info cmdcount"}}

test info-4.1 {info commands option} {
    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]
} {1 1 1 1}
test info-4.2 {info commands option} {
    proc t1 {} {}
    rename t1 {}
    set x [info comm]
    string match {* t1 *} $x
} 0
test info-4.3 {info commands option} {
    proc _t1_ {} {}
    proc _t2_ {} {}
    info commands _t1_
} _t1_
test info-4.4 {info commands option} {
    proc _t1_ {} {}
    proc _t2_ {} {}
    lsort [info commands _t*]
} {_t1_ _t2_}
catch {rename _t1_ {}}
catch {rename _t2_ {}}
test info-4.5 {info commands option} {
    list [catch {info commands a b} msg] $msg
} {1 {wrong # args: should be "info commands [pattern]"}}

test info-5.1 {info complete option} {
    info complete ""
} 1
test info-5.2 {info complete option} {
    info complete "  \n"
} 1
test info-5.3 {info complete option} {
    info complete "abc def"
} 1
test info-5.4 {info complete option} {
    info complete "a b c d e f \t\n"
} 1
test info-5.5 {info complete option} {
    info complete {a b c"d}
} 1
test info-5.6 {info complete option} {
    info complete {a b "c d" e}
} 1
test info-5.7 {info complete option} {
    info complete {a b "c d"}
} 1
test info-5.8 {info complete option} {
    info complete {a b "c d"}
} 1
test info-5.9 {info complete option} {
    info complete {a b "c d}
} 0
test info-5.10 {info complete option} {
    info complete {a b "}
} 0
test info-5.11 {info complete option} {
    info complete {a b "cd"xyz}
} 1
test info-5.12 {info complete option} {
    info complete {a b "c $d() d"}
} 1
test info-5.13 {info complete option} {
    info complete {a b "c $dd("}
} 0
test info-5.14 {info complete option} {
    info complete {a b "c \"}
} 0
test info-5.15 {info complete option} {
    info complete {a b "c [d e f]"}
} 1
test info-5.16 {info complete option} {
    info complete {a b "c [d e f] g"}
} 1
test info-5.17 {info complete option} {
    info complete {a b "c [d e f"}
} 0
test info-5.18 {info complete option} {
    info complete {a {b c d} e}
} 1
test info-5.19 {info complete option} {
    info complete {a {b c d}}
} 1
test info-5.20 {info complete option} {
    info complete "a b\{c d"
} 1
test info-5.21 {info complete option} {
    info complete "a b \{c"
} 0
test info-5.22 {info complete option} {
    info complete "a b \{c{ }"
} 0
test info-5.23 {info complete option} {
    info complete "a b {c d e}xxx"
} 1
test info-5.24 {info complete option} {
    info complete "a b {c \\\{d e}xxx"
} 1
test info-5.25 {info complete option} {
    info complete {a b [ab cd ef]}
} 1
test info-5.26 {info complete option} {
    info complete {a b x[ab][cd][ef] gh}
} 1
test info-5.27 {info complete option} {
    info complete {a b x[ab][cd[ef] gh}
} 0
test info-5.28 {info complete option} {
    info complete {a b x[ gh}
} 0
test info-5.29 {info complete option} {
    info complete {[]]]}
} 1
test info-5.30 {info complete option} {
    info complete {abc x$yyy}
} 1
test info-5.31 {info complete option} {
    info complete "abc x\${abc\[\\d} xyz"
} 1
test info-5.32 {info complete option} {
    info complete "abc x\$\{ xyz"
} 0
test info-5.33 {info complete option} {
    info complete {word $a(xyz)}
} 1
test info-5.34 {info complete option} {
    info complete {word $a(}
} 0
test info-5.35 {info complete option} {
    info complete "set a \\\n"
} 0
test info-5.36 {info complete option} {
    info complete "set a \\n "
} 1
test info-5.37 {info complete option} {
    info complete "set a \\"
} 1
test info-5.38 {info complete option} {
    info complete "foo \\\n\{"
} 0
test info-5.39 {info complete option} {
    info complete " # \{"
} 1
test info-5.40 {info complete option} {
    info complete "foo bar;# \{"
} 1
test info-5.41 {info complete option} {
    info complete "a\nb\n# \{\n# \{\nc\n"
} 1

test info-6.1 {info default option} {
    proc t1 {a b {c d} {e "long default value"}} {}
    info default t1 a value
} 0
test info-6.2 {info default option} {
    proc t1 {a b {c d} {e "long default value"}} {}
    set value 12345
    info d t1 a value
    set value
} {}
test info-6.3 {info default option} {
    proc t1 {a b {c d} {e "long default value"}} {}
    info default t1 c value
} 1
test info-6.4 {info default option} {
    proc t1 {a b {c d} {e "long default value"}} {}
    set value 12345
    info default t1 c value
    set value
} d
test info-6.5 {info default option} {
    proc t1 {a b {c d} {e "long default value"}} {}
    set value 12345
    set x [info default t1 e value]
    list $x $value
} {1 {long default value}}
test info-6.6 {info default option} {
    list [catch {info default a b} msg] $msg
} {1 {wrong # args: should be "info default procname arg varname"}}
test info-6.7 {info default option} {
    list [catch {info default _nonexistent_ a b} msg] $msg
} {1 {"_nonexistent_" isn't a procedure}}
test info-6.8 {info default option} {
    proc t1 {a b} {}
    list [catch {info default t1 x value} msg] $msg
} {1 {procedure "t1" doesn't have an argument "x"}}
test info-6.9 {info default option} {
    catch {unset a}
    set a(0) 88
    proc t1 {a b} {}
    list [catch {info default t1 a a} msg] $msg
} {1 {couldn't store default value in variable "a"}}
test info-6.10 {info default option} {
    catch {unset a}
    set a(0) 88
    proc t1 {{a 18} b} {}
    list [catch {info default t1 a a} msg] $msg
} {1 {couldn't store default value in variable "a"}}
catch {unset a}

test info-7.1 {info exists option} {
    set value foo
    info exists value
} 1
catch {unset _nonexistent_}
test info-7.2 {info exists option} {
    info exists _nonexistent_
} 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} {
    proc t1 {x} {
        global _nonexistent_
        return [info exists _nonexistent_]
    }
    t1 2
} 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
test info-7.7 {info exists option} {
    catch {unset x}
    set x(2) 44
    list [info exists x] [info exists x(1)] [info exists x(2)]
} {1 0 1}
catch {unset x}
test info-7.8 {info exists option} {
    list [catch {info exists} msg] $msg
} {1 {wrong # args: should be "info exists varName"}}
test info-7.9 {info exists option} {
    list [catch {info exists 1 2} msg] $msg
} {1 {wrong # args: should be "info exists varName"}}

test info-8.1 {info globals option} {
    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]
} {1 1 1 0}
test info-8.2 {info globals option} {
    set _xxx1 1
    set _xxx2 2
    lsort [info g _xxx*]
} {_xxx1 _xxx2}
test info-8.3 {info globals option} {
    list [catch {info globals 1 2} msg] $msg
} {1 {wrong # args: should be "info globals [pattern]"}}

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} {
    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-10.1 {info library option} {
    list [catch {info library x} msg] $msg
} {1 {wrong # args: should be "info library"}}
# The following check can only be done at Berkeley, where the exact
# location of the library is known.

if $atBerkeley {
    test info-10.2 {info library option} {
	info li
    } /users/ouster/tcl/library
    test info-10.3 {info library option} {
	set env(TCL_LIBRARY) test_value
	set result [info library]
	unset env(TCL_LIBRARY)
	list $result [info library]
    } {test_value /users/ouster/tcl/library}
}

test info-11.1 {info locals option} {
    set a 22
    proc t1 {x y} {
        set b 13
        set c testing
        global a
        return [info locals]
    }
    lsort [t1 23 24]
} {b c x y}
test info-11.2 {info locals option} {
    proc t1 {x y} {
        set xx1 2
        set xx2 3
        set y 4
        return [info lo x*]
    }
    lsort [t1 2 3]
} {x xx1 xx2}
test info-11.3 {info locals option} {
    list [catch {info locals 1 2} msg] $msg
} {1 {wrong # args: should be "info locals [pattern]"}}
test info-11.4 {info locals option} {
    info locals
} {}
test info-11.5 {info locals option} {
    proc t1 {} {return [info locals]}
    t1
} {}

test info-12.1 {info patchlevel option} {
    set a [info patchlevel]
    incr a 2
    expr $a-[info patchlevel]
} 2
test info-12.2 {info patchlevel option} {
    list [catch {info patchlevel a} msg] $msg
} {1 {wrong # args: should be "info patchlevel"}}

test info-13.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-13.2 {info procs option} {
    proc _tt1 {} {}
    proc _tt2 {} {}
    lsort [info pr _tt*]
} {_tt1 _tt2}
catch {rename _tt1 {}}
catch {rename _tt2 {}}
test info-13.3 {info procs option} {
    list [catch {info procs 2 3} msg] $msg
} {1 {wrong # args: should be "info procs [pattern]"}}

test info-14.1 {info script option} {
    list [catch {info script x} msg] $msg
} {1 {wrong # args: should be "info script"}}
test info-14.2 {info script option} {
    file tail [info s]
} info.test
catch {exec rm -f gorp.info}
exec cat > gorp.info << "info script\n"
test info-14.3 {info script option} {
    list [source gorp.info] [file tail [info script]]
} {gorp.info info.test}
test info-14.4 {resetting "info script" after errors} {
    catch {source ~_nobody_/foo}
    file tail [info script]
} {info.test}
test info-14.5 {resetting "info script" after errors} {
    catch {source _nonexistent_}
    file tail [info script]
} {info.test}
exec rm -f gorp.info

test info-15.1 {info tclversion option} {
    set x [info tclversion]
    scan $x "%d.%d%c" a b c
} 2
test info-15.2 {info tclversion option} {
    list [catch {info t 2} msg] $msg
} {1 {wrong # args: should be "info tclversion"}}

test info-16.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-16.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-16.3 {info vars option} {
    lsort [info vars]
} [lsort [info globals]]
test info-16.4 {info vars option} {
    list [catch {info vars a b} msg] $msg
} {1 {wrong # args: should be "info vars [pattern]"}}

test info-17.1 {miscellaneous error conditions} {
    list [catch {info} msg] $msg
} {1 {wrong # args: should be "info option ?arg arg ...?"}}
test info-17.2 {miscellaneous error conditions} {
    list [catch {info gorp} msg] $msg
} {1 {bad option "gorp": should be args, body, cmdcount, commands, complete, default, exists, globals, level, library, locals, patchlevel, procs, script, tclversion, or vars}}
test info-17.3 {miscellaneous error conditions} {
    list [catch {info c} msg] $msg
} {1 {bad option "c": should be args, body, cmdcount, commands, complete, default, exists, globals, level, library, locals, patchlevel, procs, script, tclversion, or vars}}
test info-17.4 {miscellaneous error conditions} {
    list [catch {info l} msg] $msg
} {1 {bad option "l": should be args, body, cmdcount, commands, complete, default, exists, globals, level, library, locals, patchlevel, procs, script, tclversion, or vars}}