summaryrefslogtreecommitdiffstats
path: root/tests/winFile.test
diff options
context:
space:
mode:
Diffstat (limited to 'tests/winFile.test')
-rw-r--r--tests/winFile.test112
1 files changed, 67 insertions, 45 deletions
diff --git a/tests/winFile.test b/tests/winFile.test
index 0c13a0e..bfba9cf 100644
--- a/tests/winFile.test
+++ b/tests/winFile.test
@@ -4,68 +4,88 @@
# commands. Sourcing this file into Tcl runs the tests and generates output
# for errors. No output means no errors were found.
#
-# Copyright © 1997 Sun Microsystems, Inc.
-# Copyright © 1998-1999 Scriptics Corporation.
+# 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.
-if {"::tcltest" ni [namespace children]} {
- package require tcltest 2.5
- namespace import -force ::tcltest::*
+if {[catch {package require tcltest 2.0.2}]} {
+ puts stderr "Skipping tests in [info script]. tcltest 2.0.2 required."
+ return
}
-
-::tcltest::loadTestedCommands
-catch [list package require -exact tcl::test [info patchlevel]]
+namespace import -force ::tcltest::*
testConstraint testvolumetype [llength [info commands testvolumetype]]
testConstraint notNTFS 0
+testConstraint win2000 0
if {[testConstraint testvolumetype]} {
testConstraint notNTFS [expr {[testvolumetype] eq "NTFS"}]
}
-testConstraint notWine [expr {![info exists ::env(CI_USING_WINE)]}]
+if {[testConstraint nt] && $::tcl_platform(osVersion) >= 5.0} {
+ testConstraint win2000 1
+}
-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 nonPortable} -body {
+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} {
# The administrator account should always exist.
- glob ~administrator
-} -match glob -result *
-test winFile-1.4 {TclpGetUserHome} {win nonPortable} {
+
+ catch {glob ~administrator}
+} {0}
+test winFile-1.3 {TclpGetUserHome} {win 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} {win nt nonPortable} {
catch {glob ~stanton@workgroup}
} {0}
-test winFile-2.1 {TclpMatchFiles: case sensitivity} -constraints {win} -body {
+test winFile-2.1 {TclpMatchFiles: case sensitivity} {win} {
makeFile {} GlobCapS
- set args [list -nocomplain -tails -directory [temporaryDirectory]]
- list [glob {*}$args GlobC*] [glob {*}$args globc*]} -cleanup {
+ set result [list [glob -nocomplain GlobC*] [glob -nocomplain globc*]]
removeFile GlobCapS
-} -result {GlobCapS GlobCapS}
-test winFile-2.2 {TclpMatchFiles: case sensitivity} -constraints {win} -body {
+ set result
+} {GlobCapS GlobCapS}
+test winFile-2.2 {TclpMatchFiles: case sensitivity} {win} {
makeFile {} globlower
- set args [list -nocomplain -tails -directory [temporaryDirectory]]
- list [glob {*}$args globl*] [glob {*}$args gLOBl*]
-} -cleanup {
+ set result [list [glob -nocomplain globl*] [glob -nocomplain gLOBl*]]
removeFile globlower
-} -result {globlower globlower}
+ set result
+} {globlower globlower}
-test winFile-3.1 {file system} -constraints {win testvolumetype} -setup {
- set res ""
-} -body {
+test winFile-3.1 {file system} {win testvolumetype} {
+ 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 {[lindex [file system $vol] 1] ne [testvolumetype $vol]} {
- append res "For $vol, we found [file system $vol]\
- and [testvolumetype $vol] are different\n"
+ 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
-} -result {}
+} {volume types ok}
proc cacls {fname args} {
string trim [eval [list exec cacls [file nativename $fname]] $args <<y]
@@ -85,7 +105,7 @@ proc getuser {fname} {
}
set owner ""
set tail [file tail $tryname]
- if {[info exists env(OSTYPE)] && $env(OSTYPE) eq "msys"} {
+ if {[info exists env(OSTYPE)] && [string equal $env(OSTYPE) "msys"]} {
set dirtext [exec ls -l $fname]
foreach line [split $dirtext "\n"] {
set owner [lindex $line 2]
@@ -94,20 +114,21 @@ 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 {$owner eq ""} {
+ if {[string length $owner] == 0} {
error "getuser: Owner not found in output of dir/q"
}
return $owner
}
proc test_read {fname} {
- if {[catch {open $fname r} ifs]} {
+ if {[catch {set ifs [open $fname r]}]} {
return 0
}
set readfailed [catch {read $ifs}]
@@ -115,7 +136,7 @@ proc test_read {fname} {
}
proc test_writ {fname} {
- if {[catch {open $fname w} ofs]} {
+ if {[catch {set ofs [open $fname w]}]} {
return 0
}
set writefailed [catch {puts $ofs "Hello"}]
@@ -132,10 +153,11 @@ proc test_access {fname read writ} {
lappend problem "[set $type] != \[test_${type} $fname\]"
}
}
- if {![llength $problem]} {
- return
+ if {[llength $problem]} {
+ return "Problem [join $problem \n]\nActual rights are: [cacls $fname]"
+ } else {
+ return ""
}
- return "Problem [join $problem \n]\nActual rights are: [cacls $fname]"
}
if {[testConstraint win]} {
@@ -151,7 +173,7 @@ if {[testConstraint win]} {
test winFile-4.0 {
Enhanced NTFS user/group permissions: test no acccess
} -constraints {
- win notNTFS notWine
+ win nt notNTFS win2000
} -setup {
set owner [getuser $fname]
set user $::env(USERDOMAIN)\\$::env(USERNAME)
@@ -166,7 +188,7 @@ test winFile-4.0 {
test winFile-4.1 {
Enhanced NTFS user/group permissions: test readable only
} -constraints {
- win notNTFS notWine
+ win nt notNTFS
} -setup {
set user $::env(USERDOMAIN)\\$::env(USERNAME)
} -body {
@@ -177,7 +199,7 @@ test winFile-4.1 {
test winFile-4.2 {
Enhanced NTFS user/group permissions: test writable only
} -constraints {
- win notNTFS notWine
+ win nt notNTFS
} -setup {
set user $::env(USERDOMAIN)\\$::env(USERNAME)
} -body {
@@ -189,7 +211,7 @@ test winFile-4.2 {
test winFile-4.3 {
Enhanced NTFS user/group permissions: test read+write
} -constraints {
- win notNTFS
+ win nt notNTFS
} -setup {
set user $::env(USERDOMAIN)\\$::env(USERNAME)
} -body {
@@ -202,7 +224,7 @@ test winFile-4.3 {
test winFile-4.4 {
Enhanced NTFS user/group permissions: test full access
} -constraints {
- win notNTFS
+ win nt notNTFS
} -setup {
set user $::env(USERDOMAIN)\\$::env(USERNAME)
} -body {
generated by cgit v0.12 at 2025-12-20 13:42:42 (GMT)