# 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} { ::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] foreach {major minor} [split [info tclversion] .] break set results {} set base8 [file join $base tcl8] lappend results [file join $base8 site-tcl] for {set i 0} {$i <= 7} {incr i} { lappend results [file join $base8 8.$i] } 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: