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