source: downloads/tcl8.5.2/tests/tm.test @ 68

# 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.
#
# RCS: @(#) $Id: tm.test,v 1.6 2005/08/29 21:55:27 andreas_kupries Exp $

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} -returnCodes error -body {
    ::tcl::tm::path add
} -result "wrong # args: should be \"::tcl::tm::path add path ...\""
test tm-1.4 {tm: path command syntax} -returnCodes error -body {
    ::tcl::tm::path remove
} -result "wrong # args: should be \"::tcl::tm::path remove path ...\""
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 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: