More cleaning up of the code to remove unnecessary [string equal]s in tests.

2 files changed, 130 insertions, 244 deletions

diff --git a/ChangeLog b/ChangeLog
index b645eb0..f06295f 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,8 +1,14 @@
+2011-06-08  Donal K. Fellows  <dkf@users.sf.net>
+
+	* tests/fileSystem.test: Reduce the amount of use of duplication of
+	complex code to perform common tests, and convert others to do the
+	test result check directly using Tcltest's own primitives.
+
 2011-06-06  Jan Nijtmans  <nijtmans@users.sf.net>
 
-	* tests/socket.test: Add test constraint, so 6.2 and
-	  6.3 don't fail when the machine does not have support
-	  for ip6. Follow-up to checkin from 2011-05-11 by rmax.
+	* tests/socket.test: Add test constraint, so 6.2 and 6.3 don't fail
+	when the machine does not have support for ip6. Follow-up to checkin
+	from 2011-05-11 by rmax.
 
 2011-06-02  Don Porter  <dgp@users.sourceforge.net>
 
diff --git a/tests/fileSystem.test b/tests/fileSystem.test
index 6ab554b..4191713 100644
--- a/tests/fileSystem.test
+++ b/tests/fileSystem.test
@@ -31,44 +31,39 @@ makeDirectory [file join dir.dir dirinside.dir]
 makeFile "test file in directory" [file join dir.dir inside.file]
 
 testConstraint unusedDrive 0
