diff options
Diffstat (limited to 'tests/winFile.test')
| -rw-r--r-- | tests/winFile.test | 91 |
1 files changed, 45 insertions, 46 deletions
diff --git a/tests/winFile.test b/tests/winFile.test index bfba9cf..fba9bcb 100644 --- a/tests/winFile.test +++ b/tests/winFile.test @@ -16,6 +16,9 @@ if {[catch {package require tcltest 2.0.2}]} { } namespace import -force ::tcltest::* +::tcltest::loadTestedCommands +catch [list package require -exact Tcltest [info patchlevel]] + testConstraint testvolumetype [llength [info commands testvolumetype]] testConstraint notNTFS 0 testConstraint win2000 0 @@ -27,65 +30,63 @@ if {[testConstraint nt] && $::tcl_platform(osVersion) >= 5.0} { testConstraint win2000 1 } -test winFile-1.1 {TclpGetUserHome} {win} { - list [catch {glob ~nosuchuser} msg] $msg -} {1 {user "nosuchuser" doesn't exist}} -test winFile-1.2 {TclpGetUserHome} {win nt nonPortable} { +test winFile-1.1 {TclpGetUserHome} -constraints {win} -body { + glob ~nosuchuser +} -returnCodes error -result {user "nosuchuser" doesn't exist} +test winFile-1.2 {TclpGetUserHome} -constraints {win nt nonPortable} -body { # The administrator account should always exist. - - catch {glob ~administrator} -} {0} -test winFile-1.3 {TclpGetUserHome} {win 95} { + glob ~administrator +} -match glob -result * +test winFile-1.3 {TclpGetUserHome} -constraints {win 95} -body { # 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 - } + while {[gets $f line] >= 0} { + if {$line ne {[Password Lists]}} { + continue + } + gets $f + set name [lindex [split [gets $f] =] 0] + if {$name ne ""} { + return [catch {glob ~$name}] } } - close $f - set x -} {0} + return 0 ;# didn't find anything... +} -cleanup { + catch {close $f} +} -result {0} test winFile-1.4 {TclpGetUserHome} {win nt nonPortable} { catch {glob ~stanton@workgroup} } {0} -test winFile-2.1 {TclpMatchFiles: case sensitivity} {win} { +test winFile-2.1 {TclpMatchFiles: case sensitivity} -constraints {win} -body { makeFile {} GlobCapS - set result [list [glob -nocomplain GlobC*] [glob -nocomplain globc*]] + list [glob -nocomplain GlobC*] [glob -nocomplain globc*] +} -cleanup { removeFile GlobCapS - set result -} {GlobCapS GlobCapS} -test winFile-2.2 {TclpMatchFiles: case sensitivity} {win} { +} -result {GlobCapS GlobCapS} +test winFile-2.2 {TclpMatchFiles: case sensitivity} -constraints {win} -body { makeFile {} globlower - set result [list [glob -nocomplain globl*] [glob -nocomplain gLOBl*]] + list [glob -nocomplain globl*] [glob -nocomplain gLOBl*] +} -cleanup { removeFile globlower - set result -} {globlower globlower} +} -result {globlower globlower} -test winFile-3.1 {file system} {win testvolumetype} { - set res "volume types ok" +test winFile-3.1 {file system} -constraints {win testvolumetype} -setup { + set res "" +} -body { 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 + if {[lindex [file system $vol] 1] ne [testvolumetype $vol]} { + append res "For $vol, we found [file system $vol]\ + and [testvolumetype $vol] are different\n" } } } set res -} {volume types ok} +} -result {} proc cacls {fname args} { string trim [eval [list exec cacls [file nativename $fname]] $args <<y] @@ -105,7 +106,7 @@ proc getuser {fname} { } set owner "" set tail [file tail $tryname] - if {[info exists env(OSTYPE)] && [string equal $env(OSTYPE) "msys"]} { + if {[info exists env(OSTYPE)] && $env(OSTYPE) eq "msys"} { set dirtext [exec ls -l $fname] foreach line [split $dirtext "\n"] { set owner [lindex $line 2] @@ -114,21 +115,20 @@ proc getuser {fname} { set dirtext [exec cmd /c dir /q [file nativename $fname]] foreach line [split $dirtext "\n"] { if {[string match -nocase "*$tail" $line]} { - set attrs [string range $line \ - 0 end-[string length $tail]] + set attrs [string range $line 0 end-[string length $tail]] regexp { [^ \\]+\\.*$} $attrs owner set owner [string trim $owner] } } } - if {[string length $owner] == 0} { + if {$owner eq ""} { error "getuser: Owner not found in output of dir/q" } return $owner } proc test_read {fname} { - if {[catch {set ifs [open $fname r]}]} { + if {[catch {open $fname r} ifs]} { return 0 } set readfailed [catch {read $ifs}] @@ -136,7 +136,7 @@ proc test_read {fname} { } proc test_writ {fname} { - if {[catch {set ofs [open $fname w]}]} { + if {[catch {open $fname w} ofs]} { return 0 } set writefailed [catch {puts $ofs "Hello"}] @@ -153,11 +153,10 @@ proc test_access {fname read writ} { lappend problem "[set $type] != \[test_${type} $fname\]" } } - if {[llength $problem]} { - return "Problem [join $problem \n]\nActual rights are: [cacls $fname]" - } else { - return "" + if {![llength $problem]} { + return } + return "Problem [join $problem \n]\nActual rights are: [cacls $fname]" } if {[testConstraint win]} { |