# This file tests the tclWinFile.c file. # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1997 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id: winFile.test,v 1.1.1.1 2007/07/10 15:04:24 duncan Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest namespace import -force ::tcltest::* } test winFile-1.1 {TclpGetUserHome} {pcOnly} { list [catch {glob ~nosuchuser} msg] $msg } {1 {user "nosuchuser" doesn't exist}} test winFile-1.2 {TclpGetUserHome} {pcOnly nt nonPortable} { # The administrator account should always exist. catch {glob ~administrator} } {0} test winFile-1.3 {TclpGetUserHome} {pcOnly 95} { # Find some user in system.ini and then see if they have a home. set f [open $::env(windir)/system.ini] set x 0 while {![eof $f]} { set line [gets $f] if {$line == "\[Password Lists]"} { gets $f set name [lindex [split [gets $f] =] 0] if {$name != ""} { set x [catch {glob ~$name}] break } } } close $f set x } {0} test winFile-1.4 {TclpGetUserHome} {pcOnly nt nonPortable} { catch {glob ~stanton@workgroup} } {0} test winFile-2.1 {TclpMatchFiles: case sensitivity} {pcOnly} { makeFile {} GlobCapS set result [list [glob -nocomplain GlobC*] [glob -nocomplain globc*]] removeFile GlobCapS set result } {GlobCapS GlobCapS} test winFile-2.2 {TclpMatchFiles: case sensitivity} {pcOnly} { makeFile {} globlower set result [list [glob -nocomplain globl*] [glob -nocomplain gLOBl*]] removeFile globlower set result } {globlower globlower} test winFile-3.1 {file system} {pcOnly} { set res "volume types ok" foreach vol [file volumes] { # Have to catch in case there is a removable drive (CDROM, floppy) # with nothing in it. catch { if {![string equal [lindex [file system $vol] 1] [testvolumetype $vol]]} { set res "For $vol, we found [file system $vol]\ and [testvolumetype $vol] are different" break } } } set res } {volume types ok} # cleanup ::tcltest::cleanupTests return