pkg.test

来自「tcl是工具命令语言」· TEST 代码 · 共 666 行 · 第 1/2 页

    package ifneeded t 1.4 "script for t 1.4"
    list [package ifneeded t 1.5] [package names] [package versions t]
} {{} t 1.4}
test pkg-3.12 {Tcl_PackageCmd procedure, "ifneeded" option} {
    package forget t
    package ifneeded t 1.4 "script for t 1.4"
    package ifneeded t 1.4 "second script for t 1.4"
    list [package ifneeded t 1.4] [package names] [package versions t]
} {{second script for t 1.4} t 1.4}
test pkg-3.13 {Tcl_PackageCmd procedure, "ifneeded" option} {
    package forget t
    package ifneeded t 1.4 "script for t 1.4"
    package ifneeded t 1.2 "second script"
    package ifneeded t 3.1 "last script"
    list [package ifneeded t 1.2] [package versions t]
} {{second script} {1.4 1.2 3.1}}
test pkg-3.14 {Tcl_PackageCmd procedure, "names" option} {
    list [catch {package names a} msg] $msg
} {1 {wrong # args: should be "package names"}}
test pkg-3.15 {Tcl_PackageCmd procedure, "names" option} {
    foreach i [package names] {
	package forget $i
    }
    package names
} {}
test pkg-3.16 {Tcl_PackageCmd procedure, "names" option} {
    foreach i [package names] {
	package forget $i
    }
    package ifneeded x 1.2 {dummy}
    package provide x 1.3
    package provide y 2.4
    catch {package require z 47.16}
    lsort [package names]
} {x y}
test pkg-3.17 {Tcl_PackageCmd procedure, "provide" option} {
    list [catch {package provide} msg] $msg
} {1 {wrong # args: should be "package provide package ?version?"}}
test pkg-3.18 {Tcl_PackageCmd procedure, "provide" option} {
    list [catch {package provide a b c} msg] $msg
} {1 {wrong # args: should be "package provide package ?version?"}}
test pkg-3.19 {Tcl_PackageCmd procedure, "provide" option} {
    package forget t
    package provide t
} {}
test pkg-3.20 {Tcl_PackageCmd procedure, "provide" option} {
    package forget t
    package provide t 2.3
    package provide t
} {2.3}
test pkg-3.21 {Tcl_PackageCmd procedure, "provide" option} {
    package forget t
    list [catch {package provide t a.b} msg] $msg
} {1 {expected version number but got "a.b"}}
test pkg-3.22 {Tcl_PackageCmd procedure, "require" option} {
    list [catch {package require} msg] $msg
} {1 {wrong # args: should be "package require ?-exact? package ?version?"}}
test pkg-3.23 {Tcl_PackageCmd procedure, "require" option} {
    list [catch {package require a b c} msg] $msg
} {1 {wrong # args: should be "package require ?-exact? package ?version?"}}
test pkg-3.24 {Tcl_PackageCmd procedure, "require" option} {
    list [catch {package require -exact a b c} msg] $msg
} {1 {wrong # args: should be "package require ?-exact? package ?version?"}}
test pkg-3.25 {Tcl_PackageCmd procedure, "require" option} {
    list [catch {package require -bs a b} msg] $msg
} {1 {wrong # args: should be "package require ?-exact? package ?version?"}}
test pkg-3.26 {Tcl_PackageCmd procedure, "require" option} {
    list [catch {package require x a.b} msg] $msg
} {1 {expected version number but got "a.b"}}
test pkg-3.27 {Tcl_PackageCmd procedure, "require" option} {
    list [catch {package require -exact x a.b} msg] $msg
} {1 {expected version number but got "a.b"}}
test pkg-3.28 {Tcl_PackageCmd procedure, "require" option} {
    list [catch {package require -exact x} msg] $msg
} {1 {wrong # args: should be "package require ?-exact? package ?version?"}}
test pkg-3.29 {Tcl_PackageCmd procedure, "require" option} {
    list [catch {package require -exact} msg] $msg
} {1 {wrong # args: should be "package require ?-exact? package ?version?"}}
test pkg-3.30 {Tcl_PackageCmd procedure, "require" option} {
    package forget t
    package provide t 2.3
    package require t 2.1
} {2.3}
test pkg-3.31 {Tcl_PackageCmd procedure, "require" option} {
    package forget t
    list [catch {package require t} msg] $msg
} {1 {can't find package t}}
test pkg-3.32 {Tcl_PackageCmd procedure, "require" option} {
    package forget t
    package ifneeded t 2.3 "error {synthetic error}"
    list [catch {package require t 2.3} msg] $msg
} {1 {synthetic error}}
test pkg-3.33 {Tcl_PackageCmd procedure, "unknown" option} {
    list [catch {package unknown a b} msg] $msg
} {1 {wrong # args: should be "package unknown ?command?"}}
test pkg-3.34 {Tcl_PackageCmd procedure, "unknown" option} {
    package unknown "test script"
    package unknown
} {test script}
test pkg-3.35 {Tcl_PackageCmd procedure, "unknown" option} {
    package unknown "test script"
    package unknown {}
    package unknown
} {}
test pkg-3.36 {Tcl_PackageCmd procedure, "vcompare" option} {
    list [catch {package vcompare a} msg] $msg
} {1 {wrong # args: should be "package vcompare version1 version2"}}
test pkg-3.37 {Tcl_PackageCmd procedure, "vcompare" option} {
    list [catch {package vcompare a b c} msg] $msg
} {1 {wrong # args: should be "package vcompare version1 version2"}}
test pkg-3.38 {Tcl_PackageCmd procedure, "vcompare" option} {
    list [catch {package vcompare x.y 3.4} msg] $msg
} {1 {expected version number but got "x.y"}}
test pkg-3.39 {Tcl_PackageCmd procedure, "vcompare" option} {
    list [catch {package vcompare 2.1 a.b} msg] $msg
} {1 {expected version number but got "a.b"}}
test pkg-3.40 {Tcl_PackageCmd procedure, "vcompare" option} {
    package vc 2.1 2.3
} {-1}
test pkg-3.41 {Tcl_PackageCmd procedure, "vcompare" option} {
    package vc 2.2.4 2.2.4
} {0}
test pkg-3.42 {Tcl_PackageCmd procedure, "versions" option} {
    list [catch {package versions} msg] $msg
} {1 {wrong # args: should be "package versions package"}}
test pkg-3.43 {Tcl_PackageCmd procedure, "versions" option} {
    list [catch {package versions a b} msg] $msg
} {1 {wrong # args: should be "package versions package"}}
test pkg-3.44 {Tcl_PackageCmd procedure, "versions" option} {
    package forget t
    package versions t
} {}
test pkg-3.45 {Tcl_PackageCmd procedure, "versions" option} {
    package forget t
    package provide t 2.3
    package versions t
} {}
test pkg-3.46 {Tcl_PackageCmd procedure, "versions" option} {
    package forget t
    package ifneeded t 2.3 x
    package ifneeded t 2.4 y
    package versions t
} {2.3 2.4}
test pkg-3.47 {Tcl_PackageCmd procedure, "vsatisfies" option} {
    list [catch {package vsatisfies a} msg] $msg
} {1 {wrong # args: should be "package vsatisfies version1 version2"}}
test pkg-3.48 {Tcl_PackageCmd procedure, "vsatisfies" option} {
    list [catch {package vsatisfies a b c} msg] $msg
} {1 {wrong # args: should be "package vsatisfies version1 version2"}}
test pkg-3.49 {Tcl_PackageCmd procedure, "vsatisfies" option} {
    list [catch {package vsatisfies x.y 3.4} msg] $msg
} {1 {expected version number but got "x.y"}}
test pkg-3.50 {Tcl_PackageCmd procedure, "vsatisfies" option} {
    list [catch {package vcompare 2.1 a.b} msg] $msg
} {1 {expected version number but got "a.b"}}
test pkg-3.51 {Tcl_PackageCmd procedure, "vsatisfies" option} {
    package vs 2.3 2.1
} {1}
test pkg-3.52 {Tcl_PackageCmd procedure, "vsatisfies" option} {
    package vs 2.3 1.2
} {0}
test pkg-3.53 {Tcl_PackageCmd procedure, "versions" option} {
    list [catch {package foo} msg] $msg
} {1 {bad option "foo": must be forget, ifneeded, names, present, provide, require, unknown, vcompare, versions, or vsatisfies}}

# No tests for FindPackage;  can't think up anything detectable
# errors.

test pkg-4.1 {TclFreePackageInfo procedure} {
    interp create foo
    foo eval {
	package ifneeded t 2.3 x
	package ifneeded t 2.4 y
	package ifneeded x 3.1 z
	package provide q 4.3
	package unknown "will this get freed?"
    }
    interp delete foo
} {}
test pkg-4.2 {TclFreePackageInfo procedure} {
    interp create foo
    foo eval {
	package ifneeded t 2.3 x
	package ifneeded t 2.4 y
	package ifneeded x 3.1 z
	package provide q 4.3
    }
    foo alias z kill
    proc kill {} {
	interp delete foo
    }
    list [catch {foo eval package require x 3.1} msg] $msg
} {1 {can't find package x 3.1}}

test pkg-5.1 {CheckVersion procedure} {
    list [catch {package vcompare 1 2.1} msg] $msg
} {0 -1}
test pkg-5.2 {CheckVersion procedure} {
    list [catch {package vcompare .1 2.1} msg] $msg
} {1 {expected version number but got ".1"}}
test pkg-5.3 {CheckVersion procedure} {
    list [catch {package vcompare 111.2a.3 2.1} msg] $msg
} {1 {expected version number but got "111.2a.3"}}
test pkg-5.4 {CheckVersion procedure} {
    list [catch {package vcompare 1.2.3. 2.1} msg] $msg
} {1 {expected version number but got "1.2.3."}}
test pkg-5.5 {CheckVersion procedure} {
    list [catch {package vcompare 1.2..3 2.1} msg] $msg
} {1 {expected version number but got "1.2..3"}}

test pkg-6.1 {ComparePkgVersions procedure} {
    package vcompare 1.23 1.22
} {1}
test pkg-6.2 {ComparePkgVersions procedure} {
    package vcompare 1.22.1.2.3 1.22.1.2.3
} {0}
test pkg-6.3 {ComparePkgVersions procedure} {
    package vcompare 1.21 1.22
} {-1}
test pkg-6.4 {ComparePkgVersions procedure} {
    package vcompare 1.21 1.21.2
} {-1}
test pkg-6.5 {ComparePkgVersions procedure} {
    package vcompare 1.21.1 1.21
} {1}
test pkg-6.6 {ComparePkgVersions procedure} {
    package vsatisfies 1.21.1 1.21
} {1}
test pkg-6.7 {ComparePkgVersions procedure} {
    package vsatisfies 2.22.3 1.21
} {0}
test pkg-6.8 {ComparePkgVersions procedure} {
    package vsatisfies 1 1
} {1}
test pkg-6.9 {ComparePkgVersions procedure} {
    package vsatisfies 2 1
} {0}

test pkg-7.1 {Tcl_PkgPresent procedure, any version} {
    package forget t
    package provide t 2.4
    package present t
} {2.4}
test pkg-7.2 {Tcl_PkgPresent procedure, correct version} {
    package forget t
    package provide t 2.4
    package present t 2.4
} {2.4}
test pkg-7.3 {Tcl_PkgPresent procedure, satisfying version} {
    package forget t
    package provide t 2.4
    package present t 2.0
} {2.4}
test pkg-7.4 {Tcl_PkgPresent procedure, not satisfying version} {
    package forget t
    package provide t 2.4
    list [catch {package present t 2.6} msg] $msg
} {1 {version conflict for package "t": have 2.4, need 2.6}}
test pkg-7.5 {Tcl_PkgPresent procedure, not satisfying version} {
    package forget t
    package provide t 2.4
    list [catch {package present t 1.0} msg] $msg
} {1 {version conflict for package "t": have 2.4, need 1.0}}
test pkg-7.6 {Tcl_PkgPresent procedure, exact version} {
    package forget t
    package provide t 2.4
    package present -exact t 2.4
} {2.4}
test pkg-7.7 {Tcl_PkgPresent procedure, not exact version} {
    package forget t
    package provide t 2.4
    list [catch {package present -exact t 2.3} msg] $msg
} {1 {version conflict for package "t": have 2.4, need 2.3}}
test pkg-7.8 {Tcl_PkgPresent procedure, unknown package} {
    package forget t
    list [catch {package present t} msg] $msg
} {1 {package t is not present}}
test pkg-7.9 {Tcl_PkgPresent procedure, unknown package} {
    package forget t
    list [catch {package present t 2.4} msg] $msg
} {1 {package t 2.4 is not present}}
test pkg-7.10 {Tcl_PkgPresent procedure, unknown package} {
    package forget t
    list [catch {package present -exact t 2.4} msg] $msg
} {1 {package t 2.4 is not present}}
test pkg-7.11 {Tcl_PackageCmd procedure, "present" option} {
    list [catch {package present} msg] $msg
} {1 {wrong # args: should be "package present ?-exact? package ?version?"}}
test pkg-7.12 {Tcl_PackageCmd procedure, "present" option} {
    list [catch {package present a b c} msg] $msg
} {1 {wrong # args: should be "package present ?-exact? package ?version?"}}
test pkg-7.13 {Tcl_PackageCmd procedure, "present" option} {
    list [catch {package present -exact a b c} msg] $msg
} {1 {wrong # args: should be "package present ?-exact? package ?version?"}}
test pkg-7.14 {Tcl_PackageCmd procedure, "present" option} {
    list [catch {package present -bs a b} msg] $msg
} {1 {wrong # args: should be "package present ?-exact? package ?version?"}}
test pkg-7.15 {Tcl_PackageCmd procedure, "present" option} {
    list [catch {package present x a.b} msg] $msg
} {1 {expected version number but got "a.b"}}
test pkg-7.16 {Tcl_PackageCmd procedure, "present" option} {
    list [catch {package present -exact x a.b} msg] $msg
} {1 {expected version number but got "a.b"}}
test pkg-7.17 {Tcl_PackageCmd procedure, "present" option} {
    list [catch {package present -exact x} msg] $msg
} {1 {wrong # args: should be "package present ?-exact? package ?version?"}}
test pkg-7.18 {Tcl_PackageCmd procedure, "present" option} {
    list [catch {package present -exact} msg] $msg
} {1 {wrong # args: should be "package present ?-exact? package ?version?"}}

set auto_path $oldPath
package unknown $oldPkgUnknown
concat

}

# cleanup
interp delete $i
::tcltest::cleanupTests
return