diff options
| -rw-r--r-- | ChangeLog | 6 | ||||
| -rw-r--r-- | generic/tclIOUtil.c | 17 | ||||
| -rw-r--r-- | tests/winFCmd.test | 18 |
3 files changed, 31 insertions, 10 deletions
@@ -1,3 +1,9 @@ +2003-11-20 Vince Darley <vincentdarley@users.sourceforge.net> + + * generic/tclIOUtil.c: + * tests/winFCmd.test: fix to [Bug 845778] - Infinite recursion + on [cd] (Windows only bug). + 2003-11-18 Jeff Hobbs <jeffh@ActiveState.com> *** 8.4.5 TAGGED FOR RELEASE *** diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c index 2da3666..de12596 100644 --- a/generic/tclIOUtil.c +++ b/generic/tclIOUtil.c @@ -17,7 +17,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclIOUtil.c,v 1.77.2.11 2003/10/22 22:35:46 andreas_kupries Exp $ + * RCS: @(#) $Id: tclIOUtil.c,v 1.77.2.12 2003/11/20 19:05:44 vincentdarley Exp $ */ #include "tclInt.h" @@ -5572,15 +5572,22 @@ Tcl_FSGetNormalizedPath(interp, pathObjPtr) } if (drive[0] == drive_c) { absolutePath = Tcl_DuplicateObj(useThisCwd); - Tcl_IncrRefCount(absolutePath); - Tcl_AppendToObj(absolutePath, "/", 1); - Tcl_AppendToObj(absolutePath, path+2, -1); /* We have a refCount on the cwd */ } else { - /* We just can't handle it correctly here */ Tcl_DecrRefCount(useThisCwd); useThisCwd = NULL; + /* + * The path is not in the current drive, but + * is volume-relative. The way Tcl 8.3 handles + * this is that it treats such a path as + * relative to the root of the drive. We + * therefore behave the same here. + */ + absolutePath = Tcl_NewStringObj(path, 2); } + Tcl_IncrRefCount(absolutePath); + Tcl_AppendToObj(absolutePath, "/", 1); + Tcl_AppendToObj(absolutePath, path+2, -1); } #endif /* __WIN32__ */ } diff --git a/tests/winFCmd.test b/tests/winFCmd.test index 58d6f67..be2cc85 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.2.1 2003/10/03 17:25:22 vincentdarley Exp $ +# RCS: @(#) $Id: winFCmd.test,v 1.20.2.2 2003/11/20 19:05:45 vincentdarley Exp $ # if {[lsearch [namespace children] ::tcltest] == -1} { @@ -1002,12 +1002,20 @@ test winFCmd-16.8 {Windows file normalization} {pcOnly} { 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" } +test winFCmd-16.10 {Windows file normalization} {pcOnly} { file norm ${dd}:foo -} {Tcl doesn't know about a drive-specific cwd} +} "${dd}:/foo" +test winFCmd-16.11 {Windows file normalization} {pcOnly cdrom} { + cd ${d}: + cd $cdrom + cd ${d}: + cd $cdrom + # Must not crash + set result "no crash" +} {no crash} -unset d pwd +cd $pwd +unset d dd 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. |