1# This file contains tests for the ::tcl::tm::* commands. 2# 3# Sourcing this file into Tcl runs the tests and generates output for 4# errors. No output means no errors were found. 5# 6# Copyright © 2004 Donal K. Fellows. 7# All rights reserved. 8 9if {"::tcltest" ni [namespace children]} { 10 package require tcltest 2.5 11 namespace import -force ::tcltest::* 12} 13 14test tm-1.1 {tm: path command exists} { 15 catch { ::tcl::tm::path } 16 info commands ::tcl::tm::path 17} ::tcl::tm::path 18test tm-1.2 {tm: path command syntax} -returnCodes error -body { 19 ::tcl::tm::path foo 20} -result {unknown or ambiguous subcommand "foo": must be add, list, or remove} 21test tm-1.3 {tm: path command syntax} { 22 ::tcl::tm::path add 23} {} 24test tm-1.4 {tm: path command syntax} { 25 ::tcl::tm::path remove 26} {} 27test tm-1.5 {tm: path command syntax} -returnCodes error -body { 28 ::tcl::tm::path list foobar 29} -result "wrong # args: should be \"::tcl::tm::path list\"" 30 31test tm-2.1 {tm: roots command exists} { 32 catch { ::tcl::tm::roots } 33 info commands ::tcl::tm::roots 34} ::tcl::tm::roots 35test tm-2.2 {tm: roots command syntax} -returnCodes error -body { 36 ::tcl::tm::roots 37} -result "wrong # args: should be \"::tcl::tm::roots paths\"" 38test tm-2.3 {tm: roots command syntax} -returnCodes error -body { 39 ::tcl::tm::roots foo bar 40} -result "wrong # args: should be \"::tcl::tm::roots paths\"" 41 42 43test tm-3.1 {tm: module path management, input validation} -setup { 44 # Save and clear the list 45 set defaults [::tcl::tm::path list] 46 foreach p $defaults {::tcl::tm::path remove $p} 47} -cleanup { 48 # Restore old contents of path list. 49 foreach p [::tcl::tm::path list] {::tcl::tm::path remove $p} 50 foreach p $defaults {::tcl::tm::path add $p} 51} -returnCodes error -body { 52 ::tcl::tm::path add foo/bar 53 ::tcl::tm::path add foo 54} -result {foo is ancestor of existing module path foo/bar.} 55 56test tm-3.2 {tm: module path management, input validation} -setup { 57 # Save and clear the list 58 set defaults [::tcl::tm::path list] 59 foreach p $defaults {::tcl::tm::path remove $p} 60} -cleanup { 61 # Restore old contents of path list. 62 foreach p [::tcl::tm::path list] {::tcl::tm::path remove $p} 63 foreach p $defaults {::tcl::tm::path add $p} 64} -returnCodes error -body { 65 ::tcl::tm::path add foo 66 ::tcl::tm::path add foo/bar 67} -result {foo/bar is subdirectory of existing module path foo.} 68 69test tm-3.3 {tm: module path management, add/list interaction} -setup { 70 # Save and clear the list 71 set defaults [::tcl::tm::path list] 72 foreach p $defaults {::tcl::tm::path remove $p} 73} -cleanup { 74 # Restore old contents of path list. 75 foreach p [::tcl::tm::path list] {::tcl::tm::path remove $p} 76 foreach p $defaults {::tcl::tm::path add $p} 77} -body { 78 ::tcl::tm::path add foo 79 ::tcl::tm::path add bar 80 ::tcl::tm::path list 81} -result {bar foo} 82 83test tm-3.4 {tm: module path management, add/list interaction} -setup { 84 # Save and clear the list 85 set defaults [::tcl::tm::path list] 86 foreach p $defaults {::tcl::tm::path remove $p} 87} -cleanup { 88 # Restore old contents of path list. 89 foreach p [::tcl::tm::path list] {::tcl::tm::path remove $p} 90 foreach p $defaults {::tcl::tm::path add $p} 91} -body { 92 ::tcl::tm::path add foo bar baz 93 ::tcl::tm::path list 94} -result {baz bar foo} 95 96test tm-3.5 {tm: module path management, input validation/list interaction} -setup { 97 # Save and clear the list 98 set defaults [::tcl::tm::path list] 99 foreach p $defaults {::tcl::tm::path remove $p} 100} -cleanup { 101 # Restore old contents of path list. 102 foreach p [::tcl::tm::path list] {::tcl::tm::path remove $p} 103 foreach p $defaults {::tcl::tm::path add $p} 104} -body { 105 catch {::tcl::tm::path add snarf foo geode foo/bar} 106 # Nothing is added if a problem was found. 107 ::tcl::tm::path list 108} -result {} 109 110test tm-3.6 {tm: module path management, input validation/list interaction} -setup { 111 # Save and clear the list 112 set defaults [::tcl::tm::path list] 113 foreach p $defaults {::tcl::tm::path remove $p} 114} -cleanup { 115 # Restore old contents of path list. 116 foreach p [::tcl::tm::path list] {::tcl::tm::path remove $p} 117 foreach p $defaults {::tcl::tm::path add $p} 118} -body { 119 catch {::tcl::tm::path add snarf foo/bar geode foo} 120 # Nothing is added if a problem was found. 121 ::tcl::tm::path list 122} -result {} 123 124test tm-3.7 {tm: module path management, input validation/list interaction} -setup { 125 # Save and clear the list 126 set defaults [::tcl::tm::path list] 127 foreach p $defaults {::tcl::tm::path remove $p} 128} -cleanup { 129 # Restore old contents of path list. 130 foreach p [::tcl::tm::path list] {::tcl::tm::path remove $p} 131 foreach p $defaults {::tcl::tm::path add $p} 132} -body { 133 catch { 134 ::tcl::tm::path add foo/bar 135 ::tcl::tm::path add snarf geode foo 136 } 137 # Nothing is added if a problem was found. 138 ::tcl::tm::path list 139} -result {foo/bar} 140 141test tm-3.8 {tm: module path management, input validation, ignore duplicates} -setup { 142 # Save and clear the list 143 set defaults [::tcl::tm::path list] 144 foreach p $defaults {::tcl::tm::path remove $p} 145} -cleanup { 146 # Restore old contents of path list. 147 foreach p [::tcl::tm::path list] {::tcl::tm::path remove $p} 148 foreach p $defaults {::tcl::tm::path add $p} 149} -body { 150 # Ignore path if present 151 ::tcl::tm::path add foo 152 ::tcl::tm::path add snarf geode foo 153 ::tcl::tm::path list 154} -result {geode snarf foo} 155 156test tm-3.9 {tm: module path management, input validation, ignore duplicates} -setup { 157 # Save and clear the list 158 set defaults [::tcl::tm::path list] 159 foreach p $defaults {::tcl::tm::path remove $p} 160} -cleanup { 161 # Restore old contents of path list. 162 foreach p [::tcl::tm::path list] {::tcl::tm::path remove $p} 163 foreach p $defaults {::tcl::tm::path add $p} 164} -body { 165 # Ignore path if present 166 ::tcl::tm::path add foo snarf geode foo 167 ::tcl::tm::path list 168} -result {geode snarf foo} 169 170test tm-3.10 {tm: module path management, remove} -setup { 171 # Save and clear the list 172 set defaults [::tcl::tm::path list] 173 foreach p $defaults {::tcl::tm::path remove $p} 174} -cleanup { 175 # Restore old contents of path list. 176 foreach p [::tcl::tm::path list] {::tcl::tm::path remove $p} 177 foreach p $defaults {::tcl::tm::path add $p} 178} -body { 179 ::tcl::tm::path add snarf geode foo 180 ::tcl::tm::path remove foo 181 ::tcl::tm::path list 182} -result {geode snarf} 183 184test tm-3.11 {tm: module path management, remove ignores unknown path} -setup { 185 # Save and clear the list 186 set defaults [::tcl::tm::path list] 187 foreach p $defaults {::tcl::tm::path remove $p} 188} -cleanup { 189 # Restore old contents of path list. 190 foreach p [::tcl::tm::path list] {::tcl::tm::path remove $p} 191 foreach p $defaults {::tcl::tm::path add $p} 192} -body { 193 ::tcl::tm::path add foo snarf geode 194 ::tcl::tm::path remove fox 195 ::tcl::tm::path list 196} -result {geode snarf foo} 197 198 199proc genpaths {base} { 200 # Normalizing picks up drive letters on windows [Bug 1053568] 201 set base [file normalize $base] 202 regexp {^(\d+)\.(\d+)} [package provide tcl] - major minor 203 set results {} 204 set base [file join $base tcl$major] 205 lappend results [file join $base site-tcl] 206 for {set i 0} {$i <= $minor} {incr i} { 207 lappend results [file join $base ${major}.$i] 208 } 209 return $results 210} 211 212test tm-3.12 {tm: module path management, roots} -setup { 213 # Save and clear the list 214 set defaults [::tcl::tm::path list] 215 foreach p $defaults {::tcl::tm::path remove $p} 216} -cleanup { 217 # Restore old contents of path list. 218 foreach p [::tcl::tm::path list] {::tcl::tm::path remove $p} 219 foreach p $defaults {::tcl::tm::path add $p} 220} -body { 221 ::tcl::tm::roots /FOO 222 ::tcl::tm::path list 223} -result [genpaths /FOO] 224 225test tm-3.13 {tm: module path management, roots} -setup { 226 # Save and clear the list 227 set defaults [::tcl::tm::path list] 228 foreach p $defaults {::tcl::tm::path remove $p} 229} -cleanup { 230 # Restore old contents of path list. 231 foreach p [::tcl::tm::path list] {::tcl::tm::path remove $p} 232 foreach p $defaults {::tcl::tm::path add $p} 233} -body { 234 ::tcl::tm::roots [list /FOO /BAR] 235 ::tcl::tm::path list 236} -result [concat [genpaths /BAR] [genpaths /FOO]] 237 238rename genpaths {} 239::tcltest::cleanupTests 240return 241 242# Local Variables: 243# mode: tcl 244# End: 245