summaryrefslogtreecommitdiffstats
path: root/tests
diff options
context:
space:
mode:
authorpatthoyts <patthoyts@users.sourceforge.net>2006-10-01 09:51:05 (GMT)
committerpatthoyts <patthoyts@users.sourceforge.net>2006-10-01 09:51:05 (GMT)
commitc66d63df2c14632d90b665b3e576bc44b18e627f (patch)
tree3788bd2f2eee28a22c7ecfedc7957f51006d6fe2 /tests
parent95ad00a6876e7f285593ef426f2b86df76115ae7 (diff)
downloadtcl-c66d63df2c14632d90b665b3e576bc44b18e627f.zip
tcl-c66d63df2c14632d90b665b3e576bc44b18e627f.tar.gz
tcl-c66d63df2c14632d90b665b3e576bc44b18e627f.tar.bz2
bug 1567956: handle Msys environment a little differently in getuser function
Diffstat (limited to 'tests')
-rw-r--r--tests/winFile.test31
1 files changed, 20 insertions, 11 deletions
diff --git a/tests/winFile.test b/tests/winFile.test
index 6d5377a..c08cc20 100644
--- a/tests/winFile.test
+++ b/tests/winFile.test
@@ -10,7 +10,7 @@
# 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.18 2006/03/20 15:41:10 dkf Exp $
+# RCS: @(#) $Id: winFile.test,v 1.19 2006/10/01 09:51:05 patthoyts Exp $
if {[catch {package require tcltest 2.0.2}]} {
puts stderr "Skipping tests in [info script]. tcltest 2.0.2 required."
@@ -95,23 +95,32 @@ proc cacls {fname args} {
# dir/q output:
# 2003-11-03 20:36 598 OCTAVIAN\benny filename.txt
+# Modified to cope with Msys environment and use ls -l.
proc getuser {fname} {
+ global env
set tryname $fname
if {[file isdirectory $fname]} {
set tryname [file dirname $fname]
}
- set tail [file tail $tryname]
- set dirtext [exec cmd /c dir /q [file nativename $fname]]
set owner ""
- foreach line [split $dirtext "\n"] {
- if {[string match -nocase "* $tail" $line]} {
- set attrs [string range $line \
- 0 end-[string length $tail]]
- regexp { [^ \\]+\\.*$} $attrs owner
- set owner [string trim $owner]
- }
+ set tail [file tail $tryname]
+ 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]
+ }
+ } else {
+ 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]]
+ regexp { [^ \\]+\\.*$} $attrs owner
+ set owner [string trim $owner]
+ }
+ }
}
- if {"" == "$owner"} {
+ if {[string length $owner] == 0} {
error "getuser: Owner not found in output of dir/q"
}
return $owner