diff options
Diffstat (limited to 'tests/tm.test')
| -rw-r--r-- | tests/tm.test | 245 |
1 files changed, 245 insertions, 0 deletions
diff --git a/tests/tm.test b/tests/tm.test new file mode 100644 index 0000000..3f93483 --- /dev/null +++ b/tests/tm.test @@ -0,0 +1,245 @@ +# This file contains tests for the ::tcl::tm::* commands. +# +# Sourcing this file into Tcl runs the tests and generates output for +# errors. No output means no errors were found. +# +# Copyright (c) 2004 by Donal K. Fellows. +# All rights reserved. + +package require Tcl 8.5 +if {"::tcltest" ni [namespace children]} { + package require tcltest 2 + namespace import -force ::tcltest::* +} + +test tm-1.1 {tm: path command exists} { + catch { ::tcl::tm::path } + info commands ::tcl::tm::path +} ::tcl::tm::path +test tm-1.2 {tm: path command syntax} -returnCodes error -body { + ::tcl::tm::path foo +} -result {unknown or ambiguous subcommand "foo": must be add, list, or remove} +test tm-1.3 {tm: path command syntax} -returnCodes error -body { + ::tcl::tm::path add +} -result "wrong # args: should be \"::tcl::tm::path add path ...\"" +test tm-1.4 {tm: path command syntax} -returnCodes error -body { + ::tcl::tm::path remove +} -result "wrong # args: should be \"::tcl::tm::path remove path ...\"" +test tm-1.5 {tm: path command syntax} -returnCodes error -body { + ::tcl::tm::path list foobar +} -result "wrong # args: should be \"::tcl::tm::path list\"" + +test tm-2.1 {tm: roots command exists} { + catch { ::tcl::tm::roots } + info commands ::tcl::tm::roots +} ::tcl::tm::roots +test tm-2.2 {tm: roots command syntax} -returnCodes error -body { + ::tcl::tm::roots +} -result "wrong # args: should be \"::tcl::tm::roots paths\"" +test tm-2.3 {tm: roots command syntax} -returnCodes error -body { + ::tcl::tm::roots foo bar +} -result "wrong # args: should be \"::tcl::tm::roots paths\"" + + +test tm-3.1 {tm: module path management, input validation} -setup { + # Save and clear the list + set defaults [::tcl::tm::path list] + foreach p $defaults {::tcl::tm::path remove $p} +} -cleanup { + # Restore old contents of path list. + foreach p [::tcl::tm::path list] {::tcl::tm::path remove $p} + foreach p $defaults {::tcl::tm::path add $p} +} -returnCodes error -body { + ::tcl::tm::path add foo/bar + ::tcl::tm::path add foo +} -result {foo is ancestor of existing module path foo/bar.} + +test tm-3.2 {tm: module path management, input validation} -setup { + # Save and clear the list + set defaults [::tcl::tm::path list] + foreach p $defaults {::tcl::tm::path remove $p} +} -cleanup { + # Restore old contents of path list. + foreach p [::tcl::tm::path list] {::tcl::tm::path remove $p} + foreach p $defaults {::tcl::tm::path add $p} +} -returnCodes error -body { + ::tcl::tm::path add foo + ::tcl::tm::path add foo/bar +} -result {foo/bar is subdirectory of existing module path foo.} + +test tm-3.3 {tm: module path management, add/list interaction} -setup { + # Save and clear the list + set defaults [::tcl::tm::path list] + foreach p $defaults {::tcl::tm::path remove $p} +} -cleanup { + # Restore old contents of path list. + foreach p [::tcl::tm::path list] {::tcl::tm::path remove $p} + foreach p $defaults {::tcl::tm::path add $p} +} -body { + ::tcl::tm::path add foo + ::tcl::tm::path add bar + ::tcl::tm::path list +} -result {bar foo} + +test tm-3.4 {tm: module path management, add/list interaction} -setup { + # Save and clear the list + set defaults [::tcl::tm::path list] + foreach p $defaults {::tcl::tm::path remove $p} +} -cleanup { + # Restore old contents of path list. + foreach p [::tcl::tm::path list] {::tcl::tm::path remove $p} + foreach p $defaults {::tcl::tm::path add $p} +} -body { + ::tcl::tm::path add foo bar baz + ::tcl::tm::path list +} -result {baz bar foo} + +test tm-3.5 {tm: module path management, input validation/list interaction} -setup { + # Save and clear the list + set defaults [::tcl::tm::path list] + foreach p $defaults {::tcl::tm::path remove $p} +} -cleanup { + # Restore old contents of path list. + foreach p [::tcl::tm::path list] {::tcl::tm::path remove $p} + foreach p $defaults {::tcl::tm::path add $p} +} -body { + catch {::tcl::tm::path add snarf foo geode foo/bar} + # Nothing is added if a problem was found. + ::tcl::tm::path list +} -result {} + +test tm-3.6 {tm: module path management, input validation/list interaction} -setup { + # Save and clear the list + set defaults [::tcl::tm::path list] + foreach p $defaults {::tcl::tm::path remove $p} +} -cleanup { + # Restore old contents of path list. + foreach p [::tcl::tm::path list] {::tcl::tm::path remove $p} + foreach p $defaults {::tcl::tm::path add $p} +} -body { + catch {::tcl::tm::path add snarf foo/bar geode foo} + # Nothing is added if a problem was found. + ::tcl::tm::path list +} -result {} + +test tm-3.7 {tm: module path management, input validation/list interaction} -setup { + # Save and clear the list + set defaults [::tcl::tm::path list] + foreach p $defaults {::tcl::tm::path remove $p} +} -cleanup { + # Restore old contents of path list. + foreach p [::tcl::tm::path list] {::tcl::tm::path remove $p} + foreach p $defaults {::tcl::tm::path add $p} +} -body { + catch { + ::tcl::tm::path add foo/bar + ::tcl::tm::path add snarf geode foo + } + # Nothing is added if a problem was found. + ::tcl::tm::path list +} -result {foo/bar} + +test tm-3.8 {tm: module path management, input validation, ignore duplicates} -setup { + # Save and clear the list + set defaults [::tcl::tm::path list] + foreach p $defaults {::tcl::tm::path remove $p} +} -cleanup { + # Restore old contents of path list. + foreach p [::tcl::tm::path list] {::tcl::tm::path remove $p} + foreach p $defaults {::tcl::tm::path add $p} +} -body { + # Ignore path if present + ::tcl::tm::path add foo + ::tcl::tm::path add snarf geode foo + ::tcl::tm::path list +} -result {geode snarf foo} + +test tm-3.9 {tm: module path management, input validation, ignore duplicates} -setup { + # Save and clear the list + set defaults [::tcl::tm::path list] + foreach p $defaults {::tcl::tm::path remove $p} +} -cleanup { + # Restore old contents of path list. + foreach p [::tcl::tm::path list] {::tcl::tm::path remove $p} + foreach p $defaults {::tcl::tm::path add $p} +} -body { + # Ignore path if present + ::tcl::tm::path add foo snarf geode foo + ::tcl::tm::path list +} -result {geode snarf foo} + +test tm-3.10 {tm: module path management, remove} -setup { + # Save and clear the list + set defaults [::tcl::tm::path list] + foreach p $defaults {::tcl::tm::path remove $p} +} -cleanup { + # Restore old contents of path list. + foreach p [::tcl::tm::path list] {::tcl::tm::path remove $p} + foreach p $defaults {::tcl::tm::path add $p} +} -body { + ::tcl::tm::path add snarf geode foo + ::tcl::tm::path remove foo + ::tcl::tm::path list +} -result {geode snarf} + +test tm-3.11 {tm: module path management, remove ignores unknown path} -setup { + # Save and clear the list + set defaults [::tcl::tm::path list] + foreach p $defaults {::tcl::tm::path remove $p} +} -cleanup { + # Restore old contents of path list. + foreach p [::tcl::tm::path list] {::tcl::tm::path remove $p} + foreach p $defaults {::tcl::tm::path add $p} +} -body { + ::tcl::tm::path add foo snarf geode + ::tcl::tm::path remove fox + ::tcl::tm::path list +} -result {geode snarf foo} + + +proc genpaths {base} { + # Normalizing picks up drive letters on windows [Bug 1053568] + set base [file normalize $base] + lassign [split [package present Tcl] .] major minor + set results {} + set base [file join $base tcl$major] + lappend results [file join $base site-tcl] + for {set i 0} {$i <= $minor} {incr i} { + lappend results [file join $base ${major}.$i] + } + return $results +} + +test tm-3.12 {tm: module path management, roots} -setup { + # Save and clear the list + set defaults [::tcl::tm::path list] + foreach p $defaults {::tcl::tm::path remove $p} +} -cleanup { + # Restore old contents of path list. + foreach p [::tcl::tm::path list] {::tcl::tm::path remove $p} + foreach p $defaults {::tcl::tm::path add $p} +} -body { + ::tcl::tm::roots /FOO + ::tcl::tm::path list +} -result [genpaths /FOO] + +test tm-3.13 {tm: module path management, roots} -setup { + # Save and clear the list + set defaults [::tcl::tm::path list] + foreach p $defaults {::tcl::tm::path remove $p} +} -cleanup { + # Restore old contents of path list. + foreach p [::tcl::tm::path list] {::tcl::tm::path remove $p} + foreach p $defaults {::tcl::tm::path add $p} +} -body { + ::tcl::tm::roots [list /FOO /BAR] + ::tcl::tm::path list +} -result [concat [genpaths /BAR] [genpaths /FOO]] + +rename genpaths {} +::tcltest::cleanupTests +return + +# Local Variables: +# mode: tcl +# End: |