diff options
author | vincentdarley <vincentdarley> | 2003-10-03 17:25:22 (GMT) |
---|---|---|
committer | vincentdarley <vincentdarley> | 2003-10-03 17:25:22 (GMT) |
commit | 5e610d838ab3c6b8398b2ae540ca3d73f2025e8a (patch) | |
tree | 0d47a9e7196a908e951c272e96bb45c5b051a95d | |
parent | 7874bbbf7780a2d50f99f77b4d0590e5b4e6fcbf (diff) | |
download | tcl-5e610d838ab3c6b8398b2ae540ca3d73f2025e8a.zip tcl-5e610d838ab3c6b8398b2ae540ca3d73f2025e8a.tar.gz tcl-5e610d838ab3c6b8398b2ae540ca3d73f2025e8a.tar.bz2 |
new tests for reported problems, fixes to follow
-rw-r--r-- | tests/fileName.test | 70 | ||||
-rw-r--r-- | tests/winFCmd.test | 46 |
2 files changed, 112 insertions, 4 deletions
diff --git a/tests/fileName.test b/tests/fileName.test index 6247fb9..e858caa 100644 --- a/tests/fileName.test +++ b/tests/fileName.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: fileName.test,v 1.30.2.1 2003/04/29 11:45:24 vincentdarley Exp $ +# RCS: @(#) $Id: fileName.test,v 1.30.2.2 2003/10/03 17:25:22 vincentdarley Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -895,6 +895,74 @@ test filename-9.18 {Tcl_JoinPath: win} {testsetplatform} { testsetplatform win file join foo/./bar } {foo/./bar} +test filename-9.19 {Tcl_JoinPath: win} {testsetplatform} { + testsetplatform win + set res {} + lappend res \ + [file join {C:\foo\bar}] \ + [file join C:/blah {C:\foo\bar}] \ + [file join C:/blah C:/blah {C:\foo\bar}] +} {C:/foo/bar C:/foo/bar C:/foo/bar} +test filename-9.20 {Tcl_JoinPath: unix} {testsetplatform} { + testsetplatform unix + set res {} + lappend res \ + [file join {/foo/bar}] \ + [file join /x {/foo/bar}] \ + [file join /x /x {/foo/bar}] +} {/foo/bar /foo/bar /foo/bar} +test filename-9.21 {Tcl_JoinPath: mac} {testsetplatform} { + testsetplatform mac + set res {} + lappend res \ + [file join {/foo/bar}] \ + [file join drive: {/foo/bar}] \ + [file join drive: drive: {/foo/bar}] +} {foo:bar foo:bar foo:bar} +test filename-9.22 {Tcl_JoinPath: mac} {testsetplatform} { + testsetplatform mac + set res {} + lappend res \ + [file join {foo:bar}] \ + [file join drive: {foo:bar}] \ + [file join drive: drive: {foo:bar}] +} {foo:bar foo:bar foo:bar} +test filename-9.23 {Tcl_JoinPath: win} {testsetplatform} { + testsetplatform win + set res {} + lappend res \ + [file join {foo\bar}] \ + [file join C:/blah {foo\bar}] \ + [file join C:/blah C:/blah {foo\bar}] + string map [list C:/blah ""] $res +} {foo/bar /foo/bar /foo/bar} +test filename-9.24 {Tcl_JoinPath: unix} {testsetplatform} { + testsetplatform unix + set res {} + lappend res \ + [file join {foo/bar}] \ + [file join /x {foo/bar}] \ + [file join /x /x {foo/bar}] + string map [list /x ""] $res +} {foo/bar /foo/bar /foo/bar} +test filename-9.25 {Tcl_JoinPath: mac} {testsetplatform} { + testsetplatform mac + set res {} + lappend res \ + [file join {foo/bar}] \ + [file join drive: {foo/bar}] \ + [file join drive: drive: {foo/bar}] + string map [list drive: ""] $res +} {:foo:bar foo:bar foo:bar} +test filename-9.26 {Tcl_JoinPath: mac} {testsetplatform} { + testsetplatform mac + set res {} + lappend res \ + [file join {:foo:bar}] \ + [file join drive: {:foo:bar}] \ + [file join drive: drive: {:foo:bar}] + string map [list drive: ""] $res +} {:foo:bar foo:bar foo:bar} test filename-10.1 {Tcl_TranslateFileName} {testsetplatform} { testsetplatform unix diff --git a/tests/winFCmd.test b/tests/winFCmd.test index 0dcb46a..58d6f67 100644 --- a/tests/winFCmd.test +++ b/tests/winFCmd.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: winFCmd.test,v 1.20 2002/10/04 08:25:14 dkf Exp $ +# RCS: @(#) $Id: winFCmd.test,v 1.20.2.1 2003/10/03 17:25:22 vincentdarley Exp $ # if {[lsearch [namespace children] ::tcltest] == -1} { @@ -598,8 +598,11 @@ test winFCmd-6.10 {TclpRemoveDirectory: attr == -1} {pcOnly 95} { } {1 {nul EACCES}} test winFCmd-6.11 {TclpRemoveDirectory: attr == -1} {pcOnly nt} { cleanup - list [catch {testfile rmdir /} msg] $msg -} {1 {/ EACCES}} + set res [list [catch {testfile rmdir /} msg] $msg] + # WinXP returns EEXIST, WinNT seems to return EACCES. No policy + # decision has been made as to which is correct. + regsub {E(ACCES|EXIST)} $res "EACCES or EEXIST" +} {1 {C:/ EACCES or EEXIST}} test winFCmd-6.12 {TclpRemoveDirectory: errno == EACCES} {pcOnly 95} { cleanup createfile tf1 @@ -968,6 +971,43 @@ test winFCmd-15.10 {SetWinFileAttributes - failing} {pcOnly cdrom} { test winFCmd-16.1 {Windows file normalization} {pcOnly} { list [file normalize c:/] [file normalize C:/] } {C:/ C:/} +test winFCmd-16.2 {Windows file normalization} {pcOnly} { + close [open td1... w] + set res [file tail [file normalize td1]] + file delete td1... + set res +} {td1} + +set pwd [pwd] +set d [string index $pwd 0] + +test winFCmd-16.3 {Windows file normalization} {pcOnly} { + file norm ${d}:foo +} [file join $pwd foo] +test winFCmd-16.4 {Windows file normalization} {pcOnly} { + file norm [string tolower ${d}]:foo +} [file join $pwd foo] +test winFCmd-16.5 {Windows file normalization} {pcOnly} { + file norm ${d}:foo/bar +} [file join $pwd foo/bar] +test winFCmd-16.6 {Windows file normalization} {pcOnly} { + file norm ${d}:foo\\bar +} [file join $pwd foo/bar] +test winFCmd-16.7 {Windows file normalization} {pcOnly} { + file norm /bar +} "${d}:/bar" +test winFCmd-16.8 {Windows file normalization} {pcOnly} { + file norm ///bar +} "${d}:/bar" +test winFCmd-16.9 {Windows file normalization} {pcOnly} { + file norm /bar/foo +} "${d}:/bar/foo" +test winFCmd-16.10 {Windows file normalization} {pcOnly knownBug} { + if {$d eq "C"} { set dd "D" } else { set dd "C" } + file norm ${dd}:foo +} {Tcl doesn't know about a drive-specific cwd} + +unset d pwd # This block of code used to occur after the "return" call, so I'm # commenting it out and assuming that this code is still under construction. |