summaryrefslogtreecommitdiffstats
path: root/tests/tm.test
diff options
context:
space:
mode:
Diffstat (limited to 'tests/tm.test')
-rw-r--r--tests/tm.test245
1 files changed, 245 insertions, 0 deletions
diff --git a/tests/tm.test b/tests/tm.test
new file mode 100644
index 0000000..f6c9a68
--- /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]
+ foreach {major minor} [split [info tclversion] .] break
+ 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: