246 lines
8.2 KiB
Plaintext
246 lines
8.2 KiB
Plaintext
|
# 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.5
|
||
|
|
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} {
|
||
|
|
::tcl::tm::path add
|
||
|
|
} {}
|
||
|
|
test tm-1.4 {tm: path command syntax} {
|
||
|
|
::tcl::tm::path remove
|
||
|
|
} {}
|
||
|
|
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]
|
||
|
|
regexp {^(\d+)\.(\d+)} [package provide 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:
|