diff options
author | patthoyts <patthoyts@noemail.net> | 2006-10-01 09:51:04 (GMT) |
---|---|---|
committer | patthoyts <patthoyts@noemail.net> | 2006-10-01 09:51:04 (GMT) |
commit | ca41f559b93a8b79cc5a94e7a4929e6b84927e9f (patch) | |
tree | 3788bd2f2eee28a22c7ecfedc7957f51006d6fe2 | |
parent | f01d4ad874a01a66a8c7f561bbcdc63550f3c69c (diff) | |
download | tcl-ca41f559b93a8b79cc5a94e7a4929e6b84927e9f.zip tcl-ca41f559b93a8b79cc5a94e7a4929e6b84927e9f.tar.gz tcl-ca41f559b93a8b79cc5a94e7a4929e6b84927e9f.tar.bz2 |
bug 1567956: handle Msys environment a little differently in getuser function
FossilOrigin-Name: a81126a71964ca173632e25a092638107cb258f6
-rw-r--r-- | ChangeLog | 5 | ||||
-rw-r--r-- | tests/winFile.test | 31 |
2 files changed, 25 insertions, 11 deletions
@@ -1,3 +1,8 @@ +2006-10-01 Pat Thoyts <patthoyts@users.sourceforge.net> + + * tests/winFile.test: Handle Msys environment a little differently + in getuser function. Fix for bug 1567956. + 2006-09-30 Miguel Sofer <msofer@users.sf.net> * generic/tclUtil.c (Tcl_SplitList): optimisation, [Patch 1344747] 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 |