-set drive {}
-if {[testConstraint win]} {
-    set vols [string map [list :/ {}] [file volumes]]
-    for {set i 0} {$i < 26} {incr i} {
-	set drive [format %c [expr {$i + 65}]]
-	if {$drive ni $vols} {
-	    testConstraint unusedDrive 1
-	    break
+testConstraint moreThanOneDrive 0
+apply {{} {
+    # The variables 'drive' and 'drives' will be used below.
+    variable drive {} drives {}
+    if {[testConstraint win]} {
+	set vols [string map [list :/ {}] [file volumes]]
+	for {set i 0} {$i < 26} {incr i} {
+	    set drive [format %c [expr {$i + 65}]]
+	    if {$drive ni $vols} {
+		testConstraint unusedDrive 1
+		break
+	    }
 	}
-    }
-    unset i vols
-    # The variable 'drive' will be used below
-}
 
-testConstraint moreThanOneDrive 0
-set drives [list]
-if {[testConstraint win]} {
-    set dir [pwd]
-    foreach vol [file volumes] {
-        if {![catch {cd $vol}]} {
-            lappend drives $vol
-        }
-    }
-    if {[llength $drives] > 1} {
-        testConstraint moreThanOneDrive 1
+	set dir [pwd]
+	try {
+	    foreach vol [file volumes] {
+		if {![catch {cd $vol}]} {
+		    lappend drives $vol
+		}
+	    }
+	    testConstraint moreThanOneDrive [llength $drives]
+	} finally {
+	    cd $dir
+	}
     }
-    # The variable 'drives' will be used below
-    unset vol
-    cd $dir
-    unset dir
-}
+} ::tcl::test::fileSystem}
 
 proc testPathEqual {one two} {
     if {$one eq $two} {
-	return 1
-    } else {
-	return "not equal: $one $two"
+	return "ok"
     }
+    return "not equal: $one $two"
 }
 
 testConstraint hasLinks [expr {![catch {
@@ -100,19 +95,19 @@ test filesystem-1.1 {link normalisation} {hasLinks} {
 test filesystem-1.2 {link normalisation} {hasLinks unix} {
     testPathEqual [file normalize [file join gorp.file foo]] \
 	[file normalize [file join link.file foo]]
-} {1}
+} ok
 test filesystem-1.3 {link normalisation} {hasLinks} {
     testPathEqual [file normalize [file join dir.dir foo]] \
 	[file normalize [file join dir.link foo]]
-} {1}
+} ok
 test filesystem-1.4 {link normalisation} {hasLinks} {
     testPathEqual [file normalize [file join dir.dir inside.file]] \
 	[file normalize [file join dir.link inside.file]]
-} {1}
+} ok
 test filesystem-1.5 {link normalisation} {hasLinks} {
     testPathEqual [file normalize [file join dir.dir linkinside.file]] \
 	[file normalize [file join dir.dir linkinside.file]]
-} {1}
+} ok
 test filesystem-1.6 {link normalisation} {hasLinks} {
     string equal [file normalize [file join dir.dir linkinside.file]] \
 	[file normalize [file join dir.link inside.file]]
@@ -120,28 +115,29 @@ test filesystem-1.6 {link normalisation} {hasLinks} {
 test filesystem-1.7 {link normalisation} {hasLinks unix} {
     testPathEqual [file normalize [file join dir.link linkinside.file foo]] \
 	[file normalize [file join dir.dir inside.file foo]]
-} {1}
+} ok
 test filesystem-1.8 {link normalisation} {hasLinks} {
     string equal [file normalize [file join dir.dir linkinside.filefoo]] \
 	[file normalize [file join dir.link inside.filefoo]]
 } {0}
-test filesystem-1.9 {link normalisation} {unix hasLinks} {
+test filesystem-1.9 {link normalisation} -setup {
     file delete -force dir.link
+} -constraints {unix hasLinks} -body {
     file link dir.link [file nativename dir.dir]
     testPathEqual [file normalize [file join dir.dir linkinside.file foo]] \
 	[file normalize [file join dir.link inside.file foo]]
-} {1}
+} -result ok
 test filesystem-1.10 {link normalisation: double link} {unix hasLinks} {
     file link dir2.link dir.link
     testPathEqual [file normalize [file join dir.dir linkinside.file foo]] \
 	[file normalize [file join dir2.link inside.file foo]]
-} {1}
+} ok
 makeDirectory dir2.file
 test filesystem-1.11 {link normalisation: double link, back in tree} {unix hasLinks} {
     file link [file join dir2.file dir2.link] [file join .. dir2.link]
     testPathEqual [file normalize [file join dir.dir linkinside.file foo]] \
 	[file normalize [file join dir2.file dir2.link inside.file foo]]
-} {1}
+} ok
 test filesystem-1.12 {file new native path} {} {
     for {set i 0} {$i < 10} {incr i} {
 	foreach f [lsort [glob -nocomplain -type l *]] {
@@ -198,39 +194,35 @@ test filesystem-1.25 {file normalisation} {win unusedDrive} {
 test filesystem-1.25.1 {file normalisation} {win unusedDrive} {
     file normalize ${drive}:/./.././..\\..\\a\\bb
 } "${drive}:/a/bb"
-test filesystem-1.26 {link normalisation: link and ..} {hasLinks} {
+test filesystem-1.26 {link normalisation: link and ..} -setup {
     file delete -force dir2.link
+} -constraints {hasLinks} -body {
     set dir [file join dir2 foo bar]
     file mkdir $dir
     file link dir2.link [file join dir2 foo bar]
-    set res [list [file normalize [file join dir2 foo x]] \
-	    [file normalize [file join dir2.link .. x]]]
-    testPathEqual [lindex $res 0] [lindex $res 1]
-} 1
+    testPathEqual [file normalize [file join dir2 foo x]] \
+	    [file normalize [file join dir2.link .. x]]
+} -result ok
 test filesystem-1.27 {file normalisation: up and down with ..} {
     set dir [file join dir2 foo bar]
     file mkdir $dir
     set dir2 [file join dir2 .. dir2 foo .. foo bar]
-    set res [list [file normalize $dir] [file normalize $dir2]]
-    set res2 [list [file exists $dir] [file exists $dir2]]
-    if {![string equal [lindex $res 0] [lindex $res 1]]} {
-	set res "exists: $res2, $res not equal"
-    } else {
-	set res "ok: $res2"
-    }
-} {ok: 1 1}
-test filesystem-1.28 {link normalisation: link with .. and ..} {hasLinks} {
+    list [testPathEqual [file normalize $dir] [file normalize $dir2]] \
+	[file exists $dir] [file exists $dir2]
+} {ok 1 1}
+test filesystem-1.28 {link normalisation: link with .. and ..} -setup {
     file delete -force dir2.link
+} -constraints {hasLinks} -body {
     set dir [file join dir2 foo bar]
     file mkdir $dir
     set to [file join dir2 .. dir2 foo .. foo bar]
     file link dir2.link $to
-    set res [list [file normalize [file join dir2 foo x]] \
-	    [file normalize [file join dir2.link .. x]]]
-    testPathEqual [lindex $res 0] [lindex $res 1]
-} 1
-test filesystem-1.29 {link normalisation: link with ..} {hasLinks} {
+    testPathEqual [file normalize [file join dir2 foo x]] \
+	    [file normalize [file join dir2.link .. x]]
+} -result ok
+test filesystem-1.29 {link normalisation: link with ..} -setup {
     file delete -force dir2.link
+} -constraints {hasLinks} -body {
     set dir [file join dir2 foo bar]
     file mkdir $dir
     set to [file join dir2 .. dir2 foo .. foo bar]
@@ -240,11 +232,11 @@ test filesystem-1.29 {link normalisation: link with ..} {hasLinks} {
 	return "$res must not contain '..'"
     }
     return "ok"
-} {ok}
+} -result {ok}
 test filesystem-1.29.1 {link normalisation with two consecutive links} {hasLinks} {
     testPathEqual [file normalize [file join dir.link dirinside.link abc]] \
 	[file normalize [file join dir.dir dirinside.dir abc]]
-} {1}
+} ok
 file delete -force dir2.file
 file delete -force dir2.link
 file delete -force link.file dir.link
@@ -277,208 +269,96 @@ test filesystem-1.33 {link normalisation: link near filesystem root} {testsetpla
 if {[testConstraint testsetplatform]} {
     testsetplatform $platform
 }
-test filesystem-1.34 {file normalisation with '/./'} {
-    set res [file normalize /foo/bar/anc/./.tml]
-    if {[string first "/./" $res] != -1} {
-	set res "normalization of /foo/bar/anc/./.tml is: $res"
-    } else {
-	set res "ok"
-    }
-    set res
-} {ok}
-test filesystem-1.35 {file normalisation with '/./'} {
-    set res [file normalize /ffo/bar/anc/./foo/.tml]
-    if {[string first "/./" $res] != -1 || ([regsub -all "foo" $res "" reg] == 2)} {
-	set res "normalization of /ffo/bar/anc/./foo/.tml is: $res"
-    } else {
-	set res "ok"
-    }
-    set res
-} {ok}
-test filesystem-1.36 {file normalisation with '/./'} {
-    set res [file normalize /foo/bar/anc/././asdasd/.tml]
-    if {[string first "/./" $res] != -1 || ([regsub -all "asdasd" $res "" reg] == 2) } {
-	set res "normalization of /foo/bar/anc/././asdasd/.tml is: $res"
-    } else {
-	set res "ok"
-    }
-    set res
-} {ok}
-test filesystem-1.37 {file normalisation with '/./'} {
+test filesystem-1.34 {file normalisation with '/./'} -body {
+    file normalize /foo/bar/anc/./.tml
+} -match regexp -result {^(?:(?!/\./).)*$}
+test filesystem-1.35a {file normalisation with '/./'} -body {
+    file normalize /ffo/bar/anc/./foo/.tml
+} -match regexp -result {^(?:(?!/\./).)*$}
+test filesystem-1.35b {file normalisation with '/./'} {
+    llength [regexp -all foo [file normalize /ffo/bar/anc/./foo/.tml]]
+} 1
+test filesystem-1.36a {file normalisation with '/./'} -body {
+    file normalize /foo/bar/anc/././asdasd/.tml
+} -match regexp -result {^(?:(?!/\./).)*$}
+test filesystem-1.36b {file normalisation with '/./'} {
+    llength [regexp -all asdasd [file normalize /foo/bar/anc/././asdasd/.tml]]
+} 1
+test filesystem-1.37 {file normalisation with '/./'} -body {
     set fname "/abc/./def/./ghi/./asda/.././.././asd/x/../../../../....."
-    set res [file norm $fname]
-    if {[string first "//" $res] != -1} {
-	set res "normalization of $fname is: $res"
-    } else {
-	set res "ok"
-    }
-    set res
-} {ok}
-test filesystem-1.38 {file normalisation with volume relative} \
-  {win moreThanOneDrive} {
-    set path "[string range [lindex $drives 0] 0 1]foo"
+    file norm $fname
+} -match regexp -result {^(?:[^/]|/(?:[^/]|$))+$}
+test filesystem-1.38 {file normalisation with volume relative} -setup {
     set dir [pwd]
+} -constraints {win moreThanOneDrive} -body {
+    set path "[string range [lindex $drives 0] 0 1]foo"
     cd [lindex $drives 1]
-    set res [file norm $path]
+    file norm $path
+} -cleanup {
     cd $dir
-    set res
-} "[lindex $drives 0]foo"
-test filesystem-1.39 {file normalisation with volume relative} {win} {
-    set drv C:/
-    set dir [lindex [glob -type d -dir $drv *] 0]
+} -result "[lindex $drives 0]foo"
+test filesystem-1.39 {file normalisation with volume relative} -setup {
     set old [pwd]
-    cd $dir
-    set res [file norm [string range $drv 0 1]]
+} -constraints {win} -body {
+    set drv C:/
+    cd [lindex [glob -type d -dir $drv *] 0]
+    file norm [string range $drv 0 1]
+} -cleanup {
     cd $old
-    if {[string index $res end] eq "/"} {
-        set res "Bad normalized path: $res"
-    } else {
-        set res "ok"
-    }
-} {ok}
+} -match glob -result {*[^/]}
 test filesystem-1.40 {file normalisation with repeated separators} {
-    set a [file norm foo////bar]
-    set b [file norm foo/bar]
-    if {![string equal $a $b]} {
-        set res "Paths should be equal: $a , $b"
-    } else {
-        set res "ok"
-    }
-} {ok}
+    testPathEqual [file norm foo////bar] [file norm foo/bar]
+} ok
 test filesystem-1.41 {file normalisation with repeated separators} {win} {
-    set a [file norm foo\\\\\\bar]
-    set b [file norm foo/bar]
-    if {![string equal $a $b]} {
-        set res "Paths should be equal: $a , $b"
-    } else {
-        set res "ok"
-    }
-} {ok}
+    testPathEqual [file norm foo\\\\\\bar] [file norm foo/bar]
+} ok
 test filesystem-1.42 {file normalisation .. beyond root (Bug 1379287)} {
-    set a [file norm /xxx/..]
-    set b [file norm /]
-    if {![string equal $a $b]} {
-        set res "Paths should be equal: $a , $b"
-    } else {
-        set res "ok"
-    }
-} {ok}
+    testPathEqual [file norm /xxx/..] [file norm /]
+} ok
 test filesystem-1.42.1 {file normalisation .. beyond root (Bug 1379287)} {
-    set a [file norm /xxx/../]
-    set b [file norm /]
-    if {![string equal $a $b]} {
-        set res "Paths should be equal: $a , $b"
-    } else {
-        set res "ok"
-    }
-} {ok}
+    testPathEqual [file norm /xxx/../] [file norm /]
+} ok
 test filesystem-1.43 {file normalisation .. beyond root (Bug 1379287)} {
-    set a [file norm /xxx/foo/../..]
-    set b [file norm /]
-    if {![string equal $a $b]} {
-        set res "Paths should be equal: $a , $b"
-    } else {
-        set res "ok"
-    }
-} {ok}
+    testPathEqual [file norm /xxx/foo/../..] [file norm /]
+} ok
 test filesystem-1.43.1 {file normalisation .. beyond root (Bug 1379287)} {
-    set a [file norm /xxx/foo/../../]
-    set b [file norm /]
-    if {![string equal $a $b]} {
-        set res "Paths should be equal: $a , $b"
-    } else {
-        set res "ok"
-    }
-} {ok}
+    testPathEqual [file norm /xxx/foo/../../] [file norm /]
+} ok
 test filesystem-1.44 {file normalisation .. beyond root (Bug 1379287)} {
-    set a [file norm /xxx/foo/../../bar]
-    set b [file norm /bar]
-    if {![string equal $a $b]} {
-        set res "Paths should be equal: $a , $b"
-    } else {
-        set res "ok"
-    }
-} {ok}
+    testPathEqual [file norm /xxx/foo/../../bar] [file norm /bar]
+} ok
 test filesystem-1.45 {file normalisation .. beyond root (Bug 1379287)} {
-    set a [file norm /xxx/../../bar]
-    set b [file norm /bar]
-    if {![string equal $a $b]} {
-        set res "Paths should be equal: $a , $b"
-    } else {
-        set res "ok"
-    }
-} {ok}
+    testPathEqual [file norm /xxx/../../bar] [file norm /bar]
+} ok
 test filesystem-1.46 {file normalisation .. beyond root (Bug 1379287)} {
-    set a [file norm /xxx/../bar]
-    set b [file norm /bar]
-    if {![string equal $a $b]} {
-        set res "Paths should be equal: $a , $b"
-    } else {
-        set res "ok"
-    }
-} {ok}
+    testPathEqual [file norm /xxx/../bar] [file norm /bar]
+} ok
 test filesystem-1.47 {file normalisation .. beyond root (Bug 1379287)} {
-    set a [file norm /..]
-    set b [file norm /]
-    if {![string equal $a $b]} {
-        set res "Paths should be equal: $a , $b"
-    } else {
-        set res "ok"
-    }
-} {ok}
+    testPathEqual [file norm /..] [file norm /]
+} ok
 test filesystem-1.48 {file normalisation .. beyond root (Bug 1379287)} {
-    set a [file norm /../]
-    set b [file norm /]
-    if {![string equal $a $b]} {
-        set res "Paths should be equal: $a , $b"
-    } else {
-        set res "ok"
-    }
-} {ok}
+    testPathEqual [file norm /../] [file norm /]
+} ok
 test filesystem-1.49 {file normalisation .. beyond root (Bug 1379287)} {
-    set a [file norm /.]
-    set b [file norm /]
-    if {![string equal $a $b]} {
-        set res "Paths should be equal: $a , $b"
-    } else {
-        set res "ok"
-    }
-} {ok}
+    testPathEqual [file norm /.] [file norm /]
+} ok
 test filesystem-1.50 {file normalisation .. beyond root (Bug 1379287)} {
-    set a [file norm /./]
-    set b [file norm /]
-    if {![string equal $a $b]} {
-        set res "Paths should be equal: $a , $b"
-    } else {
-        set res "ok"
-    }
-} {ok}
+    testPathEqual [file norm /./] [file norm /]
+} ok
 test filesystem-1.51 {file normalisation .. beyond root (Bug 1379287)} {
-    set a [file norm /../..]
-    set b [file norm /]
-    if {![string equal $a $b]} {
-        set res "Paths should be equal: $a , $b"
-    } else {
-        set res "ok"
-    }
-} {ok}
+    testPathEqual [file norm /../..] [file norm /]
+} ok
 test filesystem-1.51.1 {file normalisation .. beyond root (Bug 1379287)} {
-    set a [file norm /../../]
-    set b [file norm /]
-    if {![string equal $a $b]} {
-        set res "Paths should be equal: $a , $b"
-    } else {
-        set res "ok"
-    }
-} {ok}
+    testPathEqual [file norm /../../] [file norm /]
+} ok
 
 test filesystem-2.0 {new native path} {unix} {
    foreach f [lsort [glob -nocomplain /usr/bin/c*]] {
        catch {file readlink $f}
    }
    # If we reach here we've succeeded. We used to crash above.
-   expr 1
-} {1}
+   return ok
+} ok
 
 # Make sure the testfilesystem hasn't been registered.
 if {[testConstraint testfilesystem]} {
@@ -511,28 +391,28 @@ test filesystem-4.0 {testfilesystem} -constraints testfilesystem -body {
     set filesystemReport {}
     file exists foo
     testfilesystem 0
-    set filesystemReport
+    return $filesystemReport
 } -match glob -result {*{access foo}}
 test filesystem-4.1 {testfilesystem} -constraints testfilesystem -body {
     testfilesystem 1
     set filesystemReport {}
     catch {file stat foo bar}
     testfilesystem 0
-    set filesystemReport
+    return $filesystemReport
 } -match glob -result {*{stat foo}}
 test filesystem-4.2 {testfilesystem} -constraints testfilesystem -body {
     testfilesystem 1
     set filesystemReport {}
     catch {file lstat foo bar}
     testfilesystem 0
-    set filesystemReport
+    return $filesystemReport
 } -match glob -result {*{lstat foo}}
 test filesystem-4.3 {testfilesystem} -constraints testfilesystem -body {
     testfilesystem 1
     set filesystemReport {}
     catch {glob *}
     testfilesystem 0
-    set filesystemReport
+    return $filesystemReport
 } -match glob -result {*{matchindirectory *}*}
 
 test filesystem-5.1 {cache and ~} -constraints testfilesystem -setup {
@@ -1041,7 +921,7 @@ test filesystem-9.9 {path objects and glob and file tail and tilde} -setup {
 # ----------------------------------------------------------------------
 
 cleanupTests
-unset -nocomplain drive
+unset -nocomplain drive drives
 }
 namespace delete ::tcl::test::fileSystem
 return