Index: library/tm.tcl
===================================================================
RCS file: /cvsroot/tcl/tcl/library/tm.tcl,v
retrieving revision 1.2
diff -u -r1.2 tm.tcl
--- library/tm.tcl	25 Oct 2004 15:37:16 -0000	1.2
+++ library/tm.tcl	27 Oct 2004 16:42:24 -0000
@@ -98,45 +98,56 @@
 
     variable paths
 
-    set newpaths {}
+    # We use a copy of the path as source during validation, and
+    # extend it as well. Because we not only have to detect if the new
+    # paths are bogus with respect to the existing paths, but also
+    # between themselves. Otherwise we can still add bogus paths, by
+    # specifying them in a single call. This makes the use of the new
+    # paths simpler as well, a trivial assignment of the collected
+    # paths to the official state var.
+
+    set newpaths $paths
     foreach p $args {
-	set pos [lsearch -exact $paths $p]
-	if {$pos >= 0} {
+	if {$p in $newpaths} {
 	    # Ignore a path already on the list.
 	    continue
 	}
 
 	# Search for paths which are subdirectories of the new one. If
-	# there are any then new path violates the restriction about
-	# ancestors.
+	# there are any then the new path violates the restriction
+	# about ancestors.
 
-	set pos [lsearch -glob $paths ${p}/*]
+	set pos [lsearch -glob $newpaths ${p}/*]
+	# Cannot use "in", we need the position for the message.
 	if {$pos >= 0} {
 	    return -code error \
-		"$p is ancestor of existing module path [lindex $paths $pos]."
+		"$p is ancestor of existing module path [lindex $newpaths $pos]."
 	}
 
-	# Now look for paths which are ancestors of the new one. This
-	# reverse question req us to loop over the existing paths :(
+	# Now look for existing paths which are ancestors of the new
+	# one. This reverse question forces us to loop over the
+	# existing paths, as each element is the pattern, not the new
+	# path :(
 
-	foreach ep $paths {
+	foreach ep $newpaths {
 	    if {[string match ${ep}/* $p]} {
 		return -code error \
 		    "$p is subdirectory of existing module path $ep."
 	    }
 	}
 
-	lappend newpaths $p
+	set newpaths [linsert $newpaths 0 $p]
     }
 
     # The validation of the input is complete and successful, and
-    # everything in newpaths is actually new. We can now extend the
-    # list of paths.
+    # everything in newpaths is either an old path, or added. We can
+    # now extend the official list of paths, a simple assignment is
+    # sufficient.
 
-    foreach p $newpaths {
-	set paths [linsert $paths 0 $p]
-    }
+    set paths $newpaths
+    return
 }
+
 proc ::tcl::tm::remove {args} {
     # PART OF THE ::tcl::tm::path ENSEMBLE
     #
@@ -157,6 +168,7 @@
 	}
     }
 }
+
 proc ::tcl::tm::list {args} {
     # PART OF THE ::tcl::tm::path ENSEMBLE
 
@@ -164,8 +176,7 @@
 	return -code error "wrong # args: should be \"::tcl::tm::path list\""
     }
     variable paths
-
-    return $paths
+    return  $paths
 }
 
 # ::tcl::tm::UnknownHandler --
Index: tests/tm.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/tm.test,v
retrieving revision 1.2
diff -u -r1.2 tm.test
--- tests/tm.test	25 Oct 2004 15:37:16 -0000	1.2
+++ tests/tm.test	27 Oct 2004 16:42:30 -0000
@@ -42,10 +42,199 @@
     ::tcl::tm::roots foo bar
 } -result "wrong # args: should be \"::tcl::tm::roots paths\""
 
-test tm-3.1 {tm: module path management} {
-    # Andreas Kupries needs to write some tests here...
-    error FIXME
-} {}
+
+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} {
+    foreach {major minor} [split [info tclversion] .] break
+    set results {}
+    lappend results [file join $base site-tcl]
+    set base [file join $base tcl$major]
+    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]]
 
 ::tcltest::cleanupTests
 return
