From c66d63df2c14632d90b665b3e576bc44b18e627f Mon Sep 17 00:00:00 2001 From: patthoyts Date: Sun, 1 Oct 2006 09:51:05 +0000 Subject: bug 1567956: handle Msys environment a little differently in getuser function --- ChangeLog | 5 +++++ tests/winFile.test | 31 ++++++++++++++++++++----------- 2 files changed, 25 insertions(+), 11 deletions(-) diff --git a/ChangeLog b/ChangeLog index b8f186a..2c99433 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,8 @@ +2006-10-01 Pat Thoyts + + * tests/winFile.test: Handle Msys environment a little differently + in getuser function. Fix for bug 1567956. + 2006-09-30 Miguel Sofer * 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 -- cgit v0.12