diff options
| -rw-r--r-- | ChangeLog | 15 | ||||
| -rw-r--r-- | doc/FileSystem.3 | 25 | ||||
| -rw-r--r-- | generic/tclFileName.c | 11 | ||||
| -rw-r--r-- | tests/cmdAH.test | 6 | ||||
| -rw-r--r-- | tests/fileName.test | 9 | ||||
| -rw-r--r-- | tests/pkgMkIndex.test | 18 |
6 files changed, 56 insertions, 28 deletions
@@ -1,3 +1,14 @@ +2002-05-07 Vince Darley <vincentdarley@users.sourceforge.net> + + * generic/tclFileName.c: fix to similar segfault when using + 'glob -types nonsense -dir dirname -join * *'. [Bug 553320] + + * doc/FileSystem.3: further documentation on vfs. + * tests/cmdAH.test: + * tests/fileSystem.test: + * tests/pkgMkindex.test: Fix to testsuite bugs when running out + of directory whose name contains '{' or '['. + 2002-05-07 Miguel Sofer <msofer@users.sourceforge.net> * tests/basic.test: Fix for [Bug 549607] @@ -26,8 +37,8 @@ * tests/winFile.test: test for 'file system' returning correct values. * tests/fileSystem.test: test for 'file system' returning correct - values. - + values. Clean up after failed previous test run. + 2002-04-26 Jeff Hobbs <jeffh@ActiveState.com> * unix/configure: diff --git a/doc/FileSystem.3 b/doc/FileSystem.3 index 413c119..01a3585 100644 --- a/doc/FileSystem.3 +++ b/doc/FileSystem.3 @@ -4,7 +4,7 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -'\" RCS: @(#) $Id: FileSystem.3,v 1.22 2002/05/02 20:15:20 vincentdarley Exp $ +'\" RCS: @(#) $Id: FileSystem.3,v 1.23 2002/05/07 18:03:04 vincentdarley Exp $ '\" .so man.macros .TH Filesystem 3 8.4 Tcl "Tcl Library Procedures" @@ -241,15 +241,20 @@ filesystem which has been registered (through media or access methods. This means that all of these functions (and therefore the corresponding \fBfile\fR, \fBglob\fR, \fBpwd\fR, \fBcd\fR, \fBopen\fR, etc. Tcl commands) may be operate on 'files' which are not -native files in the native filesystem. If appropriate vfs's have been -registered, the 'files' may, to give two examples, be remote (e.g. -situated on a remote ftp server) or archived (e.g. lying inside a .zip -archive). Such registered filesystems provide a lookup table of -functions to implement all or some of the functionality listed here. -Finally, the \fBTcl_FSStat\fR and \fBTcl_FSLstat\fR calls abstract -away from what the 'struct stat' buffer buffer is actually declared to -be, allowing the same code to be used both on systems with and systems -without support for files larger than 2GB in size. +native files in the native filesystem. This also means that any Tcl +extension which accesses the filesystem through this API is +automatically 'virtual filesystem aware'. Of course, if an extension +accesses the native filesystem directly (through platform-specific +APIs, for example), then Tcl cannot intercept such calls. +.PP +If appropriate vfs's have been registered, the 'files' may, to give two +examples, be remote (e.g. situated on a remote ftp server) or archived +(e.g. lying inside a .zip archive). Such registered filesystems provide +a lookup table of functions to implement all or some of the functionality +listed here. Finally, the \fBTcl_FSStat\fR and \fBTcl_FSLstat\fR calls +abstract away from what the 'struct stat' buffer buffer is actually +declared to be, allowing the same code to be used both on systems with +and systems without support for files larger than 2GB in size. .PP The \fBTcl_FS...\fR are objectified and may cache internal representations and other path-related strings (e.g. the current diff --git a/generic/tclFileName.c b/generic/tclFileName.c index b793e38..8fc794b 100644 --- a/generic/tclFileName.c +++ b/generic/tclFileName.c @@ -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: tclFileName.c,v 1.34 2002/05/02 20:15:20 vincentdarley Exp $ + * RCS: @(#) $Id: tclFileName.c,v 1.35 2002/05/07 18:03:04 vincentdarley Exp $ */ #include "tclInt.h" @@ -1789,18 +1789,25 @@ Tcl_GlobObjCmd(dummy, interp, objc, objv) } } /* - * Error cases + * Error cases. We re-get the interpreter's result, + * just to be sure it hasn't changed, and we reset + * the 'join' flag to zero, since we haven't yet + * made use of it. */ badTypesArg: + resultPtr = Tcl_GetObjResult(interp); Tcl_AppendToObj(resultPtr, "bad argument to \"-types\": ", -1); Tcl_AppendObjToObj(resultPtr, look); result = TCL_ERROR; + join = 0; goto endOfGlob; badMacTypesArg: + resultPtr = Tcl_GetObjResult(interp); Tcl_AppendToObj(resultPtr, "only one MacOS type or creator argument" " to \"-types\" allowed", -1); result = TCL_ERROR; + join = 0; goto endOfGlob; } } diff --git a/tests/cmdAH.test b/tests/cmdAH.test index 973ecad..cd0cce8 100644 --- a/tests/cmdAH.test +++ b/tests/cmdAH.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: cmdAH.test,v 1.19 2002/04/08 09:02:11 das Exp $ +# RCS: @(#) $Id: cmdAH.test,v 1.20 2002/05/07 18:03:04 vincentdarley Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -60,7 +60,7 @@ test cmdAH-2.3 {Tcl_CdObjCmd} { file mkdir foo cd foo cd ~ - set result [string match [pwd] $oldpwd] + set result [string equal [pwd] $oldpwd] file delete foo set env(HOME) $temp set result @@ -74,7 +74,7 @@ test cmdAH-2.4 {Tcl_CdObjCmd} { file mkdir foo cd foo cd - set result [string match [pwd] $oldpwd] + set result [string equal [pwd] $oldpwd] file delete foo set env(HOME) $temp set result diff --git a/tests/fileName.test b/tests/fileName.test index 3d34e70..9289bc9 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.19 2002/05/02 20:15:20 vincentdarley Exp $ +# RCS: @(#) $Id: fileName.test,v 1.20 2002/05/07 18:03:05 vincentdarley Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -1272,6 +1272,11 @@ test filename-11.21 {Tcl_GlobCmd} { list [catch {lsort [glob -type d -path $globname *]} msg] $msg } [list 0 [lsort [list $globname]]] +# Get rid of file/dir if it exists, since it will have +# been left behind by a previous failed run. +if {[file exists $horribleglobname]} { + file delete -force $horribleglobname +} file rename globTest $horribleglobname set globname $horribleglobname @@ -1769,7 +1774,7 @@ test filename-16.15 {windows specific globbing} {pcOnly} { glob .. } {..} test filename-16.16 {windows specific globbing} {pcOnly} { - file tail [glob "[lindex [glob -types d -dir C:/ *] 0]/.."] + file tail [lindex [glob "[lindex [glob -types d -dir C:/ *] 0]/.."] 0] } {..} # cleanup diff --git a/tests/pkgMkIndex.test b/tests/pkgMkIndex.test index 76476f0..79a6b52 100644 --- a/tests/pkgMkIndex.test +++ b/tests/pkgMkIndex.test @@ -8,7 +8,7 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: pkgMkIndex.test,v 1.18 2001/01/12 09:54:16 dkf Exp $ +# RCS: @(#) $Id: pkgMkIndex.test,v 1.19 2002/05/07 18:03:05 vincentdarley Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -270,11 +270,11 @@ test pkgMkIndex-2.1 {simple package} { test pkgMkIndex-2.2 {simple package - use -direct} { pkgtest::runIndex -direct $fullPkgPath simple.tcl -} "0 {{simple:1.0 {source [file join $fullPkgPath simple.tcl]}}}" +} "0 {{simple:1.0 {[list source [file join $fullPkgPath simple.tcl]]}}}" test pkgMkIndex-2.3 {simple package - direct loading is default} { pkgtest::runIndex $fullPkgPath simple.tcl -} "0 {{simple:1.0 {source [file join $fullPkgPath simple.tcl]}}}" +} "0 {{simple:1.0 {[list source [file join $fullPkgPath simple.tcl]]}}}" test pkgMkIndex-3.1 {simple package with global symbols} { pkgtest::runIndex -lazy $fullPkgPath global.tcl @@ -286,8 +286,8 @@ test pkgMkIndex-4.1 {split package} { test pkgMkIndex-4.2 {split package - direct loading} { pkgtest::runIndex -direct $fullPkgPath pkg2_a.tcl pkg2_b.tcl -} "0 {{pkg2:1.0 {source [file join $fullPkgPath pkg2_a.tcl] -source [file join $fullPkgPath pkg2_b.tcl]}}}" +} "0 {{pkg2:1.0 {[list source [file join $fullPkgPath pkg2_a.tcl]] +[list source [file join $fullPkgPath pkg2_b.tcl]]}}}" # This will fail, with "direct1" procedures in the list of procedures # provided by std. @@ -305,7 +305,7 @@ test pkgMkIndex-6.1 {pkg1 requires pkg3} { test pkgMkIndex-6.2 {pkg1 requires pkg3 - use -direct} { pkgtest::runIndex -direct $fullPkgPath pkg1.tcl pkg3.tcl -} "0 {{pkg1:1.0 {source [file join $fullPkgPath pkg1.tcl]}} {pkg3:1.0 {source [file join $fullPkgPath pkg3.tcl]}}}" +} "0 {{pkg1:1.0 {[list source [file join $fullPkgPath pkg1.tcl]]}} {pkg3:1.0 {[list source [file join $fullPkgPath pkg3.tcl]]}}}" test pkgMkIndex-7.1 {pkg4 uses pkg3} { pkgtest::runIndex -lazy $fullPkgPath pkg4.tcl pkg3.tcl @@ -313,7 +313,7 @@ test pkgMkIndex-7.1 {pkg4 uses pkg3} { test pkgMkIndex-7.2 {pkg4 uses pkg3 - use -direct} { pkgtest::runIndex -direct $fullPkgPath pkg4.tcl pkg3.tcl -} "0 {{pkg3:1.0 {source [file join $fullPkgPath pkg3.tcl]}} {pkg4:1.0 {source [file join $fullPkgPath pkg4.tcl]}}}" +} "0 {{pkg3:1.0 {[list source [file join $fullPkgPath pkg3.tcl]]}} {pkg4:1.0 {[list source [file join $fullPkgPath pkg4.tcl]]}}}" test pkgMkIndex-8.1 {pkg5 uses pkg2} { pkgtest::runIndex -lazy $fullPkgPath pkg5.tcl pkg2_a.tcl pkg2_b.tcl @@ -321,8 +321,8 @@ test pkgMkIndex-8.1 {pkg5 uses pkg2} { test pkgMkIndex-8.2 {pkg5 uses pkg2 - use -direct} { pkgtest::runIndex -direct $fullPkgPath pkg5.tcl pkg2_a.tcl pkg2_b.tcl -} "0 {{pkg2:1.0 {source [file join $fullPkgPath pkg2_a.tcl] -source [file join $fullPkgPath pkg2_b.tcl]}} {pkg5:1.0 {source [file join $fullPkgPath pkg5.tcl]}}}" +} "0 {{pkg2:1.0 {[list source [file join $fullPkgPath pkg2_a.tcl]] +[list source [file join $fullPkgPath pkg2_b.tcl]]}} {pkg5:1.0 {[list source [file join $fullPkgPath pkg5.tcl]]}}}" test pkgMkIndex-9.1 {circular packages} { pkgtest::runIndex -lazy $fullPkgPath circ1.tcl circ2.tcl circ3.tcl |