pkg.test

linux系统下的音频通信

# Commands covered:  pkg
#
# 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) 1995-1996 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# SCCS: @(#) pkg.test 1.12 97/08/14 01:33:54

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

# Do all this in a slave interp to avoid garbaging the
# package list
set i [interp create]
interp eval $i [list set VERBOSE $VERBOSE]
interp eval $i [list set TESTS $TESTS]
interp eval $i {

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

eval package forget [package names]
set oldPkgUnknown [package unknown]
package unknown {}
set oldPath $auto_path
set auto_path ""

test pkg-1.1 {Tcl_PkgProvide procedure} {
    package forget t
    package provide t 2.3
} {}
test pkg-1.2 {Tcl_PkgProvide procedure} {
    package forget t
    package provide t 2.3
    list [catch {package provide t 2.2} msg] $msg
} {1 {conflicting versions provided for package "t": 2.3, then 2.2}}
test pkg-1.3 {Tcl_PkgProvide procedure} {
    package forget t
    package provide t 2.3
    list [catch {package provide t 2.4} msg] $msg
} {1 {conflicting versions provided for package "t": 2.3, then 2.4}}
test pkg-1.4 {Tcl_PkgProvide procedure} {
    package forget t
    package provide t 2.3
    list [catch {package provide t 3.3} msg] $msg
} {1 {conflicting versions provided for package "t": 2.3, then 3.3}}
test pkg-1.5 {Tcl_PkgProvide procedure} {
    package forget t
    package provide t 2.3
    package provide t 2.3
} {}

test pkg-2.1 {Tcl_PkgRequire procedure, picking best version} {
    package forget t
    foreach i {1.4 3.4 2.3 2.4 2.2} {
	package ifneeded t $i "set x $i; package provide t $i"
    }
    set x xxx
    package require t
    set x
} {3.4}
test pkg-2.2 {Tcl_PkgRequire procedure, picking best version} {
    package forget t
    foreach i {1.4 3.4 2.3 2.4 2.2 3.5 3.2} {
	package ifneeded t $i "set x $i; package provide t $i"
    }
    set x xxx
    package require t
    set x
} {3.5}
test pkg-2.3 {Tcl_PkgRequire procedure, picking best version} {
    package forget t
    foreach i {3.5 2.1 2.3} {
	package ifneeded t $i "set x $i; package provide t $i"
    }
    set x xxx
    package require t 2.2
    set x
} {2.3}
test pkg-2.4 {Tcl_PkgRequire procedure, picking best version} {
    package forget t
    foreach i {1.4 3.4 2.3 2.4 2.2} {
	package ifneeded t $i "set x $i; package provide t $i"
    }
    set x xxx
    package require -exact t 2.3
    set x
} {2.3}
test pkg-2.5 {Tcl_PkgRequire procedure, picking best version} {
    package forget t
    foreach i {1.4 3.4 2.3 2.4 2.2} {
	package ifneeded t $i "set x $i; package provide t $i"
    }
    set x xxx
    package require t 2.1
    set x
} {2.4}
test pkg-2.6 {Tcl_PkgRequire procedure, can't find suitable version} {
    package forget t
    package unknown {}
    foreach i {1.4 3.4 2.3 2.4 2.2} {
	package ifneeded t $i "set x $i"
    }
    list [catch {package require t 2.5} msg] $msg
} {1 {can't find package t 2.5}}
test pkg-2.7 {Tcl_PkgRequire procedure, can't find suitable version} {
    package forget t
    package unknown {}
    foreach i {1.4 3.4 2.3 2.4 2.2} {
	package ifneeded t $i "set x $i"
    }
    list [catch {package require t 4.1} msg] $msg
} {1 {can't find package t 4.1}}
test pkg-2.8 {Tcl_PkgRequire procedure, can't find suitable version} {
    package forget t
    package unknown {}
    foreach i {1.4 3.4 2.3 2.4 2.2} {
	package ifneeded t $i "set x $i"
    }
    list [catch {package require -exact t 1.3} msg] $msg
} {1 {can't find package t 1.3}}
test pkg-2.9 {Tcl_PkgRequire procedure, can't find suitable version} {
    package forget t
    package unknown {}
    list [catch {package require t} msg] $msg
} {1 {can't find package t}}
test pkg-2.10 {Tcl_PkgRequire procedure, error in ifneeded script} {
    package forget t
    package ifneeded t 2.1 {package provide t 2.1; error "ifneeded test"}
    list [catch {package require t 2.1} msg] $msg $errorInfo
} {1 {ifneeded test} {ifneeded test
    while executing
"error "ifneeded test""
    ("package ifneeded" script)
    invoked from within
"package require t 2.1"}}
test pkg-2.11 {Tcl_PkgRequire procedure, ifneeded script doesn't provide package} {
    package forget t
    package ifneeded t 2.1 "set x invoked"
    set x xxx
    list [catch {package require t 2.1} msg] $msg $x
} {1 {can't find package t 2.1} invoked}
test pkg-2.12 {Tcl_PkgRequire procedure, self-deleting script} {
    package forget t
    package ifneeded t 1.2 "package forget t; set x 1.2; package provide t 1.2"
    set x xxx
    package require t 1.2
    set x
} {1.2}
test pkg-2.13 {Tcl_PkgRequire procedure, "package unknown" support} {
    proc pkgUnknown args {
	global x
	set x $args
	package provide [lindex $args 0] [lindex $args 1]
    }
    package forget t
    foreach i {1.4 3.4 2.3 2.4 2.2} {
	package ifneeded t $i "set x $i"
    }
    package unknown pkgUnknown
    set x xxx
    package require -exact t 1.5
    package unknown {}
    set x
} {t 1.5 -exact}
test pkg-2.14 {Tcl_PkgRequire procedure, "package unknown" support} {
    proc pkgUnknown args {
	package ifneeded t 1.2 "set x loaded; package provide t 1.2"
    }
    package forget t
    package unknown pkgUnknown
    set x xxx
    set result [list [package require t] $x]
    package unknown {}
    set result
} {1.2 loaded}
test pkg-2.15 {Tcl_PkgRequire procedure, "package unknown" support} {
    proc pkgUnknown args {
	global x
	set x $args
	package provide [lindex $args 0] 2.0
    }
    package forget {a b}
    package unknown pkgUnknown
    set x xxx
    package require {a b}
    package unknown {}
    set x
} {{a b} {}}
test pkg-2.16 {Tcl_PkgRequire procedure, "package unknown" error} {
    proc pkgUnknown args {
	error "testing package unknown"
    }
    package forget t 
    package unknown pkgUnknown
    set result [list [catch {package require t} msg] $msg $errorInfo]
    package unknown {}
    set result
} {1 {testing package unknown} {testing package unknown
    while executing
"error "testing package unknown""
    (procedure "pkgUnknown" line 2)
    invoked from within
"pkgUnknown t {}"
    ("package unknown" script)
    invoked from within
"package require t"}}
test pkg-2.17 {Tcl_PkgRequire procedure, "package unknown" doesn't load package} {
    proc pkgUnknown args {
	global x
	set x $args
    }
    package forget t
    foreach i {1.4 3.4 2.3 2.4 2.2} {
	package ifneeded t $i "set x $i"
    }
    package unknown pkgUnknown
    set x xxx
    set result [list [catch {package require -exact t 1.5} msg] $msg $x]
    package unknown {}
    set result
} {1 {can't find package t 1.5} {t 1.5 -exact}}
test pkg-2.18 {Tcl_PkgRequire procedure, version checks} {
    package forget t
    package provide t 2.3
    package require t
} {2.3}
test pkg-2.19 {Tcl_PkgRequire procedure, version checks} {
    package forget t
    package provide t 2.3
    package require t 2.1
} {2.3}
test pkg-2.20 {Tcl_PkgRequire procedure, version checks} {
    package forget t
    package provide t 2.3
    package require t 2.3
} {2.3}
test pkg-2.21 {Tcl_PkgRequire procedure, version checks} {
    package forget t
    package provide t 2.3
    list [catch {package require t 2.4} msg] $msg
} {1 {version conflict for package "t": have 2.3, need 2.4}}
test pkg-2.22 {Tcl_PkgRequire procedure, version checks} {
    package forget t
    package provide t 2.3
    list [catch {package require t 1.2} msg] $msg
} {1 {version conflict for package "t": have 2.3, need 1.2}}
test pkg-2.23 {Tcl_PkgRequire procedure, version checks} {
    package forget t
    package provide t 2.3
    package require -exact t 2.3
} {2.3}
test pkg-2.24 {Tcl_PkgRequire procedure, version checks} {
    package forget t
    package provide t 2.3
    list [catch {package require -exact t 2.2} msg] $msg
} {1 {version conflict for package "t": have 2.3, need 2.2}}

test pkg-3.1 {Tcl_PackageCmd procedure} {
    list [catch {package} msg] $msg
} {1 {wrong # args: should be "package option ?arg arg ...?"}}
test pkg-3.2 {Tcl_PackageCmd procedure, "forget" option} {
    foreach i [package names] {
	package forget $i
    }
    package names
} {}
test pkg-3.3 {Tcl_PackageCmd procedure, "forget" option} {
    foreach i [package names] {
	package forget $i
    }
    package forget foo
} {}
test pkg-3.4 {Tcl_PackageCmd procedure, "forget" option} {
    foreach i [package names] {
	package forget $i
    }
    package ifneeded t 1.1 {first script}
    package ifneeded t 2.3 {second script}