Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Changes In Branch vendor Excluding Merge-Ins
This is equivalent to a diff from be00629e6a to 277c5d5b05
2001-08-03
| ||
16:19 | Initial commit check-in: f795e037a8 user: vincentdarley tags: start, trunk | |
16:19 | Initial commit Leaf check-in: 277c5d5b05 user: vincentdarley tags: vendor | |
16:18 | initial empty check-in check-in: be00629e6a user: cvs2fossil tags: trunk | |
Added ChangeLog.
> > > | 1 2 3 | 2001-05-09 Vince Darley <[email protected]> * initial distribution |
Added Makefile.in.
> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 | # Makefile.in -- # # This file is a Makefile for Sample TEA Extension. If it has the name # "Makefile.in" then it is a template for a Makefile; to generate the # actual Makefile, run "./configure", which is a configuration script # generated by the "autoconf" program (constructs like "@foo@" will get # replaced in the actual Makefile. # # Copyright (c) 1999 Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id: Makefile.in,v 1.1.1.1 2001/08/03 16:19:00 vincentdarley Exp $ #======================================================================== # Edit the following few lines when writing a new extension #======================================================================== #======================================================================== # Change the name of the variable "vfs_LIB_FILE" to match the one # used in the configure script. This is the parameterized name of the # library that we are building. #======================================================================== lib_BINARIES=$(vfs_LIB_FILE) BINARIES=$(lib_BINARIES) #======================================================================== # Enumerate the names of the source files included in this package. # This will be used when a dist target is added to the Makefile. #======================================================================== vfs_SOURCES = vfs.c SOURCES = $(vfs_SOURCES) #======================================================================== # Enumerate the names of the object files included in this package. # These objects are created and linked into the final library. In # most cases these object files will correspond to the source files # above. # #======================================================================== vfs_OBJECTS = vfs.$(OBJEXT) OBJECTS = $(vfs_OBJECTS) #======================================================================== # The substitution of "vfs_LIB_FILE" into the variable name below # allows us to refer to the objects for the library without knowing the name # of the library in advance. It also lets us use the "$@" variable in # the rule for building the library, so we can refer to both the list of # objects and the library itself in a platform-independent manner. #======================================================================== vfs_LIB_FILE = @vfs_LIB_FILE@ $(vfs_LIB_FILE)_OBJECTS = $(vfs_OBJECTS) #======================================================================== # This is a list of header files to be installed #======================================================================== GENERIC_HDRS= #======================================================================== # Add additional lines to handle any additional AC_SUBST cases that # have been added to the configure script. #======================================================================== SAMPLE_NEW_VAR=@SAMPLE_NEW_VAR@ #======================================================================== # Nothing of the variables below this line need to be changed. Please # check the TARGETS section below to make sure the make targets are # correct. #======================================================================== SHELL = @SHELL@ srcdir = @srcdir@ top_srcdir = @top_srcdir@ prefix = @prefix@ exec_prefix = @exec_prefix@ bindir = @bindir@ sbindir = @sbindir@ libexecdir = @libexecdir@ datadir = @datadir@ sysconfdir = @sysconfdir@ sharedstatedir = @sharedstatedir@ localstatedir = @localstatedir@ libdir = @libdir@ infodir = @infodir@ mandir = @mandir@ includedir = @includedir@ oldincludedir = /usr/include DESTDIR = pkgdatadir = $(datadir)/@PACKAGE@@VERSION@ pkglibdir = $(libdir)/@PACKAGE@@VERSION@ pkgincludedir = $(includedir)/@PACKAGE@@VERSION@ top_builddir = . INSTALL = @INSTALL@ INSTALL_PROGRAM = @INSTALL_PROGRAM@ INSTALL_DATA = @INSTALL_DATA@ INSTALL_SCRIPT = @INSTALL_SCRIPT@ INSTALL_STRIP_FLAG = transform = @program_transform_name@ NORMAL_INSTALL = : PRE_INSTALL = : POST_INSTALL = : NORMAL_UNINSTALL = : PRE_UNINSTALL = : POST_UNINSTALL = : PACKAGE = @PACKAGE@ VERSION = @VERSION@ CC = @CC@ CFLAGS_DEBUG = @CFLAGS_DEBUG@ CFLAGS_DEFAULT = @CFLAGS_DEFAULT@ CFLAGS_OPTIMIZE = @CFLAGS_OPTIMIZE@ CLEANFILES = @CLEANFILES@ EXEEXT = @EXEEXT@ LDFLAGS_DEBUG = @LDFLAGS_DEBUG@ LDFLAGS_DEFAULT = @LDFLAGS_DEFAULT@ LDFLAGS_OPTIMIZE = @LDFLAGS_OPTIMIZE@ MAKE_LIB = @MAKE_LIB@ MAKE_SHARED_LIB = @MAKE_SHARED_LIB@ MAKE_STATIC_LIB = @MAKE_STATIC_LIB@ OBJEXT = @OBJEXT@ RANLIB = @RANLIB@ SHLIB_CFLAGS = @SHLIB_CFLAGS@ SHLIB_LD = @SHLIB_LD@ SHLIB_LDFLAGS = @SHLIB_LDFLAGS@ SHLIB_LD_LIBS = @SHLIB_LD_LIBS@ STLIB_LD = @STLIB_LD@ TCL_BIN_DIR = @TCL_BIN_DIR@ TCL_DEFS = @TCL_DEFS@ TCL_EXTRA_CFLAGS = @TCL_EXTRA_CFLAGS@ TCL_LD_FLAGS = @TCL_LD_FLAGS@ TCL_LIBS = @TCL_LIBS@ TCL_SHLIB_LD_LIBS = @TCL_SHLIB_LD_LIBS@ TCL_SRC_DIR = @TCL_SRC_DIR@ TCL_DBGX = @TCL_DBGX@ TCL_STUB_LIB_FILE = @TCL_STUB_LIB_FILE@ TCL_STUB_LIB_SPEC = @TCL_STUB_LIB_SPEC@ TCL_TOOL_DIR_NATIVE = @TCL_TOOL_DIR_NATIVE@ TCL_TOP_DIR_NATIVE = @TCL_TOP_DIR_NATIVE@ TCL_UNIX_DIR_NATIVE = @TCL_UNIX_DIR_NATIVE@ TCL_WIN_DIR_NATIVE = @TCL_WIN_DIR_NATIVE@ INCLUDE_DIR_NATIVE = @INCLUDE_DIR_NATIVE@ TCL_BMAP_DIR_NATIVE = @TCL_BMAP_DIR_NATIVE@ TCL_PLATFORM_DIR_NATIVE = @TCL_PLATFORM_DIR_NATIVE@ TCL_GENERIC_DIR_NATIVE = @TCL_GENERIC_DIR_NATIVE@ TCLSH_PROG = @TCLSH_PROG@ SHARED_BUILD = @SHARED_BUILD@ AUTOCONF = autoconf LDFLAGS = $(LDFLAGS_DEFAULT) INCLUDES = @TCL_INCLUDES@ EXTRA_CFLAGS = $(TCL_DEFS) $(PROTO_FLAGS) $(SECURITY_FLAGS) $(MEM_DEBUG_FLAGS) $(KEYSYM_FLAGS) $(NO_DEPRECATED_FLAGS) $(TCL_EXTRA_CFLAGS) DEFS = @DEFS@ $(EXTRA_CFLAGS) ACLOCAL_M4 = $(top_srcdir)/aclocal.m4 CONFIGDIR = $(top_srcdir) mkinstalldirs = $(SHELL) $(CONFIGDIR)/mkinstalldirs CONFIG_CLEAN_FILES = mkIndex.tcl CPPFLAGS = @CPPFLAGS@ LIBS = @LIBS@ AR = ar CFLAGS = @CFLAGS@ COMPILE = $(CC) $(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) CCLD = $(CC) LINK = $(CCLD) $(AM_CFLAGS) $(CFLAGS) $(LDFLAGS) -o $@ #======================================================================== # Start of user-definable TARGETS section #======================================================================== #======================================================================== # TEA TARGETS. Please note that the "libraries:" target refers to platform # independent files, and the "binaries:" target inclues executable programs and # platform-dependent libraries. Modify these targets so that they install # the various pieces of your package. The make and install rules # for the BINARIES that you specified above have already been done. #======================================================================== all: binaries libraries doc #======================================================================== # The binaries target builds executable programs, Windows .dll's, unix # shared/static libraries, and any other platform-dependent files. # The list of targets to build for "binaries:" is specified at the top # of the Makefile, in the "BINARIES" variable. #======================================================================== binaries: $(BINARIES) libraries: doc: @echo "If you have documentation to create, place the commands to" @echo "build the docs in the 'doc:' target. For example:" @echo "" @echo "xml2nroff VFS.xml > VFS.n" @echo "xml2html VFS.xml > VFS.html" install: all install-binaries install-libraries install-doc install-binaries: binaries install-lib-binaries install-bin-binaries $(TCLSH_PROG) mkIndex.tcl $(vfs_LIB_FILE) if test "x$(SHARED_BUILD)" = "x1"; then \ $(TCLSH_PROG) mkIndex.tcl $(vfs_LIB_FILE); \ fi #======================================================================== # This rule installs platform-independent files, such as header files. #======================================================================== install-libraries: libraries $(mkinstalldirs) $(includedir) @echo "Installing header files in $(includedir)" @for i in $(GENERIC_HDRS) ; do \ echo "Installing $$i" ; \ $(INSTALL_DATA) $$i $(includedir) ; \ done; #======================================================================== # Install documentation. Unix manpages should go in the $(mandir) # directory. #======================================================================== install-doc: doc $(mkinstalldirs) $(mandir)/man1 $(mkinstalldirs) $(mandir)/man3 $(mkinstalldirs) $(mandir)/mann @echo "Installing documentation in $(mandir)" @for i in $(srcdir)/*.n; \ do \ echo "Installing $$i"; \ rm -f $(mandir)/mann/$$i; \ $(INSTALL_DATA) $$i $(mandir)/mann ; \ done test: binaries libraries ( echo \ pkg_mkIndex . $(vfs_LIB_FILE) \;\ exit; ) | \ $(TCLSH_PROG) TCL_LIBRARY=$(TCL_LIBRARY_DIR) \ LD_LIBRARY_PATH=$(BUILD_DIR):$(TCL_BIN_DIR):$(LD_LIBRARY_PATH) \ TCLLIBPATH=. \ PATH="$(BUILD_DIR)":"$(TCL_BIN_DIR)":"$(PATH)" \ $(TCLSH_PROG) `@CYGPATH@ $(srcdir)/tests/all.tcl` $(TCLTESTARGS) depend: #======================================================================== # Enumerate the names of the object files included in this package. # These objects are created and linked into the final library. In # most cases these object files will correspond to the source files # above. # # $(vfs_LIB_FILE) should be listed as part of the BINARIES variable # at the top of the Makefile. That will ensure that this target is built # when you run "make binaries". # # You shouldn't need to modify this target, except to change the package # name from "VFS" to your package's name. #======================================================================== $(vfs_LIB_FILE): $(vfs_OBJECTS) -rm -f $(vfs_LIB_FILE) @MAKE_LIB@ $(RANLIB) $(vfs_LIB_FILE) #======================================================================== # We need to enumerate the list of .c to .o lines here. # Unfortunately, there does not seem to be any other way to do this # in a Makefile-independent way. We can't use VPATH because it picks up # object files that may be located in the source directory. # # In the following lines, $(srcdir) refers to the toplevel directory # containing your extension. If your sources are in a subdirectory, # you will have to modify the paths to reflect this: # # VFS.$(OBJEXT): $(srcdir)/src/win/VFS.c # $(COMPILE) -c `@CYGPATH@ $(srcdir)/src/win/VFS.c` -o $@ #======================================================================== vfs.$(OBJEXT): $(srcdir)/vfs.c $(COMPILE) -c `@CYGPATH@ $(srcdir)/vfs.c` -o $@ #======================================================================== # End of user-definable section #======================================================================== #======================================================================== # Don't modify the file to clean here. Instead, set the "CLEANFILES" # variable in configure.in #======================================================================== clean: -test -z "$(BINARIES)" || rm -f $(BINARIES) -rm -f *.o core *.core -rm -f *.$(OBJEXT) -test -z "$(CLEANFILES)" || rm -f $(CLEANFILES) distclean: clean -rm -f *.tab.c -rm -f Makefile $(CONFIG_CLEAN_FILES) -rm -f config.cache config.log stamp-h stamp-h[0-9]* -rm -f config.status #======================================================================== # Install binary object libraries. On Windows this includes both .dll and # .lib files. Because the .lib files are not explicitly listed anywhere, # we need to deduce their existence from the .dll file of the same name. # Additionally, the .dll files go into the bin directory, but the .lib # files go into the lib directory. On Unix platforms, all library files # go into the lib directory. In addition, this will generate the pkgIndex.tcl # file in the install location (assuming it can find a usable tclsh8.2 shell) # # You should not have to modify this target. #======================================================================== install-lib-binaries: installdirs @list='$(lib_BINARIES)'; for p in $$list; do \ if test -f $$p; then \ ext=`echo $$p|sed -e "s/.*\.//"`; \ if test "x$$ext" = "xdll"; then \ echo " $(INSTALL_DATA) $$p $(DESTDIR)$(bindir)/$$p"; \ $(INSTALL_DATA) $$p $(DESTDIR)$(bindir)/$$p; \ lib=`basename $$p|sed -e 's/.[^.]*$$//'`.lib; \ if test -f $$lib; then \ echo " $(INSTALL_DATA) $$lib $(DESTDIR)$(libdir)/$$lib"; \ $(INSTALL_DATA) $$lib $(DESTDIR)$(libdir)/$$lib; \ fi; \ else \ echo " $(INSTALL_DATA) $$p $(DESTDIR)$(libdir)/$$p"; \ $(INSTALL_DATA) $$p $(DESTDIR)$(libdir)/$$p; \ fi; \ else :; fi; \ done @list='$(lib_BINARIES)'; for p in $$list; do \ if test -f $$p; then \ echo " $(RANLIB) $(DESTDIR)$(libdir)/$$p"; \ $(RANLIB) $(DESTDIR)$(libdir)/$$p; \ else :; fi; \ done #======================================================================== # Install binary executables (e.g. .exe files) # # You should not have to modify this target. #======================================================================== install-bin-binaries: installdirs @list='$(bin_BINARIES)'; for p in $$list; do \ if test -f $$p; then \ echo " $(INSTALL_DATA) $$p $(DESTDIR)$(bindir)/$$p"; \ $(INSTALL_DATA) $$p $(DESTDIR)$(bindir)/$$p; \ else :; fi; \ done .SUFFIXES: .c .o .obj Makefile: $(srcdir)/Makefile.in $(top_builddir)/config.status cd $(top_builddir) \ && CONFIG_FILES=$@ CONFIG_HEADERS= $(SHELL) ./config.status uninstall-binaries: @$(NORMAL_UNINSTALL) list='$(BINARIES)'; for p in $$list; do \ rm -f $(DESTDIR)$(libdir)/$$p; \ done installdirs: $(mkinstalldirs) $(DESTDIR)$(libdir) $(mkinstalldirs) $(DESTDIR)$(bindir) $(mkinstalldirs) $(DESTDIR)$(pkglibdir) .PHONY: all binaries clean depend distclean doc install installdirs \ libraries test # Tell versions [3.59,3.63) of GNU make to not export all variables. # Otherwise a system limit (for SysV at least) may be exceeded. .NOEXPORT: |
Added README.cygwin.
> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 | The information below is completely out of date. TEA is basically hopeless on Windows, and I do not recommend you wasting your time with it. No-one seems to take any interest in fixing the millions of problems with TEA. There is a good old VC++ makefile in the 'win' directory, which seems to work (I actually have to run it twice, but at least I get a .dll, which is more than TEA provides). ---------------------- To use cygwin for building TEA extensions, there are a couple of things you will need to do. 1. Make sure you have a working Visual C++ (version 5.0 or later) compiler. 2. Download and install the free Cygnus Cywgin full tools package from ftp://go.cygnus.com/pub/sourceware.cygnus.com/pub/cygwin/cygwin-b20/full.exe 3. Create a directory called "C:\bin". Copy the sh.exe program from the cygnus bin directory (C:\cygnus\cygwin-b20\H-i586-cygwin32\bin\sh.exe) to "C:\bin". This will allow you to run shell scripts that use the "#!/bin/sh" invocation. Create another directory called "C:\tmp". The bash.exe program requires this directory for storing temporary files. 4. Set your environment variable "MAKE_MODE" to have the value "UNIX" This will set up the "make" program to operate in a more sane manner. 5. Run vcvars32.bat. You must do this every time you wish to perform a build of an extension. It is strongly recommended that you modify your sytem environment so that you don't have to run vcvars32.bat all the time. If you look in the vcvars32.bat file you will see what system environment variables need to be set in order to make this work. 6. If you are authoring a TEA extension, you will also want the GNU autoconf package. This can be obtained from http://www.gnu.org Autoconf version 2.13 or later is required. |
Added Readme.txt.
> > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 | This is an implementation of a 'vfs' extension (and a 'vfs' package, including a small library of Tcl code). The goal of this extension is to expose Tcl 8.4a3's new filesystem C API to the Tcl level. Since 8.4 is still in alpha, the APIs on which this extension depends may of course change (although this isn't too likely). If that happens, it will of course require changes to this extension, until the point at which 8.4 goes final, when only backwards-compatible changes should occur. The 'zip' vfs package should work (more or less). There is a framework for a 'ftp' vfs package which needs filling in. Using this extension, the editor Alphatk can actually auto-mount, view and edit (but not save, since they're read-only) the contents of .zip files directly (see <http://www.santafe.edu/~vince/Alphatk.html>). The 'tests' directory contains a partially modified version of some of Tcl's core tests. They are modified in that there is a new 'fsIsWritable' test constraint, which needs adding to several hundred tests (I've done some of that work). To install, you probably want to rename the directory 'library' to 'vfs1.0' and place it in your Tcl hierarchy, with the necessary shared library inside. -- Vince Darley, August 1st 2001 |
Added aclocal.m4.
> | 1 | builtin(include,tcl.m4) |
Added configure.in.
> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 | #-------------------------------------------------------------------- # Sample configure.in for Tcl Extensions. The only places you should # need to modify this file are marked by the string __CHANGE__ #-------------------------------------------------------------------- #-------------------------------------------------------------------- # __CHANGE__ # This very first macro is used to verify that the configure script can # find the sources. The argument to AC_INIT should be a unique filename # for this package, and can be a relative path, such as: # # AC_INIT(../generic/tcl.h) #-------------------------------------------------------------------- AC_INIT(vfs.c) #AC_CONFIG_AUX_DIR(config) #CONFIGDIR=${srcdir}/config #AC_SUBST(CONFIGDIR) #-------------------------------------------------------------------- # __CHANGE__ # Set your package name and version numbers here. The NODOT_VERSION is # required for constructing the library name on systems that don't like # dots in library names (Windows). The VERSION variable is used on the # other systems. #-------------------------------------------------------------------- PACKAGE=vfs MAJOR_VERSION=1 MINOR_VERSION=0 PATCHLEVEL= VERSION=${MAJOR_VERSION}.${MINOR_VERSION}${PATCHLEVEL} NODOT_VERSION=${MAJOR_VERSION}${MINOR_VERSION} AC_SUBST(PACKAGE) AC_SUBST(VERSION) #-------------------------------------------------------------------- # We put this here so that you can compile with -DVERSION="1.2" to # encode the package version directly into the source files. #-------------------------------------------------------------------- eval AC_DEFINE_UNQUOTED(VERSION, "${VERSION}") #-------------------------------------------------------------------- # Check whether --enable-gcc or --disable-gcc was given. Do this # before AC_CYGWIN is called so the compiler can # be fully tested by built-in autoconf tools. # This macro also calls AC_PROG_CC to set the compiler if --enable-gcc # was not used. #-------------------------------------------------------------------- SC_ENABLE_GCC AC_PROG_INSTALL #-------------------------------------------------------------------- # Checks to see if the make program sets the $MAKE variable. #-------------------------------------------------------------------- AC_PROG_MAKE_SET #-------------------------------------------------------------------- # Find ranlib #-------------------------------------------------------------------- AC_PROG_RANLIB #-------------------------------------------------------------------- # This macro performs additional compiler tests. #-------------------------------------------------------------------- AC_CYGWIN #-------------------------------------------------------------------- # Determines the correct binary file extension (.o, .obj, .exe etc.) #-------------------------------------------------------------------- AC_OBJEXT AC_EXEEXT #-------------------------------------------------------------------- # "cygpath" is used on windows to generate native path names for include # files. # These variables should only be used with the compiler and linker since # they generate native path names. # # Unix tclConfig.sh points SRC_DIR at the top-level directory of # the Tcl sources, while the Windows tclConfig.sh points SRC_DIR at # the win subdirectory. Hence the different usages of SRC_DIR below. # # This must be done before calling SC_PUBLIC_TCL_HEADERS #-------------------------------------------------------------------- case "`uname -s`" in *win32* | *WIN32* | *CYGWIN_NT*|*CYGWIN_98*|*CYGWIN_95*) CYGPATH="cygpath -w" ;; *) CYGPATH=echo ;; esac AC_SUBST(CYGPATH) #-------------------------------------------------------------------- # Load the tclConfig.sh file #-------------------------------------------------------------------- SC_PATH_TCLCONFIG SC_LOAD_TCLCONFIG #-------------------------------------------------------------------- # __CHANGE__ # Choose which headers you need. Extension authors should try very # hard to only rely on the Tcl public header files. Internal headers # contain private data structures and are subject to change without # notice. # This MUST be called after SC_PATH_TCLCONFIG/SC_LOAD_TCLCONFIG #-------------------------------------------------------------------- SC_PUBLIC_TCL_HEADERS #SC_PRIVATE_TCL_HEADERS #-------------------------------------------------------------------- # __CHANGE__ # A few miscellaneous platform-specific items: # # Define a special symbol for Windows (BUILD_VFS in this case) so # that we create the export library with the dll. See sha1.h on how # to use this. # # Windows creates a few extra files that need to be cleaned up. # You can add more files to clean if your extension creates any extra # files. # # Define any extra compiler flags in the PACKAGE_CFLAGS variable. # These will be appended to the current set of compiler flags for # your system. #-------------------------------------------------------------------- case "`uname -s`" in *win32* | *WIN32* | *CYGWIN_NT*|*CYGWIN_98*|*CYGWIN_95*) AC_DEFINE_UNQUOTED(BUILD_${PACKAGE}) CLEANFILES="*.lib *.dll *.exp *.ilk *.pdb vc50.pch" AC_SUBST(CLEANFILES) ;; *) CLEANFILES= ;; esac #-------------------------------------------------------------------- # Check whether --enable-threads or --disable-threads was given. # So far only Tcl responds to this one. #-------------------------------------------------------------------- SC_ENABLE_THREADS #-------------------------------------------------------------------- # The statement below defines a collection of symbols related to # building as a shared library instead of a static library. #-------------------------------------------------------------------- SC_ENABLE_SHARED #-------------------------------------------------------------------- # This macro figures out what flags to use with the compiler/linker # when building shared/static debug/optimized objects. This information # is all taken from the tclConfig.sh file. #-------------------------------------------------------------------- CFLAGS_DEBUG=${TCL_CFLAGS_DEBUG} CFLAGS_OPTIMIZE=${TCL_CFLAGS_OPTIMIZE} LDFLAGS_DEBUG=${TCL_LDFLAGS_DEBUG} LDFLAGS_OPTIMIZE=${TCL_LDFLAGS_OPTIMIZE} SHLIB_LD=${TCL_SHLIB_LD} STLIB_LD=${TCL_STLIB_LD} SHLIB_CFLAGS=${TCL_SHLIB_CFLAGS} AC_SUBST(CFLAGS_DEBUG) AC_SUBST(CFLAGS_OPTIMIZE) AC_SUBST(STLIB_LD) AC_SUBST(SHLIB_LD) AC_SUBST(SHLIB_CFLAGS) AC_SUBST(SHLIB_LDFLAGS) #-------------------------------------------------------------------- # Set the default compiler switches based on the --enable-symbols # option. #-------------------------------------------------------------------- SC_ENABLE_SYMBOLS if test "${SHARED_BUILD}" = "1" ; then CFLAGS='${CFLAGS_DEFAULT} ${CFLAGS_WARNING} ${SHLIB_CFLAGS}' else CFLAGS='${CFLAGS_DEFAULT} ${CFLAGS_WARNING}' fi #-------------------------------------------------------------------- # Everyone should be linking against the Tcl stub library. If you # can't for some reason, remove this definition. If you aren't using # stubs, you also need to modify the SHLIB_LD_LIBS setting below to # link against the non-stubbed Tcl library. #-------------------------------------------------------------------- AC_DEFINE(USE_TCL_STUBS) #-------------------------------------------------------------------- # This macro generates a line to use when building a library. It # depends on values set by the SC_ENABLE_SHARED, SC_ENABLE_SYMBOLS, # and SC_LOAD_TCLCONFIG macros above. #-------------------------------------------------------------------- SC_MAKE_LIB #-------------------------------------------------------------------- # eval these two values to dereference the ${DBGX} variable. #-------------------------------------------------------------------- eval "SHARED_LIB_SUFFIX=${TCL_SHARED_LIB_SUFFIX}" eval "UNSHARED_LIB_SUFFIX=${TCL_UNSHARED_LIB_SUFFIX}" #-------------------------------------------------------------------- # Shared libraries and static libraries have different names. #-------------------------------------------------------------------- case "`uname -s`" in *win32* | *WIN32* | *CYGWIN_NT*|*CYGWIN_98*|*CYGWIN_95*) if test "${SHARED_BUILD}" = "1" ; then SHLIB_LD_LIBS="\"`cygpath -w ${TCL_BIN_DIR}/${TCL_STUB_LIB_FILE}`\" ${TCL_SHLIB_LD_LIBS}" eval "${PACKAGE}_LIB_FILE=${PACKAGE}${SHARED_LIB_SUFFIX}" RANLIB=: else eval "${PACKAGE}_LIB_FILE=${PACKAGE}${UNSHARED_LIB_SUFFIX}" fi ;; *) if test "${SHARED_BUILD}" = "1" ; then SHLIB_LD_LIBS="${TCL_STUB_LIB_SPEC}" eval "${PACKAGE}_LIB_FILE=lib${PACKAGE}${SHARED_LIB_SUFFIX}" RANLIB=: else eval "${PACKAGE}_LIB_FILE=lib${PACKAGE}${UNSHARED_LIB_SUFFIX}" fi ;; esac AC_SUBST(SHARED_BUILD) #-------------------------------------------------------------------- # __CHANGE__ # Change the name from exampeA_LIB_FILE to match your package name. #-------------------------------------------------------------------- AC_SUBST(vfs_LIB_FILE) AC_SUBST(SHLIB_LD_LIBS) #-------------------------------------------------------------------- # Find tclsh so that we can run pkg_mkIndex to generate the pkgIndex.tcl # file during the install process. Don't run the TCLSH_PROG through # ${CYGPATH} because it's being used directly by make. # Require that we use a tclsh shell version 8.2 or later since earlier # versions have bugs in the pkg_mkIndex routine. #-------------------------------------------------------------------- SC_PROG_TCLSH #-------------------------------------------------------------------- # Finally, substitute all of the various values into the Makefile. #-------------------------------------------------------------------- AC_OUTPUT([Makefile \ mkIndex.tcl]) |
Added generic/vfs.c.
> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 859 860 861 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 930 931 932 933 934 935 936 937 938 939 940 941 942 943 944 945 946 947 948 949 950 951 952 953 954 955 956 957 958 959 960 961 962 963 964 965 966 967 968 969 970 971 972 973 974 975 976 977 978 979 980 981 982 983 984 985 986 987 988 989 990 991 992 993 994 995 996 997 998 999 1000 1001 1002 1003 1004 1005 1006 1007 1008 1009 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080 1081 1082 1083 | /* * vfs.c -- * * This file contains the implementation of the Vfs extension * to Tcl. It provides a script level interface to Tcl's * virtual file system support, and therefore allows * vfs's to be implemented in Tcl. * * Copyright (c) Vince Darley. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include <tcl.h> /* Required to access the 'stat' structure fields */ #include "tclPort.h" /* * Windows needs to know which symbols to export. Unix does not. * BUILD_Vfs should be undefined for Unix. */ #ifdef BUILD_Vfs #undef TCL_STORAGE_CLASS #define TCL_STORAGE_CLASS DLLEXPORT #endif /* BUILD_Vfs */ /* * Only the _Init function is exported. */ EXTERN int Vfs_Init _ANSI_ARGS_((Tcl_Interp*)); /* * Native representation for a path in a Tcl vfs. */ typedef struct VfsNativeRep { int splitPosition; Tcl_Obj* fsCmd; } VfsNativeRep; /* * Structure we use to retain sufficient information about * a channel that we can properly clean up all resources * when the channel is closed. This is required when using * 'open' on things inside the vfs. */ typedef struct VfsChannelCleanupInfo { Tcl_Channel channel; Tcl_Obj* closeCallback; Tcl_Interp* interp; } VfsChannelCleanupInfo; /* * Forward declarations for procedures defined later in this file: */ static int VfsFilesystemObjCmd _ANSI_ARGS_((ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); /* * Now we define the filesystem */ static Tcl_FSStatProc VfsStat; static Tcl_FSAccessProc VfsAccess; static Tcl_FSOpenFileChannelProc VfsOpenFileChannel; static Tcl_FSMatchInDirectoryProc VfsMatchInDirectory; static Tcl_FSDeleteFileProc VfsDeleteFile; static Tcl_FSCreateDirectoryProc VfsCreateDirectory; static Tcl_FSRemoveDirectoryProc VfsRemoveDirectory; static Tcl_FSFileAttrStringsProc VfsFileAttrStrings; static Tcl_FSFileAttrsGetProc VfsFileAttrsGet; static Tcl_FSFileAttrsSetProc VfsFileAttrsSet; static Tcl_FSUtimeProc VfsUtime; static Tcl_FSPathInFilesystemProc VfsInFilesystem; static Tcl_FSFilesystemPathTypeProc VfsFilesystemPathType; static Tcl_FSFilesystemSeparatorProc VfsFilesystemSeparator; static Tcl_FSFreeInternalRepProc VfsFreeInternalRep; static Tcl_FSDupInternalRepProc VfsDupInternalRep; static Tcl_Filesystem vfsFilesystem = { "tclvfs", sizeof(Tcl_Filesystem), TCL_FILESYSTEM_VERSION_1, &VfsInFilesystem, &VfsDupInternalRep, &VfsFreeInternalRep, /* No native to normalized */ NULL, /* No create native rep function */ NULL, /* normalize path isn't needed */ NULL, &VfsFilesystemPathType, &VfsFilesystemSeparator, &VfsStat, &VfsAccess, &VfsOpenFileChannel, &VfsMatchInDirectory, &VfsUtime, /* readlink and listvolumes are not important */ NULL, NULL, &VfsFileAttrStrings, &VfsFileAttrsGet, &VfsFileAttrsSet, &VfsCreateDirectory, &VfsRemoveDirectory, &VfsDeleteFile, /* Use stat for lstat */ NULL, /* No copy file */ NULL, /* No rename file */ NULL, /* No copy directory */ NULL, /* No load, unload */ NULL, NULL, /* We don't need a getcwd or chdir */ NULL, NULL }; /* And some helper procedures */ static VfsNativeRep* VfsGetNativePath(Tcl_Obj* pathObjPtr); static Tcl_CloseProc VfsCloseProc; static void VfsExitProc(ClientData clientData); static Tcl_Obj* VfsCommand(Tcl_Interp* interp, CONST char* cmd, Tcl_Obj * pathPtr); /* * Hard-code platform dependencies. We do not need to worry * about backslash-separators on windows, because a normalized * path will never contain them. */ #ifdef MAC_TCL #define VFS_SEPARATOR ':' #else #define VFS_SEPARATOR '/' #endif /* *---------------------------------------------------------------------- * * Vfs_Init -- * * This procedure is the main initialisation point of the Vfs * extension. * * Results: * Returns a standard Tcl completion code, and leaves an error * message in the interp's result if an error occurs. * * Side effects: * Adds a command to the Tcl interpreter. * *---------------------------------------------------------------------- */ int Vfs_Init(interp) Tcl_Interp *interp; /* Interpreter for application. */ { if (Tcl_InitStubs(interp, "8.4", 0) == NULL) { return TCL_ERROR; } if (Tcl_PkgRequire(interp, "Tcl", "8.4", 0) == NULL) { return TCL_ERROR; } if (Tcl_PkgProvide(interp, "vfs", "1.0") == TCL_ERROR) { return TCL_ERROR; } /* * Create additional commands. */ Tcl_CreateObjCommand(interp, "vfs::filesystem", VfsFilesystemObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); /* Register our filesystem */ Tcl_FSRegister((ClientData)interp, &vfsFilesystem); Tcl_CreateExitHandler(VfsExitProc, (ClientData)NULL); return TCL_OK; } /* *---------------------------------------------------------------------- * * VfsFilesystemObjCmd -- * * This procedure implements the "vfs::filesystem" command. It is * used to (un)register the vfs filesystem, and to mount/unmount * particular interfaces to new filesystems, or to query for * what is mounted where. * * Results: * A standard Tcl result. * * Side effects: * Inserts or removes a filesystem from Tcl's stack. * *---------------------------------------------------------------------- */ static int VfsFilesystemObjCmd(dummy, interp, objc, objv) ClientData dummy; Tcl_Interp *interp; int objc; Tcl_Obj *CONST objv[]; { int index; static char *optionStrings[] = { "info", "mount", "unmount", NULL }; enum options { VFS_INFO, VFS_MOUNT, VFS_UNMOUNT }; if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?"); return TCL_ERROR; } if (Tcl_GetIndexFromObj(interp, objv[1], optionStrings, "option", 0, &index) != TCL_OK) { return TCL_ERROR; } switch ((enum options) index) { case VFS_MOUNT: { Tcl_Obj * path; Tcl_Interp* vfsInterp; if (objc != 4) { Tcl_WrongNumArgs(interp, 1, objv, "mount path cmd"); return TCL_ERROR; } vfsInterp = (Tcl_Interp*) Tcl_FSData(&vfsFilesystem); if (vfsInterp == NULL) { Tcl_SetResult(interp, "vfs not registered", TCL_STATIC); return TCL_ERROR; } path = Tcl_FSGetNormalizedPath(interp, objv[2]); if (Tcl_SetVar2Ex(vfsInterp, "vfs::mount", Tcl_GetString(path), objv[3], TCL_LEAVE_ERR_MSG | TCL_GLOBAL_ONLY) == NULL) { return TCL_ERROR; } break; } case VFS_INFO: { Tcl_Obj * path; Tcl_Interp* vfsInterp; Tcl_Obj * val; if (objc > 3) { Tcl_WrongNumArgs(interp, 2, objv, "path"); return TCL_ERROR; } vfsInterp = (Tcl_Interp*) Tcl_FSData(&vfsFilesystem); if (vfsInterp == NULL) { Tcl_SetResult(interp, "vfs not registered", TCL_STATIC); return TCL_ERROR; } if (objc == 2) { /* List all vfs paths */ Tcl_GlobalEval(interp, "array names ::vfs::mount"); } else { path = Tcl_FSGetNormalizedPath(interp, objv[2]); val = Tcl_GetVar2Ex(vfsInterp, "vfs::mount", Tcl_GetString(path), TCL_LEAVE_ERR_MSG | TCL_GLOBAL_ONLY); if (val == NULL) { return TCL_ERROR; } Tcl_SetObjResult(interp, val); } break; } case VFS_UNMOUNT: { Tcl_Obj * path; Tcl_Interp* vfsInterp; int res; if (objc != 3) { Tcl_WrongNumArgs(interp, 2, objv, "path"); return TCL_ERROR; } vfsInterp = (Tcl_Interp*) Tcl_FSData(&vfsFilesystem); if (vfsInterp == NULL) { Tcl_SetResult(interp, "vfs not registered", TCL_STATIC); return TCL_ERROR; } path = Tcl_FSGetNormalizedPath(interp, objv[2]); res = Tcl_UnsetVar2(vfsInterp, "vfs::mount", Tcl_GetString(path), TCL_LEAVE_ERR_MSG | TCL_GLOBAL_ONLY); return res; } } return TCL_OK; } int VfsInFilesystem(Tcl_Obj *pathPtr, ClientData *clientDataPtr) { Tcl_Obj *normedObj; int len, splitPosition; char *normed; Tcl_Interp* interp; VfsNativeRep *nativeRep; Tcl_Obj* mountCmd = NULL; /* * Even Tcl_FSGetNormalizedPath may fail due to lack of system * encodings, so we just say we can't handle anything if * we are in the middle of the exit sequence. We could * perhaps be more subtle than this! */ if (TclInExit()) { return -1; } interp = (Tcl_Interp*) Tcl_FSData(&vfsFilesystem); if (interp == NULL) { /* This is bad, but not much we can do about it */ return -1; } normedObj = Tcl_FSGetNormalizedPath(interp, pathPtr); if (normedObj == NULL) { return -1; } normed = Tcl_GetStringFromObj(normedObj, &len); splitPosition = len; /* * Find the most specific mount point for this path. * Mount points are specified by unique strings, so * we have to use a unique normalised path for the * checks here. */ while (mountCmd == NULL) { mountCmd = Tcl_GetVar2Ex(interp, "vfs::mount", normed, TCL_GLOBAL_ONLY); if (mountCmd != NULL) break; if (splitPosition != len) { normed[splitPosition] = VFS_SEPARATOR; } while ((splitPosition > 0) && (normed[--splitPosition] != VFS_SEPARATOR)) { /* Do nothing */ } /* Terminate the string there */ if (splitPosition == 0) { break; } normed[splitPosition] = 0; } /* * Now either splitPosition is zero, or we found a mount point. * Test for both possibilities, just to be sure. */ if ((splitPosition == 0) || (mountCmd == NULL)) { return -1; } if (splitPosition != len) { normed[splitPosition] = VFS_SEPARATOR; } nativeRep = (VfsNativeRep*) ckalloc(sizeof(VfsNativeRep)); nativeRep->splitPosition = splitPosition; nativeRep->fsCmd = mountCmd; Tcl_IncrRefCount(nativeRep->fsCmd); *clientDataPtr = (ClientData)nativeRep; return TCL_OK; } VfsNativeRep* VfsGetNativePath(Tcl_Obj* pathObjPtr) { return (VfsNativeRep*) Tcl_FSGetInternalRep(pathObjPtr, &vfsFilesystem); } void VfsFreeInternalRep(ClientData clientData) { VfsNativeRep *nativeRep = (VfsNativeRep*)clientData; if (nativeRep != NULL) { /* Free the command to use on this mount point */ Tcl_DecrRefCount(nativeRep->fsCmd); /* Free the native memory allocation */ ckfree((char*)nativeRep); } } ClientData VfsDupInternalRep(ClientData clientData) { VfsNativeRep *original = (VfsNativeRep*)clientData; VfsNativeRep *nativeRep = (VfsNativeRep*) ckalloc(sizeof(VfsNativeRep)); nativeRep->splitPosition = original->splitPosition; nativeRep->fsCmd = original->fsCmd; Tcl_IncrRefCount(nativeRep->fsCmd); return (ClientData)nativeRep; } Tcl_Obj* VfsFilesystemPathType(Tcl_Obj *pathPtr) { VfsNativeRep* nativeRep = VfsGetNativePath(pathPtr); if (nativeRep == NULL) { return NULL; } else { return nativeRep->fsCmd; } } Tcl_Obj* VfsFilesystemSeparator(Tcl_Obj* pathObjPtr) { return Tcl_NewStringObj("/",1); } int VfsStat(pathPtr, bufPtr) Tcl_Obj *pathPtr; /* Path of file to stat (in current CP). */ struct stat *bufPtr; /* Filled with results of stat call. */ { Tcl_Obj *mountCmd = NULL; Tcl_SavedResult savedResult; int returnVal; Tcl_Interp* interp; interp = (Tcl_Interp*) Tcl_FSData(&vfsFilesystem); mountCmd = VfsCommand(interp, "stat", pathPtr); if (mountCmd == NULL) { return -1; } Tcl_SaveResult(interp, &savedResult); /* Now we execute this mount point's callback. */ returnVal = Tcl_EvalObjEx(interp, mountCmd, TCL_EVAL_GLOBAL | TCL_EVAL_DIRECT); if (returnVal == TCL_OK) { int statListLength; Tcl_Obj* resPtr = Tcl_GetObjResult(interp); if (Tcl_ListObjLength(interp, resPtr, &statListLength) == TCL_ERROR) { returnVal = TCL_ERROR; } else if (statListLength & 1) { /* It is odd! */ returnVal = TCL_ERROR; } else { /* * The st_mode field is set part by the 'mode' * and part by the 'type' stat fields. */ bufPtr->st_mode = 0; while (statListLength > 0) { Tcl_Obj *field, *val; char *fieldName; statListLength -= 2; Tcl_ListObjIndex(interp, resPtr, statListLength, &field); Tcl_ListObjIndex(interp, resPtr, statListLength+1, &val); fieldName = Tcl_GetString(field); if (!strcmp(fieldName,"dev")) { long v; if (Tcl_GetLongFromObj(interp, val, &v) != TCL_OK) { returnVal = TCL_ERROR; break; } bufPtr->st_dev = v; } else if (!strcmp(fieldName,"ino")) { long v; if (Tcl_GetLongFromObj(interp, val, &v) != TCL_OK) { returnVal = TCL_ERROR; break; } bufPtr->st_ino = (unsigned short)v; } else if (!strcmp(fieldName,"mode")) { int v; if (Tcl_GetIntFromObj(interp, val, &v) != TCL_OK) { returnVal = TCL_ERROR; break; } bufPtr->st_mode |= v; } else if (!strcmp(fieldName,"nlink")) { long v; if (Tcl_GetLongFromObj(interp, val, &v) != TCL_OK) { returnVal = TCL_ERROR; break; } bufPtr->st_nlink = (short)v; } else if (!strcmp(fieldName,"uid")) { long v; if (Tcl_GetLongFromObj(interp, val, &v) != TCL_OK) { returnVal = TCL_ERROR; break; } bufPtr->st_uid = (short)v; } else if (!strcmp(fieldName,"gid")) { long v; if (Tcl_GetLongFromObj(interp, val, &v) != TCL_OK) { returnVal = TCL_ERROR; break; } bufPtr->st_gid = (short)v; } else if (!strcmp(fieldName,"size")) { long v; if (Tcl_GetLongFromObj(interp, val, &v) != TCL_OK) { returnVal = TCL_ERROR; break; } bufPtr->st_size = v; } else if (!strcmp(fieldName,"atime")) { long v; if (Tcl_GetLongFromObj(interp, val, &v) != TCL_OK) { returnVal = TCL_ERROR; break; } bufPtr->st_atime = v; } else if (!strcmp(fieldName,"mtime")) { long v; if (Tcl_GetLongFromObj(interp, val, &v) != TCL_OK) { returnVal = TCL_ERROR; break; } bufPtr->st_mtime = v; } else if (!strcmp(fieldName,"ctime")) { long v; if (Tcl_GetLongFromObj(interp, val, &v) != TCL_OK) { returnVal = TCL_ERROR; break; } bufPtr->st_ctime = v; } else if (!strcmp(fieldName,"type")) { char *str; str = Tcl_GetString(val); if (!strcmp(str,"directory")) { bufPtr->st_mode |= S_IFDIR; } else if (!strcmp(str,"file")) { bufPtr->st_mode |= S_IFREG; } else { /* * Do nothing. This means we do not currently * support anything except files and directories */ } } else { /* Ignore additional stat arguments */ } } } } Tcl_RestoreResult(interp, &savedResult); Tcl_DecrRefCount(mountCmd); if (returnVal != 0) { Tcl_SetErrno(ENOENT); return -1; } else { return returnVal; } } int VfsAccess(pathPtr, mode) Tcl_Obj *pathPtr; /* Path of file to access (in current CP). */ int mode; /* Permission setting. */ { Tcl_Obj *mountCmd = NULL; Tcl_SavedResult savedResult; int returnVal; Tcl_Interp* interp; interp = (Tcl_Interp*) Tcl_FSData(&vfsFilesystem); mountCmd = VfsCommand(interp, "access", pathPtr); if (mountCmd == NULL) { return -1; } Tcl_ListObjAppendElement(interp, mountCmd, Tcl_NewIntObj(mode)); /* Now we execute this mount point's callback. */ Tcl_SaveResult(interp, &savedResult); returnVal = Tcl_EvalObjEx(interp, mountCmd, TCL_EVAL_GLOBAL | TCL_EVAL_DIRECT); Tcl_RestoreResult(interp, &savedResult); Tcl_DecrRefCount(mountCmd); if (returnVal != 0) { Tcl_SetErrno(ENOENT); return -1; } else { return returnVal; } } Tcl_Channel VfsOpenFileChannel(cmdInterp, pathPtr, modeString, permissions) Tcl_Interp *cmdInterp; /* Interpreter for error reporting; * can be NULL. */ Tcl_Obj *pathPtr; /* Name of file to open. */ char *modeString; /* A list of POSIX open modes or * a string such as "rw". */ int permissions; /* If the open involves creating a * file, with what modes to create * it? */ { Tcl_Channel chan = NULL; VfsChannelCleanupInfo *channelRet = NULL; Tcl_Obj *mountCmd = NULL; Tcl_SavedResult savedResult; int returnVal; Tcl_Interp* interp; interp = (Tcl_Interp*) Tcl_FSData(&vfsFilesystem); mountCmd = VfsCommand(interp, "open", pathPtr); if (mountCmd == NULL) { return NULL; } Tcl_ListObjAppendElement(interp, mountCmd, Tcl_NewStringObj(modeString,-1)); Tcl_ListObjAppendElement(interp, mountCmd, Tcl_NewIntObj(permissions)); Tcl_SaveResult(interp, &savedResult); /* Now we execute this mount point's callback. */ returnVal = Tcl_EvalObjEx(interp, mountCmd, TCL_EVAL_GLOBAL | TCL_EVAL_DIRECT); if (returnVal == TCL_OK) { int reslen; Tcl_Obj *resultObj; /* * There may be file channel leaks on these two * error conditions, if the open command actually * created a channel, but then passed us a bogus list. */ resultObj = Tcl_GetObjResult(interp); if ((Tcl_ListObjLength(interp, resultObj, &reslen) == TCL_ERROR) || (reslen > 2) || (reslen == 0)) { returnVal = TCL_ERROR; } else { Tcl_Obj *element; Tcl_Channel theChannel = NULL; Tcl_ListObjIndex(interp, resultObj, 0, &element); theChannel = Tcl_GetChannel(interp, Tcl_GetString(element), 0); if (theChannel == NULL) { returnVal == TCL_ERROR; } else { channelRet = (VfsChannelCleanupInfo*) ckalloc(sizeof(VfsChannelCleanupInfo)); channelRet->channel = theChannel; if (reslen == 2) { Tcl_ListObjIndex(interp, resultObj, 1, &element); channelRet->closeCallback = element; Tcl_IncrRefCount(channelRet->closeCallback); channelRet->interp = interp; } else { channelRet->closeCallback = NULL; channelRet->interp = NULL; } } } } else { /* * Copy over the error message to cmdInterp, duplicating it in * case of threading issues. */ Tcl_SetObjResult(cmdInterp, Tcl_DuplicateObj(Tcl_GetObjResult(interp))); } Tcl_RestoreResult(interp, &savedResult); Tcl_DecrRefCount(mountCmd); if (channelRet != NULL) { /* * This is a pain. We got the Channel from some Tcl code. * This means it was registered with the interpreter. But we * want a pristine channel which hasn't been registered with * anyone. We use Tcl_DetachChannel to do this for us. */ chan = channelRet->channel; /* We must use the correct interpreter, not our own 'vfs' interpreter */ Tcl_DetachChannel(channelRet->interp, chan); if (channelRet->closeCallback != NULL) { Tcl_CreateCloseHandler(chan, &VfsCloseProc, (ClientData)channelRet); /* The channelRet structure will be freed in the callback */ } else { ckfree((char*)channelRet); } } return chan; } /* * IMPORTANT: This procedure must *not* modify the interpreter's result * this leads to the objResultPtr being corrupted (somehow), and curious * crashes in the future (which are very hard to debug ;-). */ void VfsCloseProc(ClientData clientData) { VfsChannelCleanupInfo * channelRet = (VfsChannelCleanupInfo*) clientData; Tcl_SavedResult savedResult; Tcl_Channel chan = channelRet->channel; Tcl_Interp * interp = channelRet->interp; Tcl_SaveResult(interp, &savedResult); /* * The interpreter needs to know about the channel, else the Tcl * callback will fail, so we register the channel (this allows * the Tcl code to use the channel's string-name). */ Tcl_RegisterChannel(interp, chan); Tcl_EvalObjEx(interp, channelRet->closeCallback, TCL_EVAL_GLOBAL | TCL_EVAL_DIRECT); Tcl_DecrRefCount(channelRet->closeCallback); /* * More complications; we can't just unregister the channel, * because it is in the middle of being cleaned up, and the cleanup * code doesn't like a channel to be closed again while it is * already being closed. So, we do the same trick as above to * unregister it without cleanup. */ Tcl_DetachChannel(interp, chan); Tcl_RestoreResult(interp, &savedResult); ckfree((char*)channelRet); } int VfsMatchInDirectory( Tcl_Interp *cmdInterp, /* Interpreter to receive results. */ Tcl_Obj *returnPtr, /* Interpreter to receive results. */ Tcl_Obj *dirPtr, /* Contains path to directory to search. */ char *pattern, /* Pattern to match against. */ Tcl_GlobTypeData *types) /* Object containing list of acceptable types. * May be NULL. */ { Tcl_Obj *mountCmd = NULL; Tcl_SavedResult savedResult; int returnVal; Tcl_Interp* interp; int type = 0; Tcl_Obj *vfsResultPtr = NULL; interp = (Tcl_Interp*) Tcl_FSData(&vfsFilesystem); mountCmd = VfsCommand(interp, "matchindirectory", dirPtr); if (mountCmd == NULL) { return -1; } if (types != NULL) { type = types->type; } Tcl_ListObjAppendElement(interp, mountCmd, Tcl_NewStringObj(pattern,-1)); Tcl_ListObjAppendElement(interp, mountCmd, Tcl_NewIntObj(type)); Tcl_SaveResult(interp, &savedResult); /* Now we execute this mount point's callback. */ returnVal = Tcl_EvalObjEx(interp, mountCmd, TCL_EVAL_GLOBAL | TCL_EVAL_DIRECT); if (returnVal != -1) { vfsResultPtr = Tcl_DuplicateObj(Tcl_GetObjResult(interp)); } Tcl_RestoreResult(interp, &savedResult); Tcl_DecrRefCount(mountCmd); if (vfsResultPtr != NULL) { if (returnVal == TCL_OK) { Tcl_ListObjAppendList(cmdInterp, returnPtr, vfsResultPtr); } else { Tcl_SetObjResult(cmdInterp, vfsResultPtr); } } return returnVal; } int VfsDeleteFile( Tcl_Obj *pathPtr) /* Pathname of file to be removed (UTF-8). */ { Tcl_Obj *mountCmd = NULL; Tcl_SavedResult savedResult; int returnVal; Tcl_Interp* interp; interp = (Tcl_Interp*) Tcl_FSData(&vfsFilesystem); mountCmd = VfsCommand(interp, "deletefile", pathPtr); if (mountCmd == NULL) { return -1; } /* Now we execute this mount point's callback. */ Tcl_SaveResult(interp, &savedResult); returnVal = Tcl_EvalObjEx(interp, mountCmd, TCL_EVAL_GLOBAL | TCL_EVAL_DIRECT); Tcl_RestoreResult(interp, &savedResult); Tcl_DecrRefCount(mountCmd); return returnVal; } int VfsCreateDirectory( Tcl_Obj *pathPtr) /* Pathname of directory to create (UTF-8). */ { Tcl_Obj *mountCmd = NULL; Tcl_SavedResult savedResult; int returnVal; Tcl_Interp* interp; interp = (Tcl_Interp*) Tcl_FSData(&vfsFilesystem); mountCmd = VfsCommand(interp, "createdirectory", pathPtr); if (mountCmd == NULL) { return -1; } /* Now we execute this mount point's callback. */ Tcl_SaveResult(interp, &savedResult); returnVal = Tcl_EvalObjEx(interp, mountCmd, TCL_EVAL_GLOBAL | TCL_EVAL_DIRECT); Tcl_RestoreResult(interp, &savedResult); Tcl_DecrRefCount(mountCmd); return returnVal; } int VfsRemoveDirectory( Tcl_Obj *pathPtr, /* Pathname of directory to be removed * (UTF-8). */ int recursive, /* If non-zero, removes directories that * are nonempty. Otherwise, will only remove * empty directories. */ Tcl_Obj **errorPtr) /* Location to store name of file * causing error. */ { Tcl_Obj *mountCmd = NULL; Tcl_SavedResult savedResult; int returnVal; Tcl_Interp* interp; interp = (Tcl_Interp*) Tcl_FSData(&vfsFilesystem); mountCmd = VfsCommand(interp, "removedirectory", pathPtr); if (mountCmd == NULL) { return -1; } Tcl_ListObjAppendElement(interp, mountCmd, Tcl_NewIntObj(recursive)); /* Now we execute this mount point's callback. */ Tcl_SaveResult(interp, &savedResult); returnVal = Tcl_EvalObjEx(interp, mountCmd, TCL_EVAL_GLOBAL | TCL_EVAL_DIRECT); Tcl_RestoreResult(interp, &savedResult); Tcl_DecrRefCount(mountCmd); if (returnVal == TCL_ERROR) { /* Assume there was a problem with the directory being non-empty */ if (errorPtr != NULL) { *errorPtr = pathPtr; } Tcl_SetErrno(EEXIST); } return returnVal; } char** VfsFileAttrStrings(pathPtr, objPtrRef) Tcl_Obj* pathPtr; Tcl_Obj** objPtrRef; { Tcl_Obj *mountCmd = NULL; Tcl_SavedResult savedResult; int returnVal; Tcl_Interp* interp; interp = (Tcl_Interp*) Tcl_FSData(&vfsFilesystem); mountCmd = VfsCommand(interp, "fileattributes", pathPtr); if (mountCmd == NULL) { *objPtrRef = NULL; return NULL; } Tcl_SaveResult(interp, &savedResult); /* Now we execute this mount point's callback. */ returnVal = Tcl_EvalObjEx(interp, mountCmd, TCL_EVAL_GLOBAL | TCL_EVAL_DIRECT); if (returnVal == TCL_OK) { *objPtrRef = Tcl_DuplicateObj(Tcl_GetObjResult(interp)); } else { *objPtrRef = NULL; } Tcl_RestoreResult(interp, &savedResult); Tcl_DecrRefCount(mountCmd); return NULL; } int VfsFileAttrsGet(cmdInterp, index, pathPtr, objPtrRef) Tcl_Interp *cmdInterp; /* The interpreter for error reporting. */ int index; /* index of the attribute command. */ Tcl_Obj *pathPtr; /* filename we are operating on. */ Tcl_Obj **objPtrRef; /* for output. */ { Tcl_Obj *mountCmd = NULL; Tcl_SavedResult savedResult; int returnVal; Tcl_Interp* interp; interp = (Tcl_Interp*) Tcl_FSData(&vfsFilesystem); mountCmd = VfsCommand(interp, "fileattributes", pathPtr); if (mountCmd == NULL) { return -1; } Tcl_ListObjAppendElement(interp, mountCmd, Tcl_NewIntObj(index)); Tcl_SaveResult(interp, &savedResult); /* Now we execute this mount point's callback. */ returnVal = Tcl_EvalObjEx(interp, mountCmd, TCL_EVAL_GLOBAL | TCL_EVAL_DIRECT); if (returnVal != -1) { *objPtrRef = Tcl_DuplicateObj(Tcl_GetObjResult(interp)); } Tcl_RestoreResult(interp, &savedResult); Tcl_DecrRefCount(mountCmd); if (returnVal != -1) { if (returnVal == TCL_OK) { Tcl_IncrRefCount(*objPtrRef); } else { /* Leave error message in correct interp */ Tcl_SetObjResult(cmdInterp, *objPtrRef); *objPtrRef = NULL; } } return returnVal; } int VfsFileAttrsSet(cmdInterp, index, pathPtr, objPtr) Tcl_Interp *cmdInterp; /* The interpreter for error reporting. */ int index; /* index of the attribute command. */ Tcl_Obj *pathPtr; /* filename we are operating on. */ Tcl_Obj *objPtr; /* for input. */ { Tcl_Obj *mountCmd = NULL; Tcl_SavedResult savedResult; int returnVal; Tcl_Interp* interp; Tcl_Obj *errorPtr = NULL; interp = (Tcl_Interp*) Tcl_FSData(&vfsFilesystem); mountCmd = VfsCommand(interp, "fileattributes", pathPtr); if (mountCmd == NULL) { return -1; } Tcl_ListObjAppendElement(interp, mountCmd, Tcl_NewIntObj(index)); Tcl_ListObjAppendElement(interp, mountCmd, objPtr); Tcl_SaveResult(interp, &savedResult); /* Now we execute this mount point's callback. */ returnVal = Tcl_EvalObjEx(interp, mountCmd, TCL_EVAL_GLOBAL | TCL_EVAL_DIRECT); if (returnVal != -1 && returnVal != TCL_OK) { errorPtr = Tcl_DuplicateObj(Tcl_GetObjResult(interp)); } Tcl_RestoreResult(interp, &savedResult); Tcl_DecrRefCount(mountCmd); if (errorPtr != NULL) { /* * Leave error message in correct interp, errorPtr was * duplicated above, in case of threading issues. */ Tcl_SetObjResult(cmdInterp, errorPtr); } return returnVal; } int VfsUtime(pathPtr, tval) Tcl_Obj* pathPtr; struct utimbuf *tval; { Tcl_Obj *mountCmd = NULL; Tcl_SavedResult savedResult; int returnVal; Tcl_Interp* interp; interp = (Tcl_Interp*) Tcl_FSData(&vfsFilesystem); mountCmd = VfsCommand(interp, "utime", pathPtr); if (mountCmd == NULL) { return -1; } Tcl_ListObjAppendElement(interp, mountCmd, Tcl_NewLongObj(tval->actime)); Tcl_ListObjAppendElement(interp, mountCmd, Tcl_NewLongObj(tval->modtime)); /* Now we execute this mount point's callback. */ Tcl_SaveResult(interp, &savedResult); returnVal = Tcl_EvalObjEx(interp, mountCmd, TCL_EVAL_GLOBAL | TCL_EVAL_DIRECT); Tcl_RestoreResult(interp, &savedResult); Tcl_DecrRefCount(mountCmd); return returnVal; } /* *---------------------------------------------------------------------- * * VfsCommand -- * * Build a portion of a command to be evaluated in Tcl. * * Results: * Returns a list containing the command, or NULL if an * error occurred. * * Side effects: * None except memory allocation. * *---------------------------------------------------------------------- */ static Tcl_Obj* VfsCommand(Tcl_Interp* interp, CONST char* cmd, Tcl_Obj * pathPtr) { Tcl_Obj *normed; Tcl_Obj *mountCmd; int len; int splitPosition; int dummyLen; int returnVal; VfsNativeRep *nativeRep; char *normedString; nativeRep = VfsGetNativePath(pathPtr); if (nativeRep == NULL) { return NULL; } splitPosition = nativeRep->splitPosition; normed = Tcl_FSGetNormalizedPath(interp, pathPtr); normedString = Tcl_GetStringFromObj(normed, &len); mountCmd = Tcl_DuplicateObj(nativeRep->fsCmd); Tcl_IncrRefCount(mountCmd); if (Tcl_ListObjLength(interp, mountCmd, &dummyLen) == TCL_ERROR) { Tcl_DecrRefCount(mountCmd); return NULL; } Tcl_ListObjAppendElement(interp, mountCmd, Tcl_NewStringObj(cmd,-1)); if (splitPosition == len) { Tcl_ListObjAppendElement(interp, mountCmd, normed); Tcl_ListObjAppendElement(interp, mountCmd, Tcl_NewStringObj("",0)); } else { Tcl_ListObjAppendElement(interp, mountCmd, Tcl_NewStringObj(normedString,splitPosition)); Tcl_ListObjAppendElement(interp, mountCmd, Tcl_NewStringObj(normedString+splitPosition+1, len-splitPosition-1)); } Tcl_ListObjAppendElement(interp, mountCmd, pathPtr); return mountCmd; } static void VfsExitProc(ClientData clientData) { Tcl_FSUnregister(&vfsFilesystem); } |
Added install-sh.
> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 | #!/bin/sh # # install - install a program, script, or datafile # This comes from X11R5; it is not part of GNU. # # $XConsortium: install.sh,v 1.2 89/12/18 14:47:22 jim Exp $ # # This script is compatible with the BSD install script, but was written # from scratch. # # set DOITPROG to echo to test this script # Don't use :- since 4.3BSD and earlier shells don't like it. doit="${DOITPROG-}" # put in absolute paths if you don't have them in your path; or use env. vars. mvprog="${MVPROG-mv}" cpprog="${CPPROG-cp}" chmodprog="${CHMODPROG-chmod}" chownprog="${CHOWNPROG-chown}" chgrpprog="${CHGRPPROG-chgrp}" stripprog="${STRIPPROG-strip}" rmprog="${RMPROG-rm}" instcmd="$mvprog" chmodcmd="" chowncmd="" chgrpcmd="" stripcmd="" rmcmd="$rmprog -f" mvcmd="$mvprog" src="" dst="" while [ x"$1" != x ]; do case $1 in -c) instcmd="$cpprog" shift continue;; -m) chmodcmd="$chmodprog $2" shift shift continue;; -o) chowncmd="$chownprog $2" shift shift continue;; -g) chgrpcmd="$chgrpprog $2" shift shift continue;; -s) stripcmd="$stripprog" shift continue;; *) if [ x"$src" = x ] then src=$1 else dst=$1 fi shift continue;; esac done if [ x"$src" = x ] then echo "install: no input file specified" exit 1 fi if [ x"$dst" = x ] then echo "install: no destination specified" exit 1 fi # If destination is a directory, append the input filename; if your system # does not like double slashes in filenames, you may need to add some logic if [ -d $dst ] then dst="$dst"/`basename $src` fi # Make a temp file name in the proper directory. dstdir=`dirname $dst` dsttmp=$dstdir/#inst.$$# # Move or copy the file name to the temp name $doit $instcmd $src $dsttmp # and set any options; do chmod last to preserve setuid bits if [ x"$chowncmd" != x ]; then $doit $chowncmd $dsttmp; fi if [ x"$chgrpcmd" != x ]; then $doit $chgrpcmd $dsttmp; fi if [ x"$stripcmd" != x ]; then $doit $stripcmd $dsttmp; fi if [ x"$chmodcmd" != x ]; then $doit $chmodcmd $dsttmp; fi # Now rename the file to the real destination. $doit $rmcmd $dst $doit $mvcmd $dsttmp $dst exit 0 |
Added library/ftpvfs.tcl.
> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 | package require vfs 1.0 package require ftp namespace eval vfs::ftp {} proc vfs::ftp::Mount {dirurl local} { regexp {(([^:]*)(:([^@]*))?@)?([^/]*)/(.*/)?([^/]*)$} $dirurl \ junk junk user junk pass host path file set fd [::ftp::Open $host $user $pass $path] ::ftp::Cd $fd $path puts "ftp $host, $path mounted at $fd" vfs::filesystem mount $local [list vfs::ftp::handler $fd $path] return $fd } proc vfs::ftp::Unmount {fd} { ::ftp::Close $fd } proc vfs::ftp::handler {fd path cmd root relative actualpath args} { eval [list $cmd $fd $path $relative] $args } # If we implement the commands below, we will have a perfect # virtual file system for remote ftp sites. proc vfs::ftp::stat {fd path name} { puts "stat $name" } proc vfs::ftp::access {fd path name mode} { puts "access $name $mode" } proc vfs::ftp::open {fd name mode permissions} { puts "open $name $mode $permissions" # return a list of two elements: # 1. first element is the Tcl channel name which has been opened # 2. second element (optional) is a command to evaluate when # the channel is closed. return [list] } proc vfs::ftp::matchindirectory {fd prefix path pattern type} { puts "matchindirectory $path $pattern $type" set ftpList [ftp::List $fd $path] puts "ftpList: $ftpList" set res [list] if {[::vfs::matchDirectories $type]} { # add matching directories to $res } if {[::vfs::matchFiles $type]} { # add matching files to $res } return $res } proc vfs::ftp::createdirectory {fd name} { puts "createdirectory $name" } proc vfs::ftp::removedirectory {fd name} { puts "removedirectory $name" } proc vfs::ftp::deletefile {fd name} { puts "deletefile $name" } proc vfs::ftp::fileattributes {fd path args} { puts "fileattributes $args" switch -- [llength $args] { 0 { # list strings return [list] } 1 { # get value set index [lindex $args 0] } 2 { # set value set index [lindex $args 0] set val [lindex $args 1] } } } |
Added library/pkgIndex.tcl.
> > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 | # Tcl package index file, version 1.1 # This file is generated by the "pkg_mkIndex" command # and sourced either when an application starts up or # by a "package unknown" script. It invokes the # "package ifneeded" command to set up package-related # information so that packages will be loaded automatically # in response to "package require" commands. When this # script is sourced, the variable $dir must contain the # full path name of this file's directory. lappend auto_path $dir package ifneeded vfs 1.0 [list load [file join $dir vfs10[info sharedlibextension]]] |
Added library/tclIndex.
> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 | # Tcl autoload index file, version 2.0 # This file is generated by the "auto_mkindex" command # and sourced to set up indexing information for one or # more commands. Typically each line is a command that # sets an element in the auto_index array, where the # element name is the name of a command and the value is # a script that loads the command. set auto_index(::vfs::ftp::Mount) [list source [file join $dir ftpvfs.tcl]] set auto_index(::vfs::ftp::Unmount) [list source [file join $dir ftpvfs.tcl]] set auto_index(::vfs::ftp::handler) [list source [file join $dir ftpvfs.tcl]] set auto_index(::vfs::ftp::stat) [list source [file join $dir ftpvfs.tcl]] set auto_index(::vfs::ftp::access) [list source [file join $dir ftpvfs.tcl]] set auto_index(::vfs::ftp::open) [list source [file join $dir ftpvfs.tcl]] set auto_index(::vfs::ftp::matchindirectory) [list source [file join $dir ftpvfs.tcl]] set auto_index(::vfs::ftp::createdirectory) [list source [file join $dir ftpvfs.tcl]] set auto_index(::vfs::ftp::removedirectory) [list source [file join $dir ftpvfs.tcl]] set auto_index(::vfs::ftp::deletefile) [list source [file join $dir ftpvfs.tcl]] set auto_index(::vfs::ftp::fileattributes) [list source [file join $dir ftpvfs.tcl]] set auto_index(::vfs::tclproc::Mount) [list source [file join $dir tclprocvfs.tcl]] set auto_index(::vfs::tclproc::Unmount) [list source [file join $dir tclprocvfs.tcl]] set auto_index(::vfs::tclproc::handler) [list source [file join $dir tclprocvfs.tcl]] set auto_index(::vfs::tclproc::stat) [list source [file join $dir tclprocvfs.tcl]] set auto_index(::vfs::tclproc::access) [list source [file join $dir tclprocvfs.tcl]] set auto_index(::vfs::tclproc::exists) [list source [file join $dir tclprocvfs.tcl]] set auto_index(::vfs::tclproc::open) [list source [file join $dir tclprocvfs.tcl]] set auto_index(::vfs::tclproc::matchindirectory) [list source [file join $dir tclprocvfs.tcl]] set auto_index(::vfs::tclproc::createdirectory) [list source [file join $dir tclprocvfs.tcl]] set auto_index(::vfs::tclproc::removedirectory) [list source [file join $dir tclprocvfs.tcl]] set auto_index(::vfs::tclproc::deletefile) [list source [file join $dir tclprocvfs.tcl]] set auto_index(::vfs::tclproc::fileattributes) [list source [file join $dir tclprocvfs.tcl]] set auto_index(::vfs::testMount) [list source [file join $dir testvfs.tcl]] set auto_index(::vfs::test::handler) [list source [file join $dir testvfs.tcl]] set auto_index(::vfs::test::stat) [list source [file join $dir testvfs.tcl]] set auto_index(::vfs::test::access) [list source [file join $dir testvfs.tcl]] set auto_index(::vfs::test::open) [list source [file join $dir testvfs.tcl]] set auto_index(::vfs::test::matchindirectory) [list source [file join $dir testvfs.tcl]] set auto_index(::vfs::test::createdirectory) [list source [file join $dir testvfs.tcl]] set auto_index(::vfs::test::removedirectory) [list source [file join $dir testvfs.tcl]] set auto_index(::vfs::test::deletefile) [list source [file join $dir testvfs.tcl]] set auto_index(::vfs::test::fileattributes) [list source [file join $dir testvfs.tcl]] set auto_index(::vfs::autoMountExtension) [list source [file join $dir vfsUtils.tcl]] set auto_index(::vfs::autoMountUrl) [list source [file join $dir vfsUtils.tcl]] set auto_index(::vfs::haveMount) [list source [file join $dir vfsUtils.tcl]] set auto_index(::vfs::urlMount) [list source [file join $dir vfsUtils.tcl]] set auto_index(::vfs::fileUrlMount) [list source [file join $dir vfsUtils.tcl]] set auto_index(::vfs::auto) [list source [file join $dir vfsUtils.tcl]] set auto_index(::vfs::matchCorrectTypes) [list source [file join $dir vfsUtils.tcl]] set auto_index(::vfs::accessMode) [list source [file join $dir vfsUtils.tcl]] set auto_index(::vfs::matchDirectories) [list source [file join $dir vfsUtils.tcl]] set auto_index(::vfs::matchFiles) [list source [file join $dir vfsUtils.tcl]] set auto_index(::vfs::modeToString) [list source [file join $dir vfsUtils.tcl]] set auto_index(::vfs::zip::Mount) [list source [file join $dir zipvfs.tcl]] set auto_index(::vfs::zip::Unmount) [list source [file join $dir zipvfs.tcl]] set auto_index(::vfs::zip::handler) [list source [file join $dir zipvfs.tcl]] set auto_index(::vfs::zip::matchindirectory) [list source [file join $dir zipvfs.tcl]] set auto_index(::vfs::zip::stat) [list source [file join $dir zipvfs.tcl]] set auto_index(::vfs::zip::access) [list source [file join $dir zipvfs.tcl]] set auto_index(::vfs::zip::open) [list source [file join $dir zipvfs.tcl]] set auto_index(::vfs::zip::createdirectory) [list source [file join $dir zipvfs.tcl]] set auto_index(::vfs::zip::removedirectory) [list source [file join $dir zipvfs.tcl]] set auto_index(::vfs::zip::deletefile) [list source [file join $dir zipvfs.tcl]] set auto_index(::vfs::zip::fileattributes) [list source [file join $dir zipvfs.tcl]] set auto_index(::zip::u_short) [list source [file join $dir zipvfs.tcl]] set auto_index(::zip::DosTime) [list source [file join $dir zipvfs.tcl]] set auto_index(::zip::Data) [list source [file join $dir zipvfs.tcl]] set auto_index(::zip::EndOfArchive) [list source [file join $dir zipvfs.tcl]] set auto_index(::zip::TOC) [list source [file join $dir zipvfs.tcl]] set auto_index(::zip::open) [list source [file join $dir zipvfs.tcl]] set auto_index(::zip::FAKEDIR) [list source [file join $dir zipvfs.tcl]] set auto_index(::zip::exists) [list source [file join $dir zipvfs.tcl]] set auto_index(::zip::stat) [list source [file join $dir zipvfs.tcl]] set auto_index(::zip::getdir) [list source [file join $dir zipvfs.tcl]] set auto_index(::zip::_close) [list source [file join $dir zipvfs.tcl]] |
Added library/tclprocvfs.tcl.
> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 | package require vfs 1.0 # Thanks to jcw for the idea here. This is a 'file system' which # is actually a representation of the Tcl command namespace hierarchy. # Namespaces are directories, and procedures are files. Tcl allows # procedures with the same name as a namespace, which are hidden in # a filesystem representation. namespace eval vfs::tclproc {} proc vfs::tclproc::Mount {ns local} { if {![namespace exists ::$ns]} { error "No such namespace" } puts "tclproc $ns mounted at $local" vfs::filesystem mount $local [list vfs::tclproc::handler $ns] } proc vfs::tclproc::Unmount {ns} { } proc vfs::tclproc::handler {ns cmd root relative actualpath args} { regsub -all / $relative :: relative if {$cmd == "matchindirectory"} { eval [list $cmd $ns $relative $actualpath] $args } else { eval [list $cmd $ns $relative] $args } } # If we implement the commands below, we will have a perfect # virtual file system for remote tclproc sites. proc vfs::tclproc::stat {ns name} { puts stderr "stat $name" if {[namespace exists ::${ns}::${name}]} { puts "directory" return [list type directory size 0 mode 0777 \ ino -1 depth 0 name $name atime 0 ctime 0 mtime 0 dev -1 \ uid -1 gid -1 nlink 1] } elseif {[llength [info procs ::${ns}::${name}]]} { puts "file" return [list type file] } else { return -code error "could not read \"$name\": no such file or directory" } } proc vfs::tclproc::access {ns name mode} { puts stderr "access $name $mode" if {[namespace exists ::${ns}::${name}]} { return 1 } elseif {[llength [info procs ::${ns}::${name}]]} { if {$mode & 2} { error "read-only" } return 1 } else { error "No such file" } } proc vfs::tclproc::exists {ns name} { if {[namespace exists ::${ns}::${name}]} { return 1 } elseif {[llength [info procs ::${ns}::${name}]]} { return 1 } else { return 0 } } proc vfs::tclproc::open {ns name mode permissions} { puts stderr "open $name $mode $permissions" # return a list of two elements: # 1. first element is the Tcl channel name which has been opened # 2. second element (optional) is a command to evaluate when # the channel is closed. switch -- $mode { "" - "r" { package require Memchan set nfd [memchan] fconfigure $nfd -translation binary puts -nonewline $nfd [_generate ::${ns}::${name}] fconfigure $nfd -translation auto seek $nfd 0 return [list $nfd] } default { return -code error "illegal access mode \"$mode\"" } } } proc vfs::tclproc::_generate {p} { lappend a proc $p set argslist [list] foreach arg [info args $p] { if {[info default $p $arg v]} { lappend argslist [list $arg $v] } else { lappend argslist $arg } } lappend a $argslist [info body $p] } proc vfs::tclproc::matchindirectory {ns path actualpath pattern type} { puts stderr "matchindirectory $path $actualpath $pattern $type" set res [list] if {[::vfs::matchDirectories $type]} { # add matching directories to $res eval lappend res [namespace children ::${ns}::${path} $pattern] } if {[::vfs::matchFiles $type]} { # add matching files to $res eval lappend res [info procs ::${ns}::${path}::$pattern] } set realres [list] foreach r $res { regsub "^(::)?${ns}(::)?${path}(::)?" $r $actualpath rr lappend realres $rr } #puts $realres return $realres } proc vfs::tclproc::createdirectory {ns name} { puts stderr "createdirectory $name" namespace eval ::${ns}::${name} {} } proc vfs::tclproc::removedirectory {ns name} { puts stderr "removedirectory $name" namespace delete ::${ns}::${name} } proc vfs::tclproc::deletefile {ns name} { puts stderr "deletefile $name" rename ::${ns}::${name} {} } proc vfs::tclproc::fileattributes {ns name args} { puts stderr "fileattributes $args" switch -- [llength $args] { 0 { # list strings return [list -args -body] } 1 { # get value set index [lindex $args 0] switch -- $index { 0 { ::info args ::${ns}::${name} } 1 { ::info body ::${ns}::${name} } } } 2 { # set value set index [lindex $args 0] set val [lindex $args 1] switch -- $index { 0 { error "read-only" } 1 { error "unimplemented" } } } } } |
Added library/testvfs.tcl.
> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 | package require vfs 1.0 proc vfs::testMount {what local} { vfs::filesystem mount $local [list vfs::test::handler $what] } namespace eval vfs::test {} proc vfs::test::handler {what cmd root relative actualpath args} { eval [list $cmd $what $relative] $args } # If we implement the commands below, we will have a perfect # virtual file system. proc vfs::test::stat {what name} { puts "stat $name" } proc vfs::test::access {what name mode} { puts "access $name $mode" } proc vfs::test::open {what name mode permissions} { puts "open $name $mode $permissions" # return a list of two elements: # 1. first element is the Tcl channel name which has been opened # 2. second element (optional) is a command to evaluate when # the channel is closed. return [list] } proc vfs::test::matchindirectory {what path pattern type} { puts "matchindirectory $path $pattern $type" set res [list] if {[::vfs::matchDirectories $type]} { # add matching directories to $res } if {[::vfs::matchFiles $type]} { # add matching files to $res } return $res } proc vfs::test::createdirectory {what name} { puts "createdirectory $name" } proc vfs::test::removedirectory {what name} { puts "removedirectory $name" } proc vfs::test::deletefile {what name} { puts "deletefile $name" } proc vfs::test::fileattributes {what args} { puts "fileattributes $args" switch -- [llength $args] { 0 { # list strings } 1 { # get value set index [lindex $args 0] } 2 { # set value set index [lindex $args 0] set val [lindex $args 1] } } } |
Added library/vfs10.dll.
cannot compute difference between binary files
Added library/vfsUtils.tcl.
> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 | package require vfs proc ::vfs::autoMountExtension {ext cmd {pkg ""}} { variable extMounts set extMounts($ext) [list $cmd $pkg] } proc ::vfs::autoMountUrl {type cmd {pkg ""}} { variable urlMounts set urlMounts($type) [list $cmd $pkg] } ::vfs::autoMountExtension .zip ::vfs::zip::Mount vfs ::vfs::autoMountUrl ftp ::vfs::ftp::Mount vfs ::vfs::autoMountUrl file ::vfs::fileUrlMount vfs ::vfs::autoMountUrl tclns ::vfs::tclprocMount vfs proc ::vfs::haveMount {url} { variable mounted info exists mounted($url) } proc ::vfs::urlMount {url args} { puts "$url $args" variable urlMounts if {[regexp {^([a-zA-Z]+)://(.*)} $url "" urltype rest]} { if {[info exists urlMounts($urltype)]} { #::vfs::log "automounting $path" foreach {cmd pkg} $urlMounts($urltype) {} if {[string length $pkg]} { package require $pkg } eval $cmd [list $url] $args variable mounted set mounted($url) 1 return } error "Unknown url type '$urltype'" } error "Couldn't parse url $url" } proc ::vfs::fileUrlMount {url args} { # Strip off the leading 'file://' set file [string range $url 7 end] eval [list ::vfs::auto $file] $args } proc ::vfs::tclprocMount {url args} { # Strip off the leading 'tclns://' set ns [string range $url 8 end] eval [list ::vfs::tclproc::Mount $ns] $args } proc ::vfs::auto {filename args} { variable extMounts set np {} set split [::file split $filename] foreach ele $split { lappend np $ele set path [::file normalize [eval [list ::file join] $np]] if {[::file isdirectory $path]} { # already mounted continue } elseif {[::file isfile $path]} { set ext [string tolower [::file extension $ele]] if {[::info exists extMounts($ext)]} { #::vfs::log "automounting $path" foreach {cmd pkg} $extMounts($ext) {} if {[string length $pkg]} { package require $pkg } eval $cmd [list $path $path] $args } else { continue } } else { # It doesn't exist, so just return # return -code error "$path doesn't exist" return } } } # Helper procedure for vfs matchindirectory # implementations. It is very important that # we match properly when given 'directory' # specifications, since this is used for # recursive globbing by Tcl. proc vfs::matchCorrectTypes {types filelist} { if {$types != 0} { # Which types to return. We must do special # handling of directories and files. set file [matchFiles $types] set dir [matchDirectories $types] if {$file && $dir} { return $filelist } if {$file == 0 && $dir == 0} { return [list] } set newres [list] if {$file} { foreach r $filelist { if {[::file isfile $r]} { lappend newres $r } } } else { foreach r $filelist { if {[::file isdirectory $r]} { lappend newres $r } } } set filelist $newres } return $filelist } # Convert integer mode to a somewhat preferable string. proc vfs::accessMode {mode} { lindex [list F X W XW R RX RW] $mode } proc vfs::matchDirectories {types} { return [expr {$types == 0 ? 1 : $types & (1<<2)}] } proc vfs::matchFiles {types} { return [expr {$types == 0 ? 1 : $types & (1<<4)}] } proc vfs::modeToString {mode} { } |
Added library/zipvfs.tcl.
> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 | package require vfs 1.0 # Using the vfs, memchan and Trf extensions, we ought to be able # to write a Tcl-only zip virtual filesystem. namespace eval vfs::zip {} proc vfs::zip::Mount {zipfile local} { set fd [::zip::open [::file normalize $zipfile]] vfs::filesystem mount $local [list vfs::zip::handler $fd] return $fd } proc vfs::zip::Unmount {fd} { ::zip::_close $fd } proc vfs::zip::handler {zipfd cmd root relative actualpath args} { #puts [list $zipfd $cmd $root $relative $actualpath $args] #update if {$cmd == "matchindirectory"} { eval [list $cmd $zipfd $relative $actualpath] $args } else { eval [list $cmd $zipfd $relative] $args } } # If we implement the commands below, we will have a perfect # virtual file system for zip files. proc vfs::zip::matchindirectory {zipfd path actualpath pattern type} { puts stderr [list matchindirectory $path $actualpath $pattern $type] set res [::zip::getdir $zipfd $path $pattern] set newres [list] foreach p [::vfs::matchCorrectTypes $type $res] { lappend newres "$actualpath$p" } #puts "got $newres" return $newres } proc vfs::zip::stat {zipfd name} { puts "stat $name" ::zip::stat $zipfd $name sb puts [array get sb] array get sb } proc vfs::zip::access {zipfd name mode} { puts "zip-access $name $mode" if {$mode & 2} { error "read-only" } # Readable, Exists and Executable are treated as 'exists' # Could we get more information from the archive? if {[::zip::exists $zipfd $name]} { return 1 } else { error "No such file" } } proc vfs::zip::open {zipfd name mode permissions} { puts "open $name $mode $permissions" # return a list of two elements: # 1. first element is the Tcl channel name which has been opened # 2. second element (optional) is a command to evaluate when # the channel is closed. switch -- $mode { "" - "r" { ::zip::stat $zipfd $name sb package require Trf package require Memchan set nfd [memchan] fconfigure $nfd -translation binary seek $zipfd $sb(ino) start zip::Data $zipfd sb data puts -nonewline $nfd $data fconfigure $nfd -translation auto seek $nfd 0 return [list $nfd] } default { return -code error "illegal access mode \"$mode\"" } } } proc vfs::zip::createdirectory {zipfd name} { puts stderr "createdirectory $name" error "read-only" } proc vfs::zip::removedirectory {zipfd name} { puts stderr "removedirectory $name" error "read-only" } proc vfs::zip::deletefile {zipfd name} { puts "deletefile $name" error "read-only" } proc vfs::zip::fileattributes {zipfd name args} { puts "fileattributes $args" switch -- [llength $args] { 0 { # list strings return [list] } 1 { # get value set index [lindex $args 0] return "" } 2 { # set value set index [lindex $args 0] set val [lindex $args 1] error "read-only" } } } # Below copied from TclKit distribution # # ZIP decoder: # # Format of zip file: # [ Data ]* [ TOC ]* EndOfArchive # # Note: TOC is refered to in ZIP doc as "Central Archive" # # This means there are two ways of accessing: # # 1) from the begining as a stream - until the header # is not "PK\03\04" - ideal for unzipping. # # 2) for table of contents without reading entire # archive by first fetching EndOfArchive, then # just loading the TOC # package provide vfs.zip 0.5 namespace eval zip { array set methods { 0 {stored - The file is stored (no compression)} 1 {shrunk - The file is Shrunk} 2 {reduce1 - The file is Reduced with compression factor 1} 3 {reduce2 - The file is Reduced with compression factor 2} 4 {reduce3 - The file is Reduced with compression factor 3} 5 {reduce4 - The file is Reduced with compression factor 4} 6 {implode - The file is Imploded} 7 {reserved - Reserved for Tokenizing compression algorithm} 8 {deflate - The file is Deflated} 9 {reserved - Reserved for enhanced Deflating} 10 {pkimplode - PKWARE Date Compression Library Imploding} } # Version types (high-order byte) array set systems { 0 {dos} 1 {amiga} 2 {vms} 3 {unix} 4 {vm cms} 5 {atari} 6 {os/2} 7 {macos} 8 {z system 8} 9 {cp/m} 10 {tops20} 11 {windows} 12 {qdos} 13 {riscos} 14 {vfat} 15 {mvs} 16 {beos} 17 {tandem} 18 {theos} } # DOS File Attrs array set dosattrs { 1 {readonly} 2 {hidden} 4 {system} 8 {unknown8} 16 {directory} 32 {archive} 64 {unknown64} 128 {normal} } proc u_short {n} { return [expr { ($n+0x10000)%0x10000 }] } } proc zip::DosTime {date time} { set time [u_short $time] set date [u_short $date] set sec [expr { ($time & 0x1F) * 2 }] set min [expr { ($time >> 5) & 0x3F }] set hour [expr { ($time >> 11) & 0x1F }] set mday [expr { $date & 0x1F }] set mon [expr { (($date >> 5) & 0xF) }] set year [expr { (($date >> 9) & 0xFF) + 1980 }] set dt [format {%4.4d-%2.2d-%2.2d %2.2d:%2.2d:%2.2d} \ $year $mon $mday $hour $min $sec] return [clock scan $dt -gmt 1] } proc zip::Data {fd arr {varPtr ""} {verify 0}} { upvar 1 $arr sb if { $varPtr != "" } { upvar 1 $varPtr data } set buf [read $fd 30] set n [binary scan $buf A4sssssiiiss \ hdr sb(ver) sb(flags) sb(method) \ time date \ sb(crc) sb(csize) sb(size) flen elen] if { ![string equal "PK\03\04" $hdr] } { error "bad header: [hexdump $hdr]" } set sb(ver) [u_short $sb(ver)] set sb(flags) [u_short $sb(flags)] set sb(method) [u_short $sb(method)] set sb(mtime) [DosTime $date $time] set sb(name) [read $fd [u_short $flen]] set sb(extra) [read $fd [u_short $elen]] if { $varPtr == "" } { seek $fd $sb(csize) current } else { set data [read $fd $sb(csize)] } if { $sb(flags) & 0x4 } { # Data Descriptor used set buf [read $fd 12] binary scan $buf iii sb(crc) sb(csize) sb(size) } if { $varPtr == "" } { return "" } if { $sb(method) != 0 } { if { [catch { set data [zip -mode decompress -nowrap 1 $data] } err] } { puts "$sb(name): inflate error: $err" puts [hexdump $data] } } return if { $verify } { set ncrc [pink zlib crc $data] if { $ncrc != $sb(crc) } { tclLog [format {%s: crc mismatch: expected 0x%x, got 0x%x} \ $sb(name) $sb(crc) $ncrc] } } } proc zip::EndOfArchive {fd arr} { upvar 1 $arr cb seek $fd -22 end set pos [tell $fd] set hdr [read $fd 22] binary scan $hdr A4ssssiis xhdr \ cb(ndisk) cb(cdisk) \ cb(nitems) cb(ntotal) \ cb(csize) cb(coff) \ cb(comment) if { ![string equal "PK\05\06" $xhdr]} { error "bad header" } set cb(ndisk) [u_short $cb(ndisk)] set cb(nitems) [u_short $cb(nitems)] set cb(ntotal) [u_short $cb(ntotal)] set cb(comment) [u_short $cb(comment)] # Compute base for situations where ZIP file # has been appended to another media (e.g. EXE) set cb(base) [expr { $pos - $cb(csize) - $cb(coff) }] } proc zip::TOC {fd arr} { upvar 1 $arr sb set buf [read $fd 46] binary scan $buf A4ssssssiiisssssii hdr \ sb(vem) sb(ver) sb(flags) sb(method) time date \ sb(crc) sb(csize) sb(size) \ flen elen clen sb(disk) sb(attr) \ sb(atx) sb(ino) if { ![string equal "PK\01\02" $hdr] } { error "bad central header: [hexdump $buf]" } foreach v {vem ver flags method disk attr} { set cb($v) [u_short [set sb($v)]] } set sb(mtime) [DosTime $date $time] set sb(mode) [expr { ($sb(atx) >> 16) & 0xffff }] if { ( $sb(atx) & 0xff ) & 16 } { set sb(type) directory } else { set sb(type) file } set sb(name) [read $fd [u_short $flen]] set sb(extra) [read $fd [u_short $elen]] set sb(comment) [read $fd [u_short $clen]] } proc zip::open {path} { set fd [::open $path] upvar #0 zip::$fd cb upvar #0 zip::$fd.toc toc fconfigure $fd -translation binary ;#-buffering none zip::EndOfArchive $fd cb seek $fd $cb(coff) start set toc(_) 0; unset toc(_); #MakeArray for { set i 0 } { $i < $cb(nitems) } { incr i } { zip::TOC $fd sb set sb(depth) [llength [file split $sb(name)]] set name [string tolower $sb(name)] set toc($name) [array get sb] FAKEDIR toc [file dirname $name] } return $fd } proc zip::FAKEDIR {arr path} { upvar 1 $arr toc if { $path == "."} { return } if { ![info exists toc($path)] } { # Implicit directory lappend toc($path) \ name $path \ type directory mtime 0 size 0 mode 0777 \ ino -1 depth [llength [file split $path]] } FAKEDIR toc [file dirname $path] } proc zip::exists {fd path} { #puts stderr "$fd $path" if {$path == ""} { return 1 } else { upvar #0 zip::$fd.toc toc info exists toc([string tolower $path]) } } proc zip::stat {fd path arr} { upvar #0 zip::$fd.toc toc upvar 1 $arr sb set name [string tolower $path] if { $name == "" || $name == "." } { array set sb { type directory mtime 0 size 0 mode 0777 ino -1 depth 0 name "" } } elseif {![info exists toc($name)] } { return -code error "could not read \"$path\": no such file or directory" } else { array set sb $toc($name) } set sb(dev) -1 set sb(uid) -1 set sb(gid) -1 set sb(nlink) 1 set sb(atime) $sb(mtime) set sb(ctime) $sb(mtime) return "" } proc zip::getdir {fd path {pat *}} { # puts stderr [list getdir $fd $path $pat] upvar #0 zip::$fd.toc toc if { $path == "." || $path == "" } { set path $pat } else { set path [string tolower $path] append path /$pat } set depth [llength [file split $path]] set ret {} foreach key [array names toc $path] { if {[string index $key end] == "/"} { # Directories are listed twice: both with and without # the trailing '/', so we ignore the one with continue } array set sb $toc($key) if { $sb(depth) == $depth } { if {[info exists toc(${key}/)]} { array set sb $toc(${key}/) } lappend ret [file tail $sb(name)] } else { #puts "$sb(depth) vs $depth for $sb(name)" } unset sb } return $ret } proc zip::_close {fd} { variable $fd variable $fd.toc unset $fd unset $fd.toc } # # return # # DEMO UNZIP -L PROGRAM # array set opts { -datefmt {%m-%d-%y %H:%M} -verbose 1 -extract 0 -debug 0 } set file [lindex $argv 0] array set opts [lrange $argv 1 end] set fd [open $file] fconfigure $fd -translation binary ;#-buffering none if { !$opts(-extract) } { if { !$opts(-verbose) } { puts " Length Date Time Name" puts " ------ ---- ---- ----" } else { puts " Length Method Size Ratio Date Time CRC-32 Name" puts " ------ ------ ---- ----- ---- ---- ------ ----" } } zip::EndOfArchive $fd cb seek $fd $cb(coff) start set TOC {} for { set i 0 } { $i < $cb(nitems) } { incr i } { zip::TOC $fd sb lappend TOC $sb(name) $sb(ino) if { $opts(-extract) } { continue } if { !$opts(-verbose) } { puts [format {%7d %-16s %s} $sb(size) \ [clock format $sb(mtime) -format $opts(-datefmt) -gmt 1] \ $sb(name)] } else { if { $sb(size) > 0 } { set cr [expr { 100 - 100 * $sb(csize) / double($sb(size)) }] } else { set cr 0 } puts [format {%7d %6.6s %7d %3.0f%% %s %8.8x %s} \ $sb(size) [lindex $::zip::methods($sb(method)) 0] \ $sb(csize) $cr \ [clock format $sb(mtime) -format $opts(-datefmt) -gmt 1] \ $sb(crc) $sb(name)] if { $opts(-debug) } { set maj [expr { ($sb(vem) & 0xff)/10 }] set min [expr { ($sb(vem) & 0xff)%10 }] set sys [expr { $sb(vem) >> 8 }] puts "made by version $maj.$min on system type $sys -> $::zip::systems($sys)" set maj [expr { ($sb(ver) & 0xff)/10 }] set min [expr { ($sb(ver) & 0xff)%10 }] set sys [expr { $sb(ver) >> 8 }] puts "need version $maj.$min on system type $sys -> $::zip::systems($sys)" puts "file type is [expr { $sb(attr) == 1 ? "text" : "binary" }]" puts "file mode is $sb(mode)" set att [expr { $sb(atx) & 0xff }] set flgs {} foreach {k v} [array get ::zip::dosattrs] { if { $k & $att } { lappend flgs $v } } puts "dos file attrs = [join $flgs]" } } } # # This doesn't do anything right now except read each # entry and inflate the data and double-check the crc # if { $opts(-extract) } { seek $fd $cb(base) start foreach {name idx} $TOC { #seek $fd $idx start zip::Data $fd sb data # The slowness of this code is actually Tcl's file i/o # I suspect there are levels of buffer duplication # wasting cpu and memory cycles.... file mkdir [file dirname $sb(name)] set nfd [open $sb(name) w] fconfigure $nfd -translation binary -buffering none puts -nonewline $nfd $data close $nfd puts "$sb(name): $sb(size) bytes" } } |
Added license.terms.
> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 | This software is copyrighted by the Vince Darley, and other parties. The following terms apply to all files associated with the software unless explicitly disclaimed in individual files. The authors hereby grant permission to use, copy, modify, distribute, and license this software and its documentation for any purpose, provided that existing copyright notices are retained in all copies and that this notice is included verbatim in any distributions. No written agreement, license, or royalty fee is required for any of the authorized uses. Modifications to this software may be copyrighted by their authors and need not follow the licensing terms described here, provided that the new terms are clearly indicated on the first page of each file where they apply. IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY DERIVATIVES THEREOF, EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. GOVERNMENT USE: If you are acquiring this software on behalf of the U.S. government, the Government shall have only "Restricted Rights" in the software and related documentation as defined in the Federal Acquisition Regulations (FARs) in Clause 52.227.19 (c) (2). If you are acquiring the software on behalf of the Department of Defense, the software shall be classified as "Commercial Computer Software" and the Government shall have only "Restricted Rights" as defined in Clause 252.227-7013 (c) (1) of DFARs. Notwithstanding the foregoing, the authors grant the U.S. Government and others acting in its behalf permission to use and distribute the software in accordance with the terms specified in this license. |
Added mkIndex.tcl.in.
> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 | # mkIndex.tcl -- # # This script generates a pkgIndex.tcl file for an installed extension. # # Copyright (c) 1999 Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # # Notes: # # If you redefine $(libdir) using the configure switch --libdir=, then # this script will probably fail for you. # # UNIX: # exec_prefix # | # | # | # lib # / \ # / \ # / \ # PACKAGE (.so files) # | # | # | # pkgIndex.tcl # # WIN: # exec_prefix # / \ # / \ # / \ # bin lib # | \ # | \ # | \ # (.dll files) PACKAGE # | # | # | # pkgIndex.tcl # The pkg_mkIndex routines from Tcl 8.2 and later support stub-enabled # extensions. Notify the user if this is not a valid tcl shell. # Exit with a status of 0 so that the make-install process does not stop. if {[catch {package require Tcl 8.4} msg]} { puts stderr "**WARNING**" puts stderr $msg puts stderr "Could not build pkgIndex.tcl file. You must create one by hand" exit 0 } # The name of the library(s) should be passed in as arguments. set libraryList $argv # Nativepath -- # # Convert a Cygnus style path to a native path # # Arguments: # pathName Path to convert # # Results: # The result is the native name of the input pathName. # On Windows, this is z:/foo/bar, on Unix the input pathName is # returned. proc Nativepath {pathName} { global tcl_platform if {![string match $tcl_platform(platform) unix]} { if {[regexp {//(.)/(.*)} $pathName null driveLetter pathRemains]} { set pathName $driveLetter:/$pathRemains } } return $pathName } set prefix "@prefix@" set exec_prefix "@exec_prefix@" set exec_prefix [Nativepath $exec_prefix] set libdir @libdir@ set package @PACKAGE@ set version @VERSION@ cd $libdir puts "Making pkgIndex.tcl in [file join [pwd] $package]" if {$tcl_platform(platform) == "unix"} { if {[llength $libraryList] > 0} { set libraryPathList {} foreach lib $libraryList { lappend libraryPathList [file join .. $lib] } puts "eval pkg_mkIndex $package$version $libraryPathList *.tcl" eval pkg_mkIndex $package$version $libraryPathList *.tcl } } else { if {[llength $libraryList] > 0} { set libraryPathList {} foreach lib $libraryList { lappend libraryPathList [file join .. .. bin $lib] } puts "eval pkg_mkIndex $package$version $libraryPathList *.tcl" eval pkg_mkIndex $package$version $libraryPathList *.tcl } } |
Added mkinstalldirs.
> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 | #! /bin/sh # mkinstalldirs --- make directory hierarchy # Author: Noah Friedman <[email protected]> # Created: 1993-05-16 # Public domain # $Id: mkinstalldirs,v 1.1.1.1 2001/08/03 16:19:00 vincentdarley Exp $ errstatus=0 for file do set fnord `echo ":$file" | sed -ne 's/^:\//#/;s/^://;s/\// /g;s/^#/\//;p'` shift pathcomp= for d do pathcomp="$pathcomp$d" case "$pathcomp" in -* ) pathcomp=./$pathcomp ;; esac if test ! -d "$pathcomp"; then echo "mkdir $pathcomp" mkdir "$pathcomp" || lasterr=$? if test ! -d "$pathcomp"; then errstatus=$lasterr fi fi pathcomp="$pathcomp/" done done exit $errstatus # mkinstalldirs ends here |
Added runZippedTests.tcl.
> > > > > > > > > > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 | catch { wm withdraw . console show } catch {file delete tests.zip} puts stdout "Zipping tests" ; update exec zip -q -9 tests.zip tests/* puts stdout "Done zipping" package require vfs set mount [vfs::zip::Mount tests.zip tests.zip] puts "Zip mount is $mount" update if {[catch { cd tests.zip cd tests #source cmdAH.test source all.tcl } err]} { puts stdout "Got error $err" } puts "Tests complete" #vfs::zip::Unmount $mount #exit |
Added tests/all.tcl.
> | 1 | # all.tcl -- # # This file contains a top-level script to run all of the Tcl # tests. Execute it by invoking "source all.test" when running tcltest # in this directory. # # Copyright (c) 1998-2000 by Scriptics Corporation. # All rights reserved. # # RCS: @(#) $Id: all.tcl,v 1.1.1.1 2001/08/03 16:19:01 vincentdarley Exp $ set tcltestVersion [package require tcltest] namespace import -force tcltest::* #tcltest::testsDirectory [file dir [info script]] #tcltest::runAllTests set ::tcltest::testSingleFile false set ::tcltest::testsDirectory [file dir [info script]] # We need to ensure that the testsDirectory is absolute ::tcltest::normalizePath ::tcltest::testsDirectory puts stdout "Tests running in interp: [info nameofexecutable]" puts stdout "Tests running in working dir: $::tcltest::testsDirectory" if {[llength $::tcltest::skip] > 0} { puts stdout "Skipping tests that match: $::tcltest::skip" } if {[llength $::tcltest::match] > 0} { puts stdout "Only running tests that match: $::tcltest::match" } if {[llength $::tcltest::skipFiles] > 0} { puts stdout "Skipping test files that match: $::tcltest::skipFiles" } if {[llength $::tcltest::matchFiles] > 0} { puts stdout "Only sourcing test files that match: $::tcltest::matchFiles" } tcltest::testConstraint fsIsWritable [expr {1 - [catch {file mkdir isreadonly ; file delete isreadonly}]}] set timeCmd {clock format [clock seconds]} puts stdout "Tests began at [eval $timeCmd]" # source each of the specified tests foreach file [lsort [::tcltest::getMatchingFiles]] { set tail [file tail $file] puts stdout $tail if {[catch {source $file} msg]} { puts stdout $msg } } # cleanup puts stdout "\nTests ended at [eval $timeCmd]" ::tcltest::cleanupTests 1 return |
Added tests/cmdAH.test.
cannot compute difference between binary files
Added tests/encoding.test.
> | 1 | # This file contains a collection of tests for tclEncoding.c # Sourcing this file into Tcl runs the tests and generates output for # errors. No output means no errors were found. # # Copyright (c) 1997 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id: encoding.test,v 1.1.1.1 2001/08/03 16:19:02 vincentdarley Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest namespace import -force ::tcltest::* } proc toutf {args} { global x lappend x "toutf $args" } proc fromutf {args} { global x lappend x "fromutf $args" } # Some tests require the testencoding command set ::tcltest::testConstraints(testencoding) \ [expr {[info commands testencoding] != {}}] # TclInitEncodingSubsystem is tested by the rest of this file # TclFinalizeEncodingSubsystem is not currently tested test encoding-1.1 {Tcl_GetEncoding: system encoding} {testencoding} { testencoding create foo toutf fromutf set old [encoding system] encoding system foo set x {} encoding convertto abcd encoding system $old testencoding delete foo set x } {{fromutf }} test encoding-1.2 {Tcl_GetEncoding: existing encoding} {testencoding} { testencoding create foo toutf fromutf set x {} encoding convertto foo abcd testencoding delete foo set x } {{fromutf }} test encoding-1.3 {Tcl_GetEncoding: load encoding} { list [encoding convertto jis0208 \u4e4e] \ [encoding convertfrom jis0208 8C] } "8C \u4e4e" test encoding-2.1 {Tcl_FreeEncoding: refcount == 0} { encoding convertto jis0208 \u4e4e } {8C} test encoding-2.2 {Tcl_FreeEncoding: refcount != 0} {testencoding} { set system [encoding system] set path [testencoding path] encoding system shiftjis ;# incr ref count testencoding path [list [pwd]] set x [encoding convertto shiftjis \u4e4e] ;# old one found encoding system identity lappend x [catch {encoding convertto shiftjis \u4e4e} msg] $msg encoding system identity testencoding path $path encoding system $system set x } "\u008c\u00c1 1 {unknown encoding \"shiftjis\"}" test encoding-3.1 {Tcl_GetEncodingName, NULL} { set old [encoding system] encoding system shiftjis set x [encoding system] encoding system $old set x } {shiftjis} test encoding-3.2 {Tcl_GetEncodingName, non-null} { set old [fconfigure stdout -encoding] fconfigure stdout -encoding jis0208 set x [fconfigure stdout -encoding] fconfigure stdout -encoding $old set x } {jis0208} test encoding-4.1 {Tcl_GetEncodingNames} {testencoding} { file mkdir tmp/encoding close [open tmp/encoding/junk.enc w] close [open tmp/encoding/junk2.enc w] cd tmp set path [testencoding path] testencoding path {} catch {unset encodings} catch {unset x} foreach encoding [encoding names] { set encodings($encoding) 1 } testencoding path [list [pwd]] foreach encoding [encoding names] { if {![info exists encodings($encoding)]} { lappend x $encoding } } testencoding path $path cd .. file delete -force tmp lsort $x } {junk junk2} test encoding-5.1 {Tcl_SetSystemEncoding} { set old [encoding system] encoding system jis0208 set x [encoding convertto \u4e4e] encoding system identity encoding system $old set x } {8C} test encoding-5.2 {Tcl_SetSystemEncoding: test ref count} { set old [encoding system] encoding system $old string compare $old [encoding system] } {0} test encoding-6.1 {Tcl_CreateEncoding: new} {testencoding} { testencoding create foo {toutf 1} {fromutf 2} set x {} encoding convertfrom foo abcd encoding convertto foo abcd testencoding delete foo set x } {{toutf 1} {fromutf 2}} test encoding-6.2 {Tcl_CreateEncoding: replace encoding} {testencoding} { testencoding create foo {toutf a} {fromutf b} set x {} encoding convertfrom foo abcd encoding convertto foo abcd testencoding delete foo set x } {{toutf a} {fromutf b}} test encoding-7.1 {Tcl_ExternalToUtfDString: small buffer} { encoding convertfrom jis0208 8c8c8c8c } "\u543e\u543e\u543e\u543e" test encoding-7.2 {Tcl_UtfToExternalDString: big buffer} { set a 8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C append a $a append a $a append a $a append a $a set x [encoding convertfrom jis0208 $a] list [string length $x] [string index $x 0] } "512 \u4e4e" test encoding-8.1 {Tcl_ExternalToUtf} {fsIsWritable} { set f [open dummy w] fconfigure $f -translation binary -encoding iso8859-1 puts -nonewline $f "ab\x8c\xc1g" close $f set f [open dummy r] fconfigure $f -translation binary -encoding shiftjis set x [read $f] close $f file delete dummy set x } "ab\u4e4eg" test encoding-9.1 {Tcl_UtfToExternalDString: small buffer} { encoding convertto jis0208 "\u543e\u543e\u543e\u543e" } {8c8c8c8c} test encoding-9.2 {Tcl_UtfToExternalDString: big buffer} { set a \u4e4e\u4e4e\u4e4e\u4e4e\u4e4e\u4e4e\u4e4e\u4e4e append a $a append a $a append a $a append a $a append a $a append a $a set x [encoding convertto jis0208 $a] list [string length $x] [string range $x 0 1] } "1024 8C" test encoding-10.1 {Tcl_UtfToExternal} {fsIsWritable} { set f [open dummy w] fconfigure $f -translation binary -encoding shiftjis puts -nonewline $f "ab\u4e4eg" close $f set f [open dummy r] fconfigure $f -translation binary -encoding iso8859-1 set x [read $f] close $f file delete dummy set x } "ab\x8c\xc1g" test encoding-11.1 {LoadEncodingFile: unknown encoding} {testencoding} { set system [encoding system] set path [testencoding path] encoding system iso8859-1 testencoding path {} set x [list [catch {encoding convertto jis0208 \u4e4e} msg] $msg] testencoding path $path encoding system $system lappend x [encoding convertto jis0208 \u4e4e] } {1 {unknown encoding "jis0208"} 8C} test encoding-11.2 {LoadEncodingFile: single-byte} { encoding convertfrom jis0201 \xa1 } "\uff61" test encoding-11.3 {LoadEncodingFile: double-byte} { encoding convertfrom jis0208 8C } "\u4e4e" test encoding-11.4 {LoadEncodingFile: multi-byte} { encoding convertfrom shiftjis \x8c\xc1 } "\u4e4e" test encoding-11.5 {LoadEncodingFile: escape file} { encoding convertto iso2022 \u4e4e } "\x1b(B\x1b$@8C" test encoding-11.6 {LoadEncodingFile: invalid file} {testencoding} { set system [encoding system] set path [testencoding path] encoding system identity testencoding path tmp file mkdir tmp/encoding set f [open tmp/encoding/splat.enc w] fconfigure $f -translation binary puts $f "abcdefghijklmnop" close $f set x [list [catch {encoding convertto splat \u4e4e} msg] $msg] file delete -force tmp catch {file delete encoding} testencoding path $path encoding system $system set x } {1 {invalid encoding file "splat"}} # OpenEncodingFile is fully tested by the rest of the tests in this file. test encoding-12.1 {LoadTableEncoding: normal encoding} { set x [encoding convertto iso8859-3 \u120] append x [encoding convertto iso8859-3 \ud5] append x [encoding convertfrom iso8859-3 \xd5] } "\xd5?\u120" test encoding-12.2 {LoadTableEncoding: single-byte encoding} { set x [encoding convertto iso8859-3 ab\u0120g] append x [encoding convertfrom iso8859-3 ab\xd5g] } "ab\xd5gab\u120g" test encoding-12.3 {LoadTableEncoding: multi-byte encoding} { set x [encoding convertto shiftjis ab\u4e4eg] append x [encoding convertfrom shiftjis ab\x8c\xc1g] } "ab\x8c\xc1gab\u4e4eg" test encoding-12.4 {LoadTableEncoding: double-byte encoding} { set x [encoding convertto jis0208 \u4e4e\u3b1] append x [encoding convertfrom jis0208 8C&A] } "8C&A\u4e4e\u3b1" test encoding-12.5 {LoadTableEncoding: symbol encoding} { set x [encoding convertto symbol \u3b3] append x [encoding convertto symbol \u67] append x [encoding convertfrom symbol \x67] } "\x67\x67\u3b3" test encoding-13.1 {LoadEscapeTable} { set x [encoding convertto iso2022 ab\u4e4e\u68d9g] } "\x1b(Bab\x1b$@8C\x1b$\(DD%\x1b(Bg" test encoding-14.1 {BinaryProc} { encoding convertto identity \x12\x34\x56\xff\x69 } "\x12\x34\x56\xc3\xbf\x69" test encoding-15.1 {UtfToUtfProc} { encoding convertto utf-8 \xa3 } "\xc2\xa3" test encoding-16.1 {UnicodeToUtfProc} { encoding convertfrom unicode NN } "\u4e4e" test encoding-17.1 {UtfToUnicodeProc} { } {} test encoding-18.1 {TableToUtfProc} { } {} test encoding-19.1 {TableFromUtfProc} { } {} test encoding-20.1 {TableFreefProc} { } {} test encoding-21.1 {EscapeToUtfProc} { } {} test encoding-22.1 {EscapeFromUtfProc} { } {} # EscapeFreeProc, GetTableEncoding, unilen # are fully tested by the rest of this file # cleanup ::tcltest::cleanupTests return |
Added tests/fCmd.test.
cannot compute difference between binary files
Added tests/fileName.test.
> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 859 860 861 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 930 931 932 933 934 935 936 937 938 939 940 941 942 943 944 945 946 947 948 949 950 951 952 953 954 955 956 957 958 959 960 961 962 963 964 965 966 967 968 969 970 971 972 973 974 975 976 977 978 979 980 981 982 983 984 985 986 987 988 989 990 991 992 993 994 995 996 997 998 999 1000 1001 1002 1003 1004 1005 1006 1007 1008 1009 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080 1081 1082 1083 1084 1085 1086 1087 1088 1089 1090 1091 1092 1093 1094 1095 1096 1097 1098 1099 1100 1101 1102 1103 1104 1105 1106 1107 1108 1109 1110 1111 1112 1113 1114 1115 1116 1117 1118 1119 1120 1121 1122 1123 1124 1125 1126 1127 1128 1129 1130 1131 1132 1133 1134 1135 1136 1137 1138 1139 1140 1141 1142 1143 1144 1145 1146 1147 1148 1149 1150 1151 1152 1153 1154 1155 1156 1157 1158 1159 1160 1161 1162 1163 1164 1165 1166 1167 1168 1169 1170 1171 1172 1173 1174 1175 1176 1177 1178 1179 1180 1181 1182 1183 1184 1185 1186 1187 1188 1189 1190 1191 1192 1193 1194 1195 1196 1197 1198 1199 1200 1201 1202 1203 1204 1205 1206 1207 1208 1209 1210 1211 1212 1213 1214 1215 1216 1217 1218 1219 1220 1221 1222 1223 1224 1225 1226 1227 1228 1229 1230 1231 1232 1233 1234 1235 1236 1237 1238 1239 1240 1241 1242 1243 1244 1245 1246 1247 1248 1249 1250 1251 1252 1253 1254 1255 1256 1257 1258 1259 1260 1261 1262 1263 1264 1265 1266 1267 1268 1269 1270 1271 1272 1273 1274 1275 1276 1277 1278 1279 1280 1281 1282 1283 1284 1285 1286 1287 1288 1289 1290 1291 1292 1293 1294 1295 1296 1297 1298 1299 1300 1301 1302 1303 1304 1305 1306 1307 1308 1309 1310 1311 1312 1313 1314 1315 1316 1317 1318 1319 1320 1321 1322 1323 1324 1325 1326 1327 1328 1329 1330 1331 1332 1333 1334 1335 1336 1337 1338 1339 1340 1341 1342 1343 1344 1345 1346 1347 1348 1349 1350 1351 1352 1353 1354 1355 1356 1357 1358 1359 1360 1361 1362 1363 1364 1365 1366 1367 1368 1369 1370 1371 1372 1373 1374 1375 1376 1377 1378 1379 1380 1381 1382 1383 1384 1385 1386 1387 1388 1389 1390 1391 1392 1393 1394 1395 1396 1397 1398 1399 1400 1401 1402 1403 1404 1405 1406 1407 1408 1409 1410 1411 1412 1413 1414 1415 1416 1417 1418 1419 1420 1421 1422 1423 1424 1425 1426 1427 1428 1429 1430 1431 1432 1433 1434 1435 1436 1437 1438 1439 1440 1441 1442 1443 1444 1445 1446 1447 1448 1449 1450 1451 1452 1453 1454 1455 1456 1457 1458 1459 1460 1461 1462 1463 1464 1465 1466 1467 1468 1469 1470 1471 1472 1473 1474 1475 1476 1477 1478 1479 1480 1481 1482 1483 1484 1485 1486 1487 1488 1489 1490 1491 1492 1493 1494 1495 1496 1497 1498 1499 1500 1501 1502 1503 1504 1505 1506 1507 1508 1509 1510 1511 1512 1513 1514 1515 1516 1517 1518 1519 1520 1521 1522 1523 1524 1525 1526 1527 1528 1529 1530 1531 1532 1533 1534 1535 1536 1537 1538 1539 1540 1541 1542 1543 1544 1545 1546 1547 1548 1549 1550 1551 1552 1553 1554 1555 1556 1557 1558 1559 1560 1561 1562 1563 1564 1565 1566 1567 1568 1569 1570 1571 1572 1573 1574 1575 1576 1577 1578 1579 1580 1581 1582 1583 1584 1585 1586 1587 1588 1589 1590 1591 1592 1593 1594 1595 1596 | # This file tests the filename manipulation routines. # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1995-1996 Sun Microsystems, Inc. # Copyright (c) 1999 by Scriptics Corporation. # # 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.1.1.1 2001/08/03 16:19:04 vincentdarley Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest namespace import -force ::tcltest::* } tcltest::testConstraint testsetplatform [string equal testsetplatform [info commands testsetplatform]] tcltest::testConstraint testtranslatefilename [string equal testtranslatefilename [info commands testtranslatefilename]] global env if {[tcltest::testConstraint testsetplatform]} { set platform [testgetplatform] } test filename-1.1 {Tcl_GetPathType: unix} {testsetplatform} { testsetplatform unix file pathtype / } absolute test filename-1.2 {Tcl_GetPathType: unix} {testsetplatform} { testsetplatform unix file pathtype /foo } absolute test filename-1.3 {Tcl_GetPathType: unix} {testsetplatform} { testsetplatform unix file pathtype foo } relative test filename-1.4 {Tcl_GetPathType: unix} {testsetplatform} { testsetplatform unix file pathtype c:/foo } relative test filename-1.5 {Tcl_GetPathType: unix} {testsetplatform} { testsetplatform unix file pathtype ~ } absolute test filename-1.6 {Tcl_GetPathType: unix} {testsetplatform} { testsetplatform unix file pathtype ~/foo } absolute test filename-1.7 {Tcl_GetPathType: unix} {testsetplatform} { testsetplatform unix file pathtype ~foo } absolute test filename-1.8 {Tcl_GetPathType: unix} {testsetplatform} { testsetplatform unix file pathtype ./~foo } relative test filename-2.1 {Tcl_GetPathType: mac, denerate names} {testsetplatform} { testsetplatform mac file pathtype / } relative test filename-2.2 {Tcl_GetPathType: mac, denerate names} {testsetplatform} { testsetplatform mac file pathtype /. } relative test filename-2.3 {Tcl_GetPathType: mac, denerate names} {testsetplatform} { testsetplatform mac file pathtype /.. } relative test filename-2.4 {Tcl_GetPathType: mac, denerate names} {testsetplatform} { testsetplatform mac file pathtype //.// } relative test filename-2.5 {Tcl_GetPathType: mac, denerate names} {testsetplatform} { testsetplatform mac file pathtype //.//../. } relative test filename-2.6 {Tcl_GetPathType: mac, tilde names} {testsetplatform} { testsetplatform mac file pathtype ~ } absolute test filename-2.7 {Tcl_GetPathType: mac, tilde names} {testsetplatform} { testsetplatform mac file pathtype ~: } absolute test filename-2.8 {Tcl_GetPathType: mac, tilde names} {testsetplatform} { testsetplatform mac file pathtype ~:foo } absolute test filename-2.9 {Tcl_GetPathType: mac, tilde names} {testsetplatform} { testsetplatform mac file pathtype ~/ } absolute test filename-2.10 {Tcl_GetPathType: mac, tilde names} {testsetplatform} { testsetplatform mac file pathtype ~/foo } absolute test filename-2.11 {Tcl_GetPathType: mac, unix-style names} {testsetplatform} { testsetplatform mac file pathtype /foo } absolute test filename-2.12 {Tcl_GetPathType: mac, unix-style names} {testsetplatform} { testsetplatform mac file pathtype /./foo } absolute test filename-2.13 {Tcl_GetPathType: mac, unix-style names} {testsetplatform} { testsetplatform mac file pathtype /..//./foo } absolute test filename-2.14 {Tcl_GetPathType: mac, unix-style names} {testsetplatform} { testsetplatform mac file pathtype /foo/bar } absolute test filename-2.15 {Tcl_GetPathType: mac, unix-style names} {testsetplatform} { testsetplatform mac file pathtype foo/bar } relative test filename-2.16 {Tcl_GetPathType: mac, mac-style names} {testsetplatform} { testsetplatform mac file pathtype : } relative test filename-2.17 {Tcl_GetPathType: mac, mac-style names} {testsetplatform} { testsetplatform mac file pathtype :foo } relative test filename-2.18 {Tcl_GetPathType: mac, mac-style names} {testsetplatform} { testsetplatform mac file pathtype foo: } absolute test filename-2.19 {Tcl_GetPathType: mac, mac-style names} {testsetplatform} { testsetplatform mac file pathtype foo:bar } absolute test filename-2.20 {Tcl_GetPathType: mac, mac-style names} {testsetplatform} { testsetplatform mac file pathtype :foo:bar } relative test filename-2.21 {Tcl_GetPathType: mac, mac-style names} {testsetplatform} { testsetplatform mac file pathtype ::foo:bar } relative test filename-2.22 {Tcl_GetPathType: mac, mac-style names} {testsetplatform} { testsetplatform mac file pathtype ~foo } absolute test filename-2.23 {Tcl_GetPathType: mac, mac-style names} {testsetplatform} { testsetplatform mac file pathtype :~foo } relative test filename-2.24 {Tcl_GetPathType: mac, mac-style names} {testsetplatform} { testsetplatform mac file pathtype ~foo: } absolute test filename-2.25 {Tcl_GetPathType: mac, mac-style names} {testsetplatform} { testsetplatform mac file pathtype foo/bar: } absolute test filename-2.26 {Tcl_GetPathType: mac, mac-style names} {testsetplatform} { testsetplatform mac file pathtype /foo: } absolute test filename-2.27 {Tcl_GetPathType: mac, mac-style names} {testsetplatform} { testsetplatform mac file pathtype foo } relative test filename-3.1 {Tcl_GetPathType: windows} {testsetplatform} { testsetplatform windows file pathtype / } volumerelative test filename-3.2 {Tcl_GetPathType: windows} {testsetplatform} { testsetplatform windows file pathtype \\ } volumerelative test filename-3.3 {Tcl_GetPathType: windows} {testsetplatform} { testsetplatform windows file pathtype /foo } volumerelative test filename-3.4 {Tcl_GetPathType: windows} {testsetplatform} { testsetplatform windows file pathtype \\foo } volumerelative test filename-3.5 {Tcl_GetPathType: windows} {testsetplatform} { testsetplatform windows file pathtype c:/ } absolute test filename-3.6 {Tcl_GetPathType: windows} {testsetplatform} { testsetplatform windows file pathtype c:\\ } absolute test filename-3.7 {Tcl_GetPathType: windows} {testsetplatform} { testsetplatform windows file pathtype c:/foo } absolute test filename-3.8 {Tcl_GetPathType: windows} {testsetplatform} { testsetplatform windows file pathtype c:\\foo } absolute test filename-3.9 {Tcl_GetPathType: windows} {testsetplatform} { testsetplatform windows file pathtype c: } volumerelative test filename-3.10 {Tcl_GetPathType: windows} {testsetplatform} { testsetplatform windows file pathtype c:foo } volumerelative test filename-3.11 {Tcl_GetPathType: windows} {testsetplatform} { testsetplatform windows file pathtype foo } relative test filename-3.12 {Tcl_GetPathType: windows} {testsetplatform} { testsetplatform windows file pathtype //foo/bar } absolute test filename-3.13 {Tcl_GetPathType: windows} {testsetplatform} { testsetplatform windows file pathtype ~foo } absolute test filename-3.14 {Tcl_GetPathType: windows} {testsetplatform} { testsetplatform windows file pathtype ~ } absolute test filename-3.15 {Tcl_GetPathType: windows} {testsetplatform} { testsetplatform windows file pathtype ~/foo } absolute test filename-3.16 {Tcl_GetPathType: windows} {testsetplatform} { testsetplatform windows file pathtype ./~foo } relative test filename-4.1 {Tcl_SplitPath: unix} {testsetplatform} { testsetplatform unix file split / } {/} test filename-4.2 {Tcl_SplitPath: unix} {testsetplatform} { testsetplatform unix file split /foo } {/ foo} test filename-4.3 {Tcl_SplitPath: unix} {testsetplatform} { testsetplatform unix file split /foo/bar } {/ foo bar} test filename-4.4 {Tcl_SplitPath: unix} {testsetplatform} { testsetplatform unix file split /foo/bar/baz } {/ foo bar baz} test filename-4.5 {Tcl_SplitPath: unix} {testsetplatform} { testsetplatform unix file split foo/bar } {foo bar} test filename-4.6 {Tcl_SplitPath: unix} {testsetplatform} { testsetplatform unix file split ./foo/bar } {. foo bar} test filename-4.7 {Tcl_SplitPath: unix} {testsetplatform} { testsetplatform unix file split /foo/../././foo/bar } {/ foo .. . . foo bar} test filename-4.8 {Tcl_SplitPath: unix} {testsetplatform} { testsetplatform unix file split ../foo/bar } {.. foo bar} test filename-4.9 {Tcl_SplitPath: unix} {testsetplatform} { testsetplatform unix file split {} } {} test filename-4.10 {Tcl_SplitPath: unix} {testsetplatform} { testsetplatform unix file split . } {.} test filename-4.11 {Tcl_SplitPath: unix} {testsetplatform} { testsetplatform unix file split ../ } {..} test filename-4.12 {Tcl_SplitPath: unix} {testsetplatform} { testsetplatform unix file split ../.. } {.. ..} test filename-4.13 {Tcl_SplitPath: unix} {testsetplatform} { testsetplatform unix file split //foo } {/ foo} test filename-4.14 {Tcl_SplitPath: unix} {testsetplatform} { testsetplatform unix file split foo//bar } {foo bar} test filename-4.15 {Tcl_SplitPath: unix} {testsetplatform} { testsetplatform unix file split ~foo } {~foo} test filename-4.16 {Tcl_SplitPath: unix} {testsetplatform} { testsetplatform unix file split ~foo/~bar } {~foo ./~bar} test filename-4.17 {Tcl_SplitPath: unix} {testsetplatform} { testsetplatform unix file split ~foo/~bar/~baz } {~foo ./~bar ./~baz} test filename-4.18 {Tcl_SplitPath: unix} {testsetplatform} { testsetplatform unix file split foo/bar~/baz } {foo bar~ baz} test filename-5.1 {Tcl_SplitPath: mac} {testsetplatform} { testsetplatform mac file split a:b } {a: b} test filename-5.2 {Tcl_SplitPath: mac} {testsetplatform} { testsetplatform mac file split a:b:c } {a: b c} test filename-5.3 {Tcl_SplitPath: mac} {testsetplatform} { testsetplatform mac file split a:b:c: } {a: b c} test filename-5.4 {Tcl_SplitPath: mac} {testsetplatform} { testsetplatform mac file split a: } {a:} test filename-5.5 {Tcl_SplitPath: mac} {testsetplatform} { testsetplatform mac file split a:: } {a: ::} test filename-5.6 {Tcl_SplitPath: mac} {testsetplatform} { testsetplatform mac file split a::: } {a: :: ::} test filename-5.7 {Tcl_SplitPath: mac} {testsetplatform} { testsetplatform mac file split :a } {a} test filename-5.8 {Tcl_SplitPath: mac} {testsetplatform} { testsetplatform mac file split :a:: } {a ::} test filename-5.9 {Tcl_SplitPath: mac} {testsetplatform} { testsetplatform mac file split : } {:} test filename-5.10 {Tcl_SplitPath: mac} {testsetplatform} { testsetplatform mac file split :: } {::} test filename-5.11 {Tcl_SplitPath: mac} {testsetplatform} { testsetplatform mac file split ::: } {:: ::} test filename-5.12 {Tcl_SplitPath: mac} {testsetplatform} { testsetplatform mac file split a:::b } {a: :: :: b} test filename-5.13 {Tcl_SplitPath: mac} {testsetplatform} { testsetplatform mac file split /a:b } {/a: b} test filename-5.14 {Tcl_SplitPath: mac} {testsetplatform} { testsetplatform mac file split ~: } {~:} test filename-5.15 {Tcl_SplitPath: mac} {testsetplatform} { testsetplatform mac file split ~/: } {~/:} test filename-5.16 {Tcl_SplitPath: mac} {testsetplatform} { testsetplatform mac file split ~:foo } {~: foo} test filename-5.17 {Tcl_SplitPath: mac} {testsetplatform} { testsetplatform mac file split ~/foo } {~: foo} test filename-5.18 {Tcl_SplitPath: mac} {testsetplatform} { testsetplatform mac file split ~foo: } {~foo:} test filename-5.19 {Tcl_SplitPath: mac} {testsetplatform} { testsetplatform mac file split a:~foo } {a: :~foo} test filename-5.20 {Tcl_SplitPath: mac} {testsetplatform} { testsetplatform mac file split / } {:/} test filename-5.21 {Tcl_SplitPath: mac} {testsetplatform} { testsetplatform mac file split a:b/c } {a: :b/c} test filename-5.22 {Tcl_SplitPath: mac} {testsetplatform} { testsetplatform mac file split /foo } {foo:} test filename-5.23 {Tcl_SplitPath: mac} {testsetplatform} { testsetplatform mac file split /a/b } {a: b} test filename-5.24 {Tcl_SplitPath: mac} {testsetplatform} { testsetplatform mac file split /a/b/foo } {a: b foo} test filename-5.25 {Tcl_SplitPath: mac} {testsetplatform} { testsetplatform mac file split a/b } {a b} test filename-5.26 {Tcl_SplitPath: mac} {testsetplatform} { testsetplatform mac file split ./foo/bar } {: foo bar} test filename-5.27 {Tcl_SplitPath: mac} {testsetplatform} { testsetplatform mac file split ../foo/bar } {:: foo bar} test filename-5.28 {Tcl_SplitPath: mac} {testsetplatform} { testsetplatform mac file split {} } {} test filename-5.29 {Tcl_SplitPath: mac} {testsetplatform} { testsetplatform mac file split . } {:} test filename-5.30 {Tcl_SplitPath: mac} {testsetplatform} { testsetplatform mac file split ././ } {: :} test filename-5.31 {Tcl_SplitPath: mac} {testsetplatform} { testsetplatform mac file split ././. } {: : :} test filename-5.32 {Tcl_SplitPath: mac} {testsetplatform} { testsetplatform mac file split ../ } {::} test filename-5.33 {Tcl_SplitPath: mac} {testsetplatform} { testsetplatform mac file split .. } {::} test filename-5.34 {Tcl_SplitPath: mac} {testsetplatform} { testsetplatform mac file split ../.. } {:: ::} test filename-5.35 {Tcl_SplitPath: mac} {testsetplatform} { testsetplatform mac file split //foo } {foo:} test filename-5.36 {Tcl_SplitPath: mac} {testsetplatform} { testsetplatform mac file split foo//bar } {foo bar} test filename-5.37 {Tcl_SplitPath: mac} {testsetplatform} { testsetplatform mac file split ~foo } {~foo:} test filename-5.38 {Tcl_SplitPath: mac} {testsetplatform} { testsetplatform mac file split ~ } {~:} test filename-5.39 {Tcl_SplitPath: mac} {testsetplatform} { testsetplatform mac file split foo } {foo} test filename-5.40 {Tcl_SplitPath: mac} {testsetplatform} { testsetplatform mac file split ~/ } {~:} test filename-5.41 {Tcl_SplitPath: mac} {testsetplatform} { testsetplatform mac file split ~foo/~bar } {~foo: :~bar} test filename-5.42 {Tcl_SplitPath: mac} {testsetplatform} { testsetplatform mac file split ~foo/~bar/~baz } {~foo: :~bar :~baz} test filename-5.43 {Tcl_SplitPath: mac} {testsetplatform} { testsetplatform mac file split foo/bar~/baz } {foo bar~ baz} test filename-5.44 {Tcl_SplitPath: mac} {testsetplatform} { testsetplatform mac file split a/../b } {a :: b} test filename-5.45 {Tcl_SplitPath: mac} {testsetplatform} { testsetplatform mac file split a/../../b } {a :: :: b} test filename-5.46 {Tcl_SplitPath: mac} {testsetplatform} { testsetplatform mac file split a/.././../b } {a :: : :: b} test filename-5.47 {Tcl_SplitPath: mac} {testsetplatform} { testsetplatform mac file split /../bar } {bar:} test filename-5.48 {Tcl_SplitPath: mac} {testsetplatform} { testsetplatform mac file split /./bar } {bar:} test filename-5.49 {Tcl_SplitPath: mac} {testsetplatform} { testsetplatform mac file split //.//.././bar } {bar:} test filename-5.50 {Tcl_SplitPath: mac} {testsetplatform} { testsetplatform mac file split /.. } {:/..} test filename-5.51 {Tcl_SplitPath: mac} {testsetplatform} { testsetplatform mac file split //.//.././ } {://.//.././} test filename-6.1 {Tcl_SplitPath: win} {testsetplatform} { testsetplatform win file split / } {/} test filename-6.2 {Tcl_SplitPath: win} {testsetplatform} { testsetplatform win file split /foo } {/ foo} test filename-6.3 {Tcl_SplitPath: win} {testsetplatform} { testsetplatform win file split /foo/bar } {/ foo bar} test filename-6.4 {Tcl_SplitPath: win} {testsetplatform} { testsetplatform win file split /foo/bar/baz } {/ foo bar baz} test filename-6.5 {Tcl_SplitPath: win} {testsetplatform} { testsetplatform win file split foo/bar } {foo bar} test filename-6.6 {Tcl_SplitPath: win} {testsetplatform} { testsetplatform win file split ./foo/bar } {. foo bar} test filename-6.7 {Tcl_SplitPath: win} {testsetplatform} { testsetplatform win file split /foo/../././foo/bar } {/ foo .. . . foo bar} test filename-6.8 {Tcl_SplitPath: win} {testsetplatform} { testsetplatform win file split ../foo/bar } {.. foo bar} test filename-6.9 {Tcl_SplitPath: win} {testsetplatform} { testsetplatform win file split {} } {} test filename-6.10 {Tcl_SplitPath: win} {testsetplatform} { testsetplatform win file split . } {.} test filename-6.11 {Tcl_SplitPath: win} {testsetplatform} { testsetplatform win file split ../ } {..} test filename-6.12 {Tcl_SplitPath: win} {testsetplatform} { testsetplatform win file split ../.. } {.. ..} test filename-6.13 {Tcl_SplitPath: win} {testsetplatform} { testsetplatform win file split //foo } {/ foo} test filename-6.14 {Tcl_SplitPath: win} {testsetplatform} { testsetplatform win file split foo//bar } {foo bar} test filename-6.15 {Tcl_SplitPath: win} {testsetplatform} { testsetplatform win file split /\\/foo//bar } {//foo/bar} test filename-6.16 {Tcl_SplitPath: win} {testsetplatform} { testsetplatform win file split /\\/foo//bar } {//foo/bar} test filename-6.17 {Tcl_SplitPath: win} {testsetplatform} { testsetplatform win file split /\\/foo//bar } {//foo/bar} test filename-6.18 {Tcl_SplitPath: win} {testsetplatform} { testsetplatform win file split \\\\foo\\bar } {//foo/bar} test filename-6.19 {Tcl_SplitPath: win} {testsetplatform} { testsetplatform win file split \\\\foo\\bar/baz } {//foo/bar baz} test filename-6.20 {Tcl_SplitPath: win} {testsetplatform} { testsetplatform win file split c:/foo } {c:/ foo} test filename-6.21 {Tcl_SplitPath: win} {testsetplatform} { testsetplatform win file split c:foo } {c: foo} test filename-6.22 {Tcl_SplitPath: win} {testsetplatform} { testsetplatform win file split c: } {c:} test filename-6.23 {Tcl_SplitPath: win} {testsetplatform} { testsetplatform win file split c:\\ } {c:/} test filename-6.24 {Tcl_SplitPath: win} {testsetplatform} { testsetplatform win file split c:/ } {c:/} test filename-6.25 {Tcl_SplitPath: win} {testsetplatform} { testsetplatform win file split c:/./.. } {c:/ . ..} test filename-6.26 {Tcl_SplitPath: win} {testsetplatform} { testsetplatform win file split ~foo } {~foo} test filename-6.27 {Tcl_SplitPath: win} {testsetplatform} { testsetplatform win file split ~foo/~bar } {~foo ./~bar} test filename-6.28 {Tcl_SplitPath: win} {testsetplatform} { testsetplatform win file split ~foo/~bar/~baz } {~foo ./~bar ./~baz} test filename-6.29 {Tcl_SplitPath: win} {testsetplatform} { testsetplatform win file split foo/bar~/baz } {foo bar~ baz} test filename-6.30 {Tcl_SplitPath: win} {testsetplatform} { testsetplatform win file split c:~foo } {c: ./~foo} test filename-7.1 {Tcl_JoinPath: unix} {testsetplatform} { testsetplatform unix file join / a } {/a} test filename-7.2 {Tcl_JoinPath: unix} {testsetplatform} { testsetplatform unix file join a b } {a/b} test filename-7.3 {Tcl_JoinPath: unix} {testsetplatform} { testsetplatform unix file join /a c /b d } {/b/d} test filename-7.4 {Tcl_JoinPath: unix} {testsetplatform} { testsetplatform unix file join / } {/} test filename-7.5 {Tcl_JoinPath: unix} {testsetplatform} { testsetplatform unix file join a } {a} test filename-7.6 {Tcl_JoinPath: unix} {testsetplatform} { testsetplatform unix file join {} } {} test filename-7.7 {Tcl_JoinPath: unix} {testsetplatform} { testsetplatform unix file join /a/ b } {/a/b} test filename-7.8 {Tcl_JoinPath: unix} {testsetplatform} { testsetplatform unix file join /a// b } {/a/b} test filename-7.9 {Tcl_JoinPath: unix} {testsetplatform} { testsetplatform unix file join /a/./../. b } {/a/./.././b} test filename-7.10 {Tcl_JoinPath: unix} {testsetplatform} { testsetplatform unix file join ~ a } {~/a} test filename-7.11 {Tcl_JoinPath: unix} {testsetplatform} { testsetplatform unix file join ~a ~b } {~b} test filename-7.12 {Tcl_JoinPath: unix} {testsetplatform} { testsetplatform unix file join ./~a b } {./~a/b} test filename-7.13 {Tcl_JoinPath: unix} {testsetplatform} { testsetplatform unix file join ./~a ~b } {~b} test filename-7.14 {Tcl_JoinPath: unix} {testsetplatform} { testsetplatform unix file join ./~a ./~b } {./~a/~b} test filename-7.15 {Tcl_JoinPath: unix} {testsetplatform} { testsetplatform unix file join a . b } {a/./b} test filename-7.16 {Tcl_JoinPath: unix} {testsetplatform} { testsetplatform unix file join a . ./~b } {a/./~b} test filename-7.17 {Tcl_JoinPath: unix} {testsetplatform} { testsetplatform unix file join //a b } {/a/b} test filename-7.18 {Tcl_JoinPath: unix} {testsetplatform} { testsetplatform unix file join /// a b } {/a/b} test filename-8.1 {Tcl_JoinPath: mac} {testsetplatform} { testsetplatform mac file join a b } {:a:b} test filename-8.2 {Tcl_JoinPath: mac} {testsetplatform} { testsetplatform mac file join :a b } {:a:b} test filename-8.3 {Tcl_JoinPath: mac} {testsetplatform} { testsetplatform mac file join a b: } {b:} test filename-8.4 {Tcl_JoinPath: mac} {testsetplatform} { testsetplatform mac file join a: :b } {a:b} test filename-8.5 {Tcl_JoinPath: mac} {testsetplatform} { testsetplatform mac file join a: :b: } {a:b} test filename-8.6 {Tcl_JoinPath: mac} {testsetplatform} { testsetplatform mac file join a :: b } {:a::b} test filename-8.7 {Tcl_JoinPath: mac} {testsetplatform} { testsetplatform mac file join a :: :: b } {:a:::b} test filename-8.8 {Tcl_JoinPath: mac} {testsetplatform} { testsetplatform mac file join a ::: b } {:a:::b} test filename-8.9 {Tcl_JoinPath: mac} {testsetplatform} { testsetplatform mac file join a: b: } {b:} test filename-8.10 {Tcl_JoinPath: mac} {testsetplatform} { testsetplatform mac file join /a/b } {a:b} test filename-8.11 {Tcl_JoinPath: mac} {testsetplatform} { testsetplatform mac file join /a/b c/d } {a:b:c:d} test filename-8.12 {Tcl_JoinPath: mac} {testsetplatform} { testsetplatform mac file join /a/b :c:d } {a:b:c:d} test filename-8.13 {Tcl_JoinPath: mac} {testsetplatform} { testsetplatform mac file join ~ foo } {~:foo} test filename-8.14 {Tcl_JoinPath: mac} {testsetplatform} { testsetplatform mac file join :: :: } {:::} test filename-8.15 {Tcl_JoinPath: mac} {testsetplatform} { testsetplatform mac file join a: :: } {a::} test filename-8.16 {Tcl_JoinPath: mac} {testsetplatform} { testsetplatform mac file join a {} b } {:a:b} test filename-8.17 {Tcl_JoinPath: mac} {testsetplatform} { testsetplatform mac file join a::: b } {a:::b} test filename-8.18 {Tcl_JoinPath: mac} {testsetplatform} { testsetplatform mac file join a : : : } {:a} test filename-8.19 {Tcl_JoinPath: mac} {testsetplatform} { testsetplatform mac file join : } {:} test filename-8.20 {Tcl_JoinPath: mac} {testsetplatform} { testsetplatform mac file join : a } {:a} test filename-8.21 {Tcl_JoinPath: mac} {testsetplatform} { testsetplatform mac file join a: :b/c } {a:b/c} test filename-8.22 {Tcl_JoinPath: mac} {testsetplatform} { testsetplatform mac file join :a :b/c } {:a:b/c} test filename-9.1 {Tcl_JoinPath: win} {testsetplatform} { testsetplatform win file join a b } {a/b} test filename-9.2 {Tcl_JoinPath: win} {testsetplatform} { testsetplatform win file join /a b } {/a/b} test filename-9.3 {Tcl_JoinPath: win} {testsetplatform} { testsetplatform win file join /a /b } {/b} test filename-9.4 {Tcl_JoinPath: win} {testsetplatform} { testsetplatform win file join c: foo } {c:foo} test filename-9.5 {Tcl_JoinPath: win} {testsetplatform} { testsetplatform win file join c:/ foo } {c:/foo} test filename-9.6 {Tcl_JoinPath: win} {testsetplatform} { testsetplatform win file join c:\\bar foo } {c:/bar/foo} test filename-9.7 {Tcl_JoinPath: win} {testsetplatform} { testsetplatform win file join /foo c:bar } {c:bar} test filename-9.8 {Tcl_JoinPath: win} {testsetplatform} { testsetplatform win file join ///host//share dir } {//host/share/dir} test filename-9.9 {Tcl_JoinPath: win} {testsetplatform} { testsetplatform win file join ~ foo } {~/foo} test filename-9.10 {Tcl_JoinPath: win} {testsetplatform} { testsetplatform win file join ~/~foo } {~/~foo} test filename-9.11 {Tcl_JoinPath: win} {testsetplatform} { testsetplatform win file join ~ ./~foo } {~/~foo} test filename-9.12 {Tcl_JoinPath: win} {testsetplatform} { testsetplatform win file join / ~foo } {~foo} test filename-9.13 {Tcl_JoinPath: win} {testsetplatform} { testsetplatform win file join ./a/ b c } {./a/b/c} test filename-9.14 {Tcl_JoinPath: win} {testsetplatform} { testsetplatform win file join ./~a/ b c } {./~a/b/c} test filename-9.15 {Tcl_JoinPath: win} {testsetplatform} { testsetplatform win file join // host share path } {/host/share/path} test filename-9.16 {Tcl_JoinPath: win} {testsetplatform} { testsetplatform win file join foo . bar } {foo/./bar} test filename-9.17 {Tcl_JoinPath: win} {testsetplatform} { testsetplatform win file join foo .. bar } {foo/../bar} test filename-9.18 {Tcl_JoinPath: win} {testsetplatform} { testsetplatform win file join foo/./bar } {foo/./bar} test filename-10.1 {Tcl_TranslateFileName} {testsetplatform} { testsetplatform unix list [catch {testtranslatefilename foo} msg] $msg } {0 foo} test filename-10.2 {Tcl_TranslateFileName} {testsetplatform} { testsetplatform windows list [catch {testtranslatefilename {c:/foo}} msg] $msg } {0 {c:\foo}} test filename-10.3 {Tcl_TranslateFileName} {testsetplatform} { testsetplatform windows list [catch {testtranslatefilename {c:/\\foo/}} msg] $msg } {0 {c:\foo}} test filename-10.4 {Tcl_TranslateFileName} {testsetplatform} { testsetplatform mac list [catch {testtranslatefilename foo} msg] $msg } {0 :foo} test filename-10.5 {Tcl_TranslateFileName} {testsetplatform} { testsetplatform mac list [catch {testtranslatefilename :~foo} msg] $msg } {0 :~foo} test filename-10.6 {Tcl_TranslateFileName} {testsetplatform} { global env set temp $env(HOME) set env(HOME) "/home/test" testsetplatform unix set result [list [catch {testtranslatefilename ~/foo} msg] $msg] set env(HOME) $temp set result } {0 /home/test/foo} test filename-10.7 {Tcl_TranslateFileName} {testsetplatform} { global env set temp $env(HOME) unset env(HOME) testsetplatform unix set result [list [catch {testtranslatefilename ~/foo} msg] $msg] set env(HOME) $temp set result } {1 {couldn't find HOME environment variable to expand path}} test filename-10.8 {Tcl_TranslateFileName} {testsetplatform} { global env set temp $env(HOME) set env(HOME) "/home/test" testsetplatform unix set result [list [catch {testtranslatefilename ~} msg] $msg] set env(HOME) $temp set result } {0 /home/test} test filename-10.9 {Tcl_TranslateFileName} {testsetplatform} { global env set temp $env(HOME) set env(HOME) "/home/test/" testsetplatform unix set result [list [catch {testtranslatefilename ~} msg] $msg] set env(HOME) $temp set result } {0 /home/test} test filename-10.10 {Tcl_TranslateFileName} {testsetplatform} { global env set temp $env(HOME) set env(HOME) "/home/test/" testsetplatform unix set result [list [catch {testtranslatefilename ~/foo} msg] $msg] set env(HOME) $temp set result } {0 /home/test/foo} test filename-10.11 {Tcl_TranslateFileName} {testsetplatform} { global env set temp $env(HOME) set env(HOME) "Root:" testsetplatform mac set result [list [catch {testtranslatefilename ~/foo} msg] $msg] set env(HOME) $temp set result } {0 Root:foo} test filename-10.12 {Tcl_TranslateFileName} {testsetplatform} { global env set temp $env(HOME) set env(HOME) "Root:home" testsetplatform mac set result [list [catch {testtranslatefilename ~/foo} msg] $msg] set env(HOME) $temp set result } {0 Root:home:foo} test filename-10.13 {Tcl_TranslateFileName} {testsetplatform} { global env set temp $env(HOME) set env(HOME) "Root:home" testsetplatform mac set result [list [catch {testtranslatefilename ~::foo} msg] $msg] set env(HOME) $temp set result } {0 Root:home::foo} test filename-10.14 {Tcl_TranslateFileName} {testsetplatform} { global env set temp $env(HOME) set env(HOME) "Root:home" testsetplatform mac set result [list [catch {testtranslatefilename ~} msg] $msg] set env(HOME) $temp set result } {0 Root:home} test filename-10.15 {Tcl_TranslateFileName} {testsetplatform} { global env set temp $env(HOME) set env(HOME) "Root:home:" testsetplatform mac set result [list [catch {testtranslatefilename ~::foo} msg] $msg] set env(HOME) $temp set result } {0 Root:home::foo} test filename-10.16 {Tcl_TranslateFileName} {testsetplatform} { global env set temp $env(HOME) set env(HOME) "Root:home::" testsetplatform mac set result [list [catch {testtranslatefilename ~::foo} msg] $msg] set env(HOME) $temp set result } {0 Root:home:::foo} test filename-10.17 {Tcl_TranslateFileName} {testsetplatform} { global env set temp $env(HOME) set env(HOME) "\\home\\" testsetplatform windows set result [list [catch {testtranslatefilename ~/foo} msg] $msg] set env(HOME) $temp set result } {0 {\home\foo}} test filename-10.18 {Tcl_TranslateFileName} {testsetplatform} { global env set temp $env(HOME) set env(HOME) "\\home\\" testsetplatform windows set result [list [catch {testtranslatefilename ~/foo\\bar} msg] $msg] set env(HOME) $temp set result } {0 {\home\foo\bar}} test filename-10.19 {Tcl_TranslateFileName} {testsetplatform} { global env set temp $env(HOME) set env(HOME) "c:" testsetplatform windows set result [list [catch {testtranslatefilename ~/foo} msg] $msg] set env(HOME) $temp set result } {0 c:foo} test filename-10.20 {Tcl_TranslateFileName} {testtranslatefilename} { list [catch {testtranslatefilename ~blorp/foo} msg] $msg } {1 {user "blorp" doesn't exist}} test filename-10.21 {Tcl_TranslateFileName} {testsetplatform} { global env set temp $env(HOME) set env(HOME) "c:\\" testsetplatform windows set result [list [catch {testtranslatefilename ~/foo} msg] $msg] set env(HOME) $temp set result } {0 {c:\foo}} test filename-10.22 {Tcl_TranslateFileName} {testsetplatform} { testsetplatform windows list [catch {testtranslatefilename foo//bar} msg] $msg } {0 {foo\bar}} if {[tcltest::testConstraint testsetplatform]} { testsetplatform $platform } test filename-10.23 {Tcl_TranslateFileName} {unixOnly nonPortable} { # this test fails if ~ouster is not /home/ouster list [catch {testtranslatefilename ~ouster} msg] $msg } {0 /home/ouster} test filename-10.24 {Tcl_TranslateFileName} {unixOnly nonPortable} { # this test fails if ~ouster is not /home/ouster list [catch {testtranslatefilename ~ouster/foo} msg] $msg } {0 /home/ouster/foo} test filename-11.1 {Tcl_GlobCmd} { list [catch {glob} msg] $msg } {1 {wrong # args: should be "glob ?switches? name ?name ...?"}} test filename-11.2 {Tcl_GlobCmd} { list [catch {glob -gorp} msg] $msg } {1 {bad option "-gorp": must be -directory, -join, -nocomplain, -path, -tails, -types, or --}} test filename-11.3 {Tcl_GlobCmd} { list [catch {glob -nocomplai} msg] $msg } {1 {wrong # args: should be "glob ?switches? name ?name ...?"}} test filename-11.4 {Tcl_GlobCmd} { list [catch {glob -nocomplain} msg] $msg } {1 {wrong # args: should be "glob ?switches? name ?name ...?"}} test filename-11.5 {Tcl_GlobCmd} { list [catch {glob -nocomplain ~xyqrszzz} msg] $msg } {0 {}} test filename-11.6 {Tcl_GlobCmd} { list [catch {glob ~xyqrszzz} msg] $msg } {1 {user "xyqrszzz" doesn't exist}} test filename-11.7 {Tcl_GlobCmd} { list [catch {glob -- -nocomplain} msg] $msg } {1 {no files matched glob pattern "-nocomplain"}} test filename-11.8 {Tcl_GlobCmd} { list [catch {glob -nocomplain -- -nocomplain} msg] $msg } {0 {}} test filename-11.9 {Tcl_GlobCmd} {testsetplatform} { testsetplatform unix list [catch {glob ~\\xyqrszzz/bar} msg] $msg } {1 {user "\xyqrszzz" doesn't exist}} test filename-11.10 {Tcl_GlobCmd} {testsetplatform} { testsetplatform unix list [catch {glob -nocomplain ~\\xyqrszzz/bar} msg] $msg } {0 {}} test filename-11.11 {Tcl_GlobCmd} {testsetplatform} { testsetplatform unix list [catch {glob ~xyqrszzz\\/\\bar} msg] $msg } {1 {user "xyqrszzz" doesn't exist}} test filename-11.12 {Tcl_GlobCmd} {testsetplatform} { testsetplatform unix set home $env(HOME) unset env(HOME) set x [list [catch {glob ~/*} msg] $msg] set env(HOME) $home set x } {1 {couldn't find HOME environment variable to expand path}} if {[tcltest::testConstraint testsetplatform]} { testsetplatform $platform } test filename-11.13 {Tcl_GlobCmd} { list [catch {file join [lindex [glob ~] 0]} msg] $msg } [list 0 [file join $env(HOME)]] set oldhome $env(HOME) set env(HOME) [pwd] file delete -force globTest file mkdir globTest/a1/b1 file mkdir globTest/a1/b2 file mkdir globTest/a2/b3 file mkdir globTest/a3 close [open globTest/x1.c w] close [open globTest/y1.c w] close [open globTest/z1.c w] close [open "globTest/weird name.c" w] close [open globTest/a1/b1/x2.c w] close [open globTest/a1/b2/y2.c w] catch {close [open globTest/.1 w]} catch {close [open globTest/x,z1.c w]} test filename-11.14 {Tcl_GlobCmd} { list [catch {glob ~/globTest} msg] $msg } [list 0 [list [file join $env(HOME) globTest]]] test filename-11.15 {Tcl_GlobCmd} { list [catch {glob ~\\/globTest} msg] $msg } [list 0 [list [file join $env(HOME) globTest]]] test filename-11.16 {Tcl_GlobCmd} { list [catch {glob globTest} msg] $msg } {0 globTest} set globname "globTest" set horribleglobname "glob\[\{Test" test filename-11.17 {Tcl_GlobCmd} {unixOnly} { list [catch {lsort [glob -directory $globname *]} msg] $msg } [list 0 [lsort [list [file join $globname a1] [file join $globname a2]\ [file join $globname a3]\ [file join $globname "weird name.c"]\ [file join $globname x,z1.c]\ [file join $globname x1.c]\ [file join $globname y1.c] [file join $globname z1.c]]]] test filename-11.17.1 {Tcl_GlobCmd} {pcOnly macOnly} { list [catch {lsort [glob -directory $globname *]} msg] $msg } [list 0 [lsort [list [file join $globname a1] [file join $globname a2]\ [file join $globname .1]\ [file join $globname a3]\ [file join $globname "weird name.c"]\ [file join $globname x,z1.c]\ [file join $globname x1.c]\ [file join $globname y1.c] [file join $globname z1.c]]]] test filename-11.18 {Tcl_GlobCmd} {unixOnly} { list [catch {lsort [glob -path $globname/ *]} msg] $msg } [list 0 [lsort [list [file join $globname a1] [file join $globname a2]\ [file join $globname a3]\ [file join $globname "weird name.c"]\ [file join $globname x,z1.c]\ [file join $globname x1.c]\ [file join $globname y1.c] [file join $globname z1.c]]]] test filename-11.18.1 {Tcl_GlobCmd} {pcOnly macOnly} { list [catch {lsort [glob -path $globname/ *]} msg] $msg } [list 0 [lsort [list [file join $globname a1] [file join $globname a2]\ [file join $globname .1]\ [file join $globname a3]\ [file join $globname "weird name.c"]\ [file join $globname x,z1.c]\ [file join $globname x1.c]\ [file join $globname y1.c] [file join $globname z1.c]]]] test filename-11.19 {Tcl_GlobCmd} {unixOnly} { list [catch {lsort [glob -join -path \ [string range $globname 0 5] * *]} msg] $msg } [list 0 [lsort [list [file join $globname a1] [file join $globname a2]\ [file join $globname a3]\ [file join $globname "weird name.c"]\ [file join $globname x,z1.c]\ [file join $globname x1.c]\ [file join $globname y1.c] [file join $globname z1.c]]]] test filename-11.19.1 {Tcl_GlobCmd} {pcOnly macOnly} { list [catch {lsort [glob -join -path \ [string range $globname 0 5] * *]} msg] $msg } [list 0 [lsort [list [file join $globname a1] [file join $globname a2]\ [file join $globname .1]\ [file join $globname a3]\ [file join $globname "weird name.c"]\ [file join $globname x,z1.c]\ [file join $globname x1.c]\ [file join $globname y1.c] [file join $globname z1.c]]]] test filename-11.20 {Tcl_GlobCmd} { list [catch {lsort [glob -type d -dir $globname *]} msg] $msg } [list 0 [lsort [list [file join $globname a1]\ [file join $globname a2]\ [file join $globname a3]]]] test filename-11.21 {Tcl_GlobCmd} { list [catch {lsort [glob -type d -path $globname *]} msg] $msg } [list 0 [lsort [list $globname]]] file rename globTest $horribleglobname set globname $horribleglobname test filename-11.22 {Tcl_GlobCmd} {unixOnly} { list [catch {lsort [glob -dir $globname *]} msg] $msg } [list 0 [lsort [list [file join $globname a1] [file join $globname a2]\ [file join $globname a3]\ [file join $globname "weird name.c"]\ [file join $globname x,z1.c]\ [file join $globname x1.c]\ [file join $globname y1.c] [file join $globname z1.c]]]] test filename-11.22.1 {Tcl_GlobCmd} {pcOnly macOnly} { list [catch {lsort [glob -dir $globname *]} msg] $msg } [list 0 [lsort [list [file join $globname a1] [file join $globname a2]\ [file join $globname .1]\ [file join $globname a3]\ [file join $globname "weird name.c"]\ [file join $globname x,z1.c]\ [file join $globname x1.c]\ [file join $globname y1.c] [file join $globname z1.c]]]] test filename-11.23 {Tcl_GlobCmd} {unixOnly} { list [catch {lsort [glob -path $globname/ *]} msg] $msg } [list 0 [lsort [list [file join $globname a1] [file join $globname a2]\ [file join $globname a3]\ [file join $globname "weird name.c"]\ [file join $globname x,z1.c]\ [file join $globname x1.c]\ [file join $globname y1.c] [file join $globname z1.c]]]] test filename-11.23.1 {Tcl_GlobCmd} {pcOnly macOnly} { list [catch {lsort [glob -path $globname/ *]} msg] $msg } [list 0 [lsort [list [file join $globname a1] [file join $globname a2]\ [file join $globname .1]\ [file join $globname a3]\ [file join $globname "weird name.c"]\ [file join $globname x,z1.c]\ [file join $globname x1.c]\ [file join $globname y1.c] [file join $globname z1.c]]]] test filename-11.24 {Tcl_GlobCmd} {unixOnly} { list [catch {lsort [glob -join -path \ [string range $globname 0 5] * *]} msg] $msg } [list 0 [lsort [list [file join $globname a1] [file join $globname a2]\ [file join $globname a3]\ [file join $globname "weird name.c"]\ [file join $globname x,z1.c]\ [file join $globname x1.c]\ [file join $globname y1.c] [file join $globname z1.c]]]] test filename-11.24.1 {Tcl_GlobCmd} {pcOnly macOnly} { list [catch {lsort [glob -join -path \ [string range $globname 0 5] * *]} msg] $msg } [list 0 [lsort [list [file join $globname a1] [file join $globname a2]\ [file join $globname .1]\ [file join $globname a3]\ [file join $globname "weird name.c"]\ [file join $globname x,z1.c]\ [file join $globname x1.c]\ [file join $globname y1.c] [file join $globname z1.c]]]] test filename-11.25 {Tcl_GlobCmd} { list [catch {lsort [glob -type d -dir $globname *]} msg] $msg } [list 0 [lsort [list [file join $globname a1]\ [file join $globname a2]\ [file join $globname a3]]]] test filename-11.26 {Tcl_GlobCmd} { list [catch {glob -type d -path $globname *} msg] $msg } [list 0 [list $globname]] test filename-11.27 {Tcl_GlobCmd} { list [catch {glob -types abcde *} msg] $msg } {1 {bad argument to "-types": abcde}} test filename-11.28 {Tcl_GlobCmd} { list [catch {glob -types z *} msg] $msg } {1 {bad argument to "-types": z}} test filename-11.29 {Tcl_GlobCmd} { list [catch {glob -types {abcd efgh} *} msg] $msg } {1 {only one MacOS type or creator argument to "-types" allowed}} test filename-11.30 {Tcl_GlobCmd} { list [catch {glob -types {{macintosh type TEXT} \ {macintosh creator ALFA} efgh} *} msg] $msg } {1 {only one MacOS type or creator argument to "-types" allowed}} test filename-11.31 {Tcl_GlobCmd} { list [catch {glob -types} msg] $msg } {1 {missing argument to "-types"}} test filename-11.32 {Tcl_GlobCmd} { list [catch {glob -path hello -dir hello *} msg] $msg } {1 {"-directory" cannot be used with "-path"}} test filename-11.33 {Tcl_GlobCmd} { list [catch {glob -path} msg] $msg } {1 {missing argument to "-path"}} test filename-11.34 {Tcl_GlobCmd} { list [catch {glob -direct} msg] $msg } {1 {missing argument to "-directory"}} test filename-11.35 {Tcl_GlobCmd} { list [catch {glob -paths *} msg] $msg } {1 {bad option "-paths": must be -directory, -join, -nocomplain, -path, -tails, -types, or --}} file rename $horribleglobname globTest set globname globTest unset horribleglobname test filename-12.1 {simple globbing} {unixOrPc} { list [catch {glob {}} msg] $msg } {0 .} test filename-12.2 {simple globbing} {macOnly} { list [catch {glob {}} msg] $msg } {0 :} test filename-12.3 {simple globbing} { list [catch {glob -nocomplain \{a1,a2\}} msg] $msg } {0 {}} if {$tcl_platform(platform) == "macintosh"} { set globPreResult :globTest: } else { set globPreResult globTest/ } set x1 x1.c set y1 y1.c test filename-12.4 {simple globbing} {unixOrPc} { lsort [glob globTest/x1.c globTest/y1.c globTest/foo] } "$globPreResult$x1 $globPreResult$y1" test filename-12.5 {simple globbing} { list [catch {glob globTest\\/x1.c} msg] $msg } "0 $globPreResult$x1" test filename-12.6 {simple globbing} { list [catch {glob globTest\\/\\x1.c} msg] $msg } "0 $globPreResult$x1" test filename-13.1 {globbing with brace substitution} { list [catch {glob globTest/\{\}} msg] $msg } "0 $globPreResult" test filename-13.2 {globbing with brace substitution} { list [catch {glob globTest/\{} msg] $msg } {1 {unmatched open-brace in file name}} test filename-13.3 {globbing with brace substitution} { list [catch {glob globTest/\{\\\}} msg] $msg } {1 {unmatched open-brace in file name}} test filename-13.4 {globbing with brace substitution} { list [catch {glob globTest/\{\\} msg] $msg } {1 {unmatched open-brace in file name}} test filename-13.5 {globbing with brace substitution} { list [catch {glob globTest/\}} msg] $msg } {1 {unmatched close-brace in file name}} test filename-13.6 {globbing with brace substitution} { list [catch {glob globTest/\{\}x1.c} msg] $msg } "0 $globPreResult$x1" test filename-13.7 {globbing with brace substitution} { list [catch {glob globTest/\{x\}1.c} msg] $msg } "0 $globPreResult$x1" test filename-13.8 {globbing with brace substitution} { list [catch {glob globTest/\{x\{\}\}1.c} msg] $msg } "0 $globPreResult$x1" test filename-13.9 {globbing with brace substitution} { list [lsort [catch {glob globTest/\{x,y\}1.c} msg]] $msg } [list 0 [list $globPreResult$x1 $globPreResult$y1]] test filename-13.10 {globbing with brace substitution} { list [lsort [catch {glob globTest/\{x,,y\}1.c} msg]] $msg } [list 0 [list $globPreResult$x1 $globPreResult$y1]] test filename-13.11 {globbing with brace substitution} {unixOrPc} { list [lsort [catch {glob globTest/\{x,x\\,z,z\}1.c} msg]] $msg } {0 {globTest/x1.c globTest/x,z1.c globTest/z1.c}} test filename-13.12 {globbing with brace substitution} {macOnly} { list [lsort [catch {glob globTest/\{x,x\\,z,z\}1.c} msg]] $msg } {0 {:globTest:x1.c :globTest:x,z1.c :globTest:z1.c}} test filename-13.13 {globbing with brace substitution} { lsort [glob globTest/{a,b,x,y}1.c] } [list $globPreResult$x1 $globPreResult$y1] test filename-13.14 {globbing with brace substitution} {unixOrPc} { lsort [glob {globTest/{x1,y2,weird name}.c}] } {{globTest/weird name.c} globTest/x1.c} test filename-13.15 {globbing with brace substitution} {macOnly} { lsort [glob {globTest/{x1,y2,weird name}.c}] } {{:globTest:weird name.c} :globTest:x1.c} test filename-13.16 {globbing with brace substitution} {unixOrPc} { lsort [glob globTest/{x1.c,a1/*}] } {globTest/a1/b1 globTest/a1/b2 globTest/x1.c} test filename-13.17 {globbing with brace substitution} {macOnly} { lsort [glob globTest/{x1.c,a1/*}] } {:globTest:a1:b1 :globTest:a1:b2 :globTest:x1.c} test filename-13.18 {globbing with brace substitution} {unixOrPc} { lsort [glob globTest/{x1.c,{a},a1/*}] } {globTest/a1/b1 globTest/a1/b2 globTest/x1.c} test filename-13.19 {globbing with brace substitution} {macOnly} { lsort [glob globTest/{x1.c,{a},a1/*}] } {:globTest:a1:b1 :globTest:a1:b2 :globTest:x1.c} test filename-13.20 {globbing with brace substitution} {unixOrPc} { lsort [glob globTest/{a,x}1/*/{x,y}*] } {globTest/a1/b1/x2.c globTest/a1/b2/y2.c} test filename-13.21 {globbing with brace substitution} {macOnly} { lsort [glob globTest/{a,x}1/*/{x,y}*] } {:globTest:a1:b1:x2.c :globTest:a1:b2:y2.c} test filename-13.22 {globbing with brace substitution} { list [catch {glob globTest/\{a,x\}1/*/\{} msg] $msg } {1 {unmatched open-brace in file name}} test filename-14.1 {asterisks, question marks, and brackets} {unixOrPc} { lsort [glob glo*/*.c] } {{globTest/weird name.c} globTest/x,z1.c globTest/x1.c globTest/y1.c globTest/z1.c} test filename-14.2 {asterisks, question marks, and brackets} {macOnly} { lsort [glob glo*/*.c] } {{:globTest:weird name.c} :globTest:x,z1.c :globTest:x1.c :globTest:y1.c :globTest:z1.c} test filename-14.3 {asterisks, question marks, and brackets} {unixOrPc} { lsort [glob globTest/?1.c] } {globTest/x1.c globTest/y1.c globTest/z1.c} test filename-14.4 {asterisks, question marks, and brackets} {macOnly} { lsort [glob globTest/?1.c] } {:globTest:x1.c :globTest:y1.c :globTest:z1.c} test filename-14.5 {asterisks, question marks, and brackets} {unixOrPc} { lsort [glob */*/*/*.c] } {globTest/a1/b1/x2.c globTest/a1/b2/y2.c} test filename-14.6 {asterisks, question marks, and brackets} {macOnly} { lsort [glob */*/*/*.c] } {:globTest:a1:b1:x2.c :globTest:a1:b2:y2.c} test filename-14.7 {asterisks, question marks, and brackets} {unixOnly} { lsort [glob globTest/*] } {globTest/a1 globTest/a2 globTest/a3 {globTest/weird name.c} globTest/x,z1.c globTest/x1.c globTest/y1.c globTest/z1.c} test filename-14.7.1 {asterisks, question marks, and brackets} {pcOnly} { lsort [glob globTest/*] } {globTest/.1 globTest/a1 globTest/a2 globTest/a3 {globTest/weird name.c} globTest/x,z1.c globTest/x1.c globTest/y1.c globTest/z1.c} test filename-14.8 {asterisks, question marks, and brackets} {macOnly} { lsort [glob globTest/*] } {:globTest:.1 :globTest:a1 :globTest:a2 :globTest:a3 {:globTest:weird name.c} :globTest:x,z1.c :globTest:x1.c :globTest:y1.c :globTest:z1.c} test filename-14.9 {asterisks, question marks, and brackets} {unixOrPc} { lsort [glob globTest/.*] } {globTest/. globTest/.. globTest/.1} test filename-14.10 {asterisks, question marks, and brackets} {macOnly} { lsort [glob globTest/.*] } {:globTest:.1} test filename-14.11 {asterisks, question marks, and brackets} {unixOrPc} { lsort [glob globTest/*/*] } {globTest/a1/b1 globTest/a1/b2 globTest/a2/b3} test filename-14.12 {asterisks, question marks, and brackets} {macOnly} { lsort [glob globTest/*/*] } {:globTest:a1:b1 :globTest:a1:b2 :globTest:a2:b3} test filename-14.13 {asterisks, question marks, and brackets} {unixOrPc} { lsort [glob {globTest/[xyab]1.*}] } {globTest/x1.c globTest/y1.c} test filename-14.14 {asterisks, question marks, and brackets} {macOnly} { lsort [glob {globTest/[xyab]1.*}] } {:globTest:x1.c :globTest:y1.c} test filename-14.15 {asterisks, question marks, and brackets} {unixOrPc} { lsort [glob globTest/*/] } {globTest/a1/ globTest/a2/ globTest/a3/} test filename-14.16 {asterisks, question marks, and brackets} {macOnly} { lsort [glob globTest/*/] } {:globTest:a1: :globTest:a2: :globTest:a3:} test filename-14.17 {asterisks, question marks, and brackets} { global env set temp $env(HOME) set env(HOME) [file join $env(HOME) globTest] set result [list [catch {glob ~/z*} msg] $msg] set env(HOME) $temp set result } [list 0 [list [file join $env(HOME) globTest z1.c]]] test filename-14.18 {asterisks, question marks, and brackets} {unixOrPc} { list [catch {lsort [glob globTest/*.c goo/*]} msg] $msg } {0 {{globTest/weird name.c} globTest/x,z1.c globTest/x1.c globTest/y1.c globTest/z1.c}} test filename-14.19 {asterisks, question marks, and brackets} {macOnly} { list [catch {lsort [glob globTest/*.c goo/*]} msg] $msg } {0 {{:globTest:weird name.c} :globTest:x,z1.c :globTest:x1.c :globTest:y1.c :globTest:z1.c}} test filename-14.20 {asterisks, question marks, and brackets} { list [catch {glob -nocomplain goo/*} msg] $msg } {0 {}} test filename-14.21 {asterisks, question marks, and brackets} { list [catch {glob globTest/*/gorp} msg] $msg } {1 {no files matched glob pattern "globTest/*/gorp"}} test filename-14.22 {asterisks, question marks, and brackets} { list [catch {glob goo/* x*z foo?q} msg] $msg } {1 {no files matched glob patterns "goo/* x*z foo?q"}} test filename-14.23 {slash globbing} {unixOrPc} { glob / } / test filename-14.24 {slash globbing} {pcOnly} { glob {\\} } / test filename-14.25 {type specific globbing} {unixOnly} { list [catch {lsort [glob -dir globTest -types f *]} msg] $msg } [list 0 [lsort [list \ [file join $globname "weird name.c"]\ [file join $globname x,z1.c]\ [file join $globname x1.c]\ [file join $globname y1.c] [file join $globname z1.c]]]] test filename-14.25.1 {type specific globbing} {pcOnly macOnly} { list [catch {lsort [glob -dir globTest -types f *]} msg] $msg } [list 0 [lsort [list \ [file join $globname .1]\ [file join $globname "weird name.c"]\ [file join $globname x,z1.c]\ [file join $globname x1.c]\ [file join $globname y1.c] [file join $globname z1.c]]]] test filename-14.26 {type specific globbing} { list [catch {glob -nocomplain -dir globTest -types {readonly} *} msg] $msg } [list 0 {}] unset globname # The following tests are only valid for Unix systems. # On some systems, like AFS, "000" protection doesn't prevent # access by owner, so the following test is not portable. catch {exec chmod 000 globTest/a1} test filename-15.1 {unix specific globbing} {unixOnly nonPortable} { string tolower [list [catch {glob globTest/a1/*} msg] $msg $errorCode] } {1 {couldn't read directory "globtest/a1": permission denied} {posix eacces {permission denied}}} test filename-15.2 {unix specific no complain: no errors} {unixOnly nonPortable} { glob -nocomplain globTest/a1/* } {} test filename-15.3 {unix specific no complain: no errors, good result} \ {unixOnly nonPortable knownBug} { # test fails because if an error occur , the interp's result # is reset... glob -nocomplain globTest/a2 globTest/a1/* globTest/a3 } {globTest/a2 globTest/a3} catch {exec chmod 755 globTest/a1} test filename-15.4 {unix specific no complain: no errors, good result} \ {unixOnly nonPortable knownBug} { # test fails because if an error occurs, the interp's result # is reset... or you don't run at scriptics where the # outser and welch users exists glob -nocomplain ~ouster ~foo ~welch } {/home/ouster /home/welch} test filename-15.5 {unix specific globbing} {unixOnly nonPortable} { glob ~ouster/.csh* } "/home/ouster/.cshrc" catch {close [open globTest/odd\\\[\]*?\{\}name w]} test filename-15.6 {unix specific globbing} {unixOnly} { global env set temp $env(HOME) set env(HOME) $env(HOME)/globTest/odd\\\[\]*?\{\}name set result [list [catch {glob ~} msg] $msg] set env(HOME) $temp set result } [list 0 [list [glob ~]/globTest/odd\\\[\]*?\{\}name]] catch {exec rm -f globTest/odd\\\[\]*?\{\}name} # The following tests are only valid for Windows systems. set oldDir [pwd] if {$::tcltest::testConstraints(pcOnly)} { cd c:/ file delete -force globTest file mkdir globTest close [open globTest/x1.BAT w] close [open globTest/y1.Bat w] close [open globTest/z1.bat w] } test filename-16.1 {windows specific globbing} {pcOnly} { lsort [glob globTest/*.bat] } {globTest/x1.BAT globTest/y1.Bat globTest/z1.bat} test filename-16.2 {windows specific globbing} {pcOnly} { glob c: } c: test filename-16.3 {windows specific globbing} {pcOnly} { glob c:\\\\ } c:/ test filename-16.4 {windows specific globbing} {pcOnly} { glob c:/ } c:/ test filename-16.5 {windows specific globbing} {pcOnly} { glob c:*Test } c:globTest test filename-16.6 {windows specific globbing} {pcOnly} { glob c:\\\\*Test } c:/globTest test filename-16.7 {windows specific globbing} {pcOnly} { glob c:/*Test } c:/globTest test filename-16.8 {windows specific globbing} {pcOnly} { lsort [glob c:globTest/*.bat] } {c:globTest/x1.BAT c:globTest/y1.Bat c:globTest/z1.bat} test filename-16.9 {windows specific globbing} {pcOnly} { lsort [glob c:/globTest/*.bat] } {c:/globTest/x1.BAT c:/globTest/y1.Bat c:/globTest/z1.bat} test filename-16.10 {windows specific globbing} {pcOnly} { lsort [glob c:globTest\\\\*.bat] } {c:globTest/x1.BAT c:globTest/y1.Bat c:globTest/z1.bat} test filename-16.11 {windows specific globbing} {pcOnly} { lsort [glob c:\\\\globTest\\\\*.bat] } {c:/globTest/x1.BAT c:/globTest/y1.Bat c:/globTest/z1.bat} # some tests require a shared C drive if {[catch {cd //[info hostname]/c}]} { set ::tcltest::testConstraints(sharedCdrive) 0 } else { set ::tcltest::testConstraints(sharedCdrive) 1 } test filename-16.12 {windows specific globbing} {pcOnly sharedCdrive} { cd //[info hostname]/c glob //[info hostname]/c/*Test } //[info hostname]/c/globTest test filename-16.13 {windows specific globbing} {pcOnly sharedCdrive} { cd //[info hostname]/c glob "\\\\\\\\[info hostname]\\\\c\\\\*Test" } //[info hostname]/c/globTest # cleanup file delete -force C:/globTest cd $oldDir file delete -force globTest set env(HOME) $oldhome if {[tcltest::testConstraint testsetplatform]} { testsetplatform $platform catch {unset platform} } catch {unset oldhome temp result} ::tcltest::cleanupTests return |
Added tests/macFCmd.test.
> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 | # This file tests the tclfCmd.c file. # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1997 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id: macFCmd.test,v 1.1.1.1 2001/08/03 16:19:04 vincentdarley Exp $ # if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest namespace import -force ::tcltest::* } catch {file delete -force foo.dir} file mkdir foo.dir if {[catch {file attributes foo.dir -readonly 1}]} { set ::tcltest::testConstraints(fileSharing) 0 set ::tcltest::testConstraints(notFileSharing) 1 } else { set ::tcltest::testConstraints(fileSharing) 1 set ::tcltest::testConstraints(notFileSharing) 0 } file delete -force foo.dir test macFCmd-1.1 {GetFileFinderAttributes - no file} {macOnly} { catch {file delete -force foo.file} list [catch {file attributes foo.file -creator} msg] $msg } {1 {could not read ":foo.file": no such file or directory}} test macFCmd-1.2 {GetFileFinderAttributes - creator} {macOnly} { catch {file delete -force foo.file} catch {close [open foo.file w]} list [catch {file attributes foo.file -creator} msg] $msg \ [file delete -force foo.file] } {0 {MPW } {}} test macFCmd-1.3 {GetFileFinderAttributes - type} {macOnly} { catch {file delete -force foo.file} catch {close [open foo.file w]} list [catch {file attributes foo.file -type} msg] $msg \ [file delete -force foo.file] } {0 TEXT {}} test macFCmd-1.4 {GetFileFinderAttributes - not hidden} {macOnly} { catch {file delete -force foo.file} catch {close [open foo.file w]} list [catch {file attributes foo.file -hidden} msg] $msg \ [file delete -force foo.file] } {0 0 {}} test macFCmd-1.5 {GetFileFinderAttributes - hidden} {macOnly} { catch {file delete -force foo.file} catch {close [open foo.file w]} file attributes foo.file -hidden 1 list [catch {file attributes foo.file -hidden} msg] $msg \ [file delete -force foo.file] } {0 1 {}} test macFCmd-1.6 {GetFileFinderAttributes - folder creator} {macOnly} { catch {file delete -force foo.dir} file mkdir foo.dir list [catch {file attributes foo.dir -creator} msg] $msg \ [file delete -force foo.dir] } {0 Fldr {}} test macFCmd-1.7 {GetFileFinderAttributes - folder type} {macOnly} { catch {file delete -force foo.dir} file mkdir foo.dir list [catch {file attributes foo.dir -type} msg] $msg \ [file delete -force foo.dir] } {0 Fldr {}} test macFCmd-1.8 {GetFileFinderAttributes - folder hidden} {macOnly} { catch {file delete -force foo.dir} file mkdir foo.dir list [catch {file attributes foo.dir -hidden} msg] $msg \ [file delete -force foo.dir] } {0 0 {}} test macFCmd-2.1 {GetFileReadOnly - bad file} {macOnly} { catch {file delete -force foo.file} list [catch {file attributes foo.file -readonly} msg] $msg } {1 {could not read ":foo.file": no such file or directory}} test macFCmd-2.2 {GetFileReadOnly - file not read only} {macOnly} { catch {file delete -force foo.file} close [open foo.file w] list [catch {file attributes foo.file -readonly} msg] $msg \ [file delete -force foo.file] } {0 0 {}} test macFCmd-2.3 {GetFileReadOnly - file read only} {macOnly} { catch {file delete -force foo.file} close [open foo.file w] file attributes foo.file -readonly 1 list [catch {file attributes foo.file -readonly} msg] $msg \ [file delete -force foo.file] } {0 1 {}} test macFCmd-2.4 {GetFileReadOnly - directory not read only} {macOnly} { catch {file delete -force foo.dir} file mkdir foo.dir list [catch {file attributes foo.dir -readonly} msg] $msg \ [file delete -force foo.dir] } {0 0 {}} test macFCmd-2.5 {GetFileReadOnly - directory read only} {macOnly fileSharing} { catch {file delete -force foo.dir} file mkdir foo.dir file attributes foo.dir -readonly 1 list [catch {file attributes foo.dir -readonly} msg] $msg \ [file delete -force foo.dir] } {0 1 {}} test macFCmd-3.1 {SetFileFinderAttributes - bad file} {macOnly} { catch {file delete -force foo.file} list [catch {file attributes foo.file -creator FOOO} msg] $msg } {1 {could not read ":foo.file": no such file or directory}} test macFCmd-3.2 {SetFileFinderAttributes - creator} {macOnly} { catch {file delete -force foo.file} close [open foo.file w] list [catch {file attributes foo.file -creator FOOO} msg] $msg \ [file attributes foo.file -creator] [file delete -force foo.file] } {0 {} FOOO {}} test macFCmd-3.3 {SetFileFinderAttributes - bad creator} {macOnly} { catch {file delete -force foo.file} close [open foo.file w] list [catch {file attributes foo.file -creator 0} msg] $msg \ [file delete -force foo.file] } {1 {expected Macintosh OS type but got "0"} {}} test macFCmd-3.4 {SetFileFinderAttributes - hidden} {macOnly} { catch {file delete -force foo.file} close [open foo.file w] list [catch {file attributes foo.file -hidden 1} msg] $msg \ [file attributes foo.file -hidden] [file delete -force foo.file] } {0 {} 1 {}} test macFCmd-3.5 {SetFileFinderAttributes - type} {macOnly} { catch {file delete -force foo.file} close [open foo.file w] list [catch {file attributes foo.file -type FOOO} msg] $msg \ [file attributes foo.file -type] [file delete -force foo.file] } {0 {} FOOO {}} test macFCmd-3.6 {SetFileFinderAttributes - bad type} {macOnly} { catch {file delete -force foo.file} close [open foo.file w] list [catch {file attributes foo.file -type 0} msg] $msg \ [file delete -force foo.file] } {1 {expected Macintosh OS type but got "0"} {}} test macFCmd-3.7 {SetFileFinderAttributes - directory} {macOnly} { catch {file delete -force foo.dir} file mkdir foo.dir list [catch {file attributes foo.dir -creator FOOO} msg] \ $msg [file delete -force foo.dir] } {1 {cannot set -creator: ":foo.dir" is a directory} {}} test macFCmd-4.1 {SetFileReadOnly - bad file} {macOnly} { catch {file delete -force foo.file} list [catch {file attributes foo.file -readonly 1} msg] $msg } {1 {could not read ":foo.file": no such file or directory}} test macFCmd-4.2 {SetFileReadOnly - file not readonly} {macOnly} { catch {file delete -force foo.file} close [open foo.file w] list [catch {file attributes foo.file -readonly 0} msg] \ $msg [file attributes foo.file -readonly] [file delete -force foo.file] } {0 {} 0 {}} test macFCmd-4.3 {SetFileReadOnly - file readonly} {macOnly} { catch {file delete -force foo.file} close [open foo.file w] list [catch {file attributes foo.file -readonly 1} msg] \ $msg [file attributes foo.file -readonly] [file delete -force foo.file] } {0 {} 1 {}} test macFCmd-4.4 {SetFileReadOnly - directory not readonly} \ {macOnly fileSharing} { catch {file delete -force foo.dir} file mkdir foo.dir list [catch {file attributes foo.dir -readonly 0} msg] \ $msg [file attributes foo.dir -readonly] [file delete -force foo.dir] } {0 {} 0 {}} test macFCmd-4.5 {SetFileReadOnly - directory not readonly} \ {macOnly notFileSharing} { catch {file delete -force foo.dir} file mkdir foo.dir list [catch {file attributes foo.dir -readonly 0} msg] $msg \ [file delete -force foo.dir] } {1 {cannot set a directory to read-only when File Sharing is turned off} {}} test macFCmd-4.6 {SetFileReadOnly - directory readonly} {macOnly fileSharing} { catch {file delete -force foo.dir} file mkdir foo.dir list [catch {file attributes foo.dir -readonly 1} msg] $msg \ [file attributes foo.dir -readonly] [file delete -force foo.dir] } {0 {} 1 {}} test macFCmd-4.7 {SetFileReadOnly - directory readonly} {macOnly notFileSharing} { catch {file delete -force foo.dir} file mkdir foo.dir list [catch {file attributes foo.dir -readonly 1} msg] $msg \ [file delete -force foo.dir] } {1 {cannot set a directory to read-only when File Sharing is turned off} {}} # cleanup ::tcltest::cleanupTests return |
Added tests/unixFCmd.test.
> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 | # This file tests the tclUnixFCmd.c file. # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1996 Sun Microsystems, Inc. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id: unixFCmd.test,v 1.1.1.1 2001/08/03 16:19:04 vincentdarley Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest namespace import -force ::tcltest::* } # Several tests require need to match results against the unix username set user {} if {$tcl_platform(platform) == "unix"} { catch {set user [exec whoami]} if {$user == ""} { catch {regexp {^[^(]*\(([^)]*)\)} [exec id] dummy user} } if {$user == ""} { set user "root" } } proc openup {path} { testchmod 777 $path if {[file isdirectory $path]} { catch { foreach p [glob -directory $path *] { openup $p } } } } proc cleanup {args} { foreach p ". $args" { set x "" catch { set x [glob -directory $p tf* td*] } foreach file $x { if {[catch {file delete -force -- $file}]} { openup $file file delete -force -- $file } } } } test unixFCmd-1.1 {TclpRenameFile: EACCES} {unixOnly notRoot} { cleanup file mkdir td1/td2/td3 exec chmod 000 td1/td2 set msg [list [catch {file rename td1/td2/td3 td2} msg] $msg] exec chmod 755 td1/td2 set msg } {1 {error renaming "td1/td2/td3": permission denied}} test unixFCmd-1.2 {TclpRenameFile: EEXIST} {unixOnly notRoot} { cleanup file mkdir td1/td2 file mkdir td2 list [catch {file rename td2 td1} msg] $msg } {1 {error renaming "td2" to "td1/td2": file already exists}} test unixFCmd-1.3 {TclpRenameFile: EINVAL} {unixOnly notRoot} { cleanup file mkdir td1 list [catch {file rename td1 td1} msg] $msg } {1 {error renaming "td1" to "td1/td1": trying to rename a volume or move a directory into itself}} test unixFCmd-1.4 {TclpRenameFile: EISDIR} {emptyTest unixOnly notRoot} { # can't make it happen } {} test unixFCmd-1.5 {TclpRenameFile: ENOENT} {unixOnly notRoot} { cleanup file mkdir td1 list [catch {file rename td2 td1} msg] $msg } {1 {error renaming "td2": no such file or directory}} test unixFCmd-1.6 {TclpRenameFile: ENOTDIR} {emptyTest unixOnly notRoot} { # can't make it happen } {} test unixFCmd-1.7 {TclpRenameFile: EXDEV} {unixOnly notRoot} { cleanup file mkdir foo/bar file attr foo -perm 040555 set catchResult [catch {file rename foo/bar /tmp} msg] set msg [lindex [split $msg :] end] catch {file delete /tmp/bar} catch {file attr foo -perm 040777} catch {file delete -force foo} list $catchResult $msg } {1 { permission denied}} test unixFCmd-1.8 {Checking EINTR Bug} {unixOnly notRoot nonPortable} { testalarm after 2000 list [testgotsig] [testgotsig] } {1 0} test unixFCmd-1.9 {Checking EINTR Bug} {unixOnly notRoot nonPortable} { cleanup set f [open tfalarm w] puts $f { after 2000 puts "hello world" exit 0 } close $f testalarm set pipe [open "|[info nameofexecutable] tfalarm" r+] set line [read $pipe 1] catch {close $pipe} list $line [testgotsig] } {h 1} test unixFCmd-2.1 {TclpCopyFile: target exists: lstat(dst) == 0} \ {unixOnly notRoot} { cleanup exec touch tf1 exec touch tf2 file copy -force tf1 tf2 } {} test unixFCmd-2.2 {TclpCopyFile: src is symlink} {unixOnly notRoot} { cleanup exec ln -s tf1 tf2 file copy tf2 tf3 file type tf3 } {link} test unixFCmd-2.3 {TclpCopyFile: src is block} {unixOnly notRoot} { cleanup set null "/dev/null" while {[file type $null] != "characterSpecial"} { set null [file join [file dirname $null] [file readlink $null]] } # file copy $null tf1 } {} test unixFCmd-2.4 {TclpCopyFile: src is fifo} {unixOnly notRoot} { cleanup if [catch {exec mknod tf1 p}] { list 1 } else { file copy tf1 tf2 expr {"[file type tf1]" == "[file type tf2]"} } } {1} test unixFCmd-2.5 {TclpCopyFile: copy attributes} {unixOnly notRoot} { cleanup exec touch tf1 exec chmod 472 tf1 file copy tf1 tf2 string range [exec ls -l tf2] 0 9 } {-r--rwx-w-} test unixFCmd-3.1 {CopyFile not done} {emptyTest unixOnly notRoot} { } {} test unixFCmd-4.1 {TclpDeleteFile not done} {emptyTest unixOnly notRoot} { } {} test unixFCmd-5.1 {TclpCreateDirectory not done} {emptyTest unixOnly notRoot} { } {} test unixFCmd-6.1 {TclpCopyDirectory not done} {emptyTest unixOnly notRoot} { } {} test unixFCmd-7.1 {TclpRemoveDirectory not done} {emptyTest unixOnly notRoot} { } {} test unixFCmd-8.1 {TraverseUnixTree not done} {emptyTest unixOnly notRoot} { } {} test unixFCmd-9.1 {TraversalCopy not done} {emptyTest unixOnly notRoot} { } {} test unixFCmd-10.1 {TraversalDelete not done} {emptyTest unixOnly notRoot} { } {} test unixFCmd-11.1 {CopyFileAttrs not done} {emptyTest unixOnly notRoot} { } {} test unixFCmd-12.1 {GetGroupAttribute - file not found} {unixOnly notRoot} { catch {file delete -force -- foo.test} list [catch {file attributes foo.test -group} msg] $msg } {1 {could not read "foo.test": no such file or directory}} test unixFCmd-12.2 {GetGroupAttribute - file found} {unixOnly notRoot} { catch {file delete -force -- foo.test} close [open foo.test w] list [catch {file attributes foo.test -group}] [file delete -force -- foo.test] } {0 {}} test unixFCmd-13.1 {GetOwnerAttribute - file not found} {unixOnly notRoot} { catch {file delete -force -- foo.test} list [catch {file attributes foo.test -group} msg] $msg } {1 {could not read "foo.test": no such file or directory}} test unixFCmd-13.2 {GetOwnerAttribute} {unixOnly notRoot} { catch {file delete -force -- foo.test} close [open foo.test w] list [catch {file attributes foo.test -owner} msg] \ [string compare $msg $user] [file delete -force -- foo.test] } {0 0 {}} test unixFCmd-14.1 {GetPermissionsAttribute - file not found} {unixOnly notRoot} { catch {file delete -force -- foo.test} list [catch {file attributes foo.test -permissions} msg] $msg } {1 {could not read "foo.test": no such file or directory}} test unixFCmd-14.2 {GetPermissionsAttribute} {unixOnly notRoot} { catch {file delete -force -- foo.test} close [open foo.test w] list [catch {file attribute foo.test -permissions}] \ [file delete -force -- foo.test] } {0 {}} # Find a group that exists on this system, or else skip tests that require # groups set ::tcltest::testConstraints(foundGroup) 0 catch { set groupList [exec groups] set group [lindex $groupList 0] set ::tcltest::testConstraints(foundGroup) 1 } #groups hard to test test unixFCmd-15.1 {SetGroupAttribute - invalid group} {unixOnly notRoot} { catch {file delete -force -- foo.test} list [catch {file attributes foo.test -group foozzz} msg] \ $msg [file delete -force -- foo.test] } {1 {could not set group for file "foo.test": group "foozzz" does not exist} {}} test unixFCmd-15.2 {SetGroupAttribute - invalid file} \ {unixOnly notRoot foundGroup} { catch {file delete -force -- foo.test} list [catch {file attributes foo.test -group $group} msg] $msg } {1 {could not set group for file "foo.test": no such file or directory}} #changing owners hard to do test unixFCmd-16.1 {SetOwnerAttribute - current owner} {unixOnly notRoot} { catch {file delete -force -- foo.test} close [open foo.test w] list [catch {file attributes foo.test -owner $user} msg] \ $msg [string compare [file attributes foo.test -owner] $user] \ [file delete -force -- foo.test] } {0 {} 0 {}} test unixFCmd-16.2 {SetOwnerAttribute - invalid file} {unixOnly notRoot} { catch {file delete -force -- foo.test} list [catch {file attributes foo.test -owner $user} msg] $msg } {1 {could not set owner for file "foo.test": no such file or directory}} test unixFCmd-16.3 {SetOwnerAttribute - invalid owner} {unixOnly notRoot} { catch {file delete -force -- foo.test} list [catch {file attributes foo.test -owner foozzz} msg] $msg } {1 {could not set owner for file "foo.test": user "foozzz" does not exist}} test unixFCmd-17.1 {SetPermissionsAttribute} {unixOnly notRoot} { catch {file delete -force -- foo.test} close [open foo.test w] list [catch {file attributes foo.test -permissions 0000} msg] \ $msg [file attributes foo.test -permissions] \ [file delete -force -- foo.test] } {0 {} 00000 {}} test unixFCmd-17.2 {SetPermissionsAttribute} {unixOnly notRoot} { catch {file delete -force -- foo.test} list [catch {file attributes foo.test -permissions 0000} msg] $msg } {1 {could not set permissions for file "foo.test": no such file or directory}} test unixFCmd-17.3 {SetPermissionsAttribute} {unixOnly notRoot} { catch {file delete -force -- foo.test} close [open foo.test w] list [catch {file attributes foo.test -permissions foo} msg] $msg \ [file delete -force -- foo.test] } {1 {unknown permission string format "foo"} {}} test unixFCmd-17.3 {SetPermissionsAttribute} {unixOnly notRoot} { catch {file delete -force -- foo.test} close [open foo.test w] list [catch {file attributes foo.test -permissions ---rwx} msg] $msg \ [file delete -force -- foo.test] } {1 {unknown permission string format "---rwx"} {}} close [open foo.test w] set ::i 4 proc permcheck {permstr expected} { test unixFCmd-17.[incr ::i] {SetPermissionsAttribute} {unixOnly notRoot} \ [subst { file attributes foo.test -permissions $permstr file attributes foo.test -permissions } ] $expected } permcheck rwxrwxrwx 00777 permcheck r--r---w- 00442 permcheck 0 00000 permcheck u+rwx,g+r 00740 permcheck u-w 00540 permcheck o+rwx 00547 permcheck --x--x--x 00111 permcheck a+rwx 00777 file delete -force -- foo.test test unixFCmd-18.1 {Unix pwd} {nonPortable unixOnly notRoot} { # This test is nonportable because SunOS generates a weird error # message when the current directory isn't readable. set cd [pwd] set nd $cd/tstdir file mkdir $nd cd $nd exec chmod 000 $nd set r [list [catch {pwd} res] [string range $res 0 36]]; cd $cd; exec chmod 755 $nd file delete $nd set r } {1 {error getting working directory name:}} # cleanup cleanup ::tcltest::cleanupTests return |
Added tests/unixFile.test.
> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 | # This file contains tests for the routines in the file tclUnixFile.c # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id: unixFile.test,v 1.1.1.1 2001/08/03 16:19:04 vincentdarley Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest namespace import -force ::tcltest::* } if {[info commands testobj] == {}} { puts "This application hasn't been compiled with the \"testfindexecutable\"" puts "command, so I can't test the Tcl_FindExecutable function" ::tcltest::cleanupTests return } catch { set oldPath $env(PATH) close [open junk w] file attributes junk -perm 0777 } set absPath [file join [pwd] junk] test unixFile-1.1 {Tcl_FindExecutable} {unixOnly} { set env(PATH) "" testfindexecutable junk } $absPath test unixFile-1.2 {Tcl_FindExecutable} {unixOnly} { set env(PATH) "/dummy" testfindexecutable junk } {} test unixFile-1.3 {Tcl_FindExecutable} {unixOnly} { set env(PATH) "/dummy:[pwd]" testfindexecutable junk } $absPath test unixFile-1.4 {Tcl_FindExecutable} {unixOnly} { set env(PATH) "/dummy:" testfindexecutable junk } $absPath test unixFile-1.5 {Tcl_FindExecutable} {unixOnly} { set env(PATH) "/dummy:/dummy" testfindexecutable junk } {} test unixFile-1.6 {Tcl_FindExecutable} {unixOnly} { set env(PATH) "/dummy::/dummy" testfindexecutable junk } $absPath test unixFile-1.7 {Tcl_FindExecutable} {unixOnly} { set env(PATH) ":/dummy" testfindexecutable junk } $absPath # cleanup catch {set env(PATH) $oldPath} file delete junk ::tcltest::cleanupTests return |
Added tests/vfs.test.
> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 | # Commands covered: vfs::filesystem # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 2001 by Vince Darley. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest namespace import ::tcltest::* } package require vfs test vfs-1.1 {mount unmount} { vfs::filesystem mount foo bar set res [list [catch {vfs::filesystem unmount foo bar} err]] lappend res $err vfs::filesystem unmount foo unset err set res } {1 {wrong # args: should be "vfs::filesystem unmount path"}} # cleanup ::tcltest::cleanupTests return |
Added tests/winFCmd.test.
> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 859 860 861 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 930 931 932 933 934 935 936 937 938 939 940 941 942 943 944 945 946 947 948 949 950 951 952 953 954 955 956 957 958 959 960 961 962 963 964 965 966 967 968 969 970 971 972 973 974 975 976 977 978 979 980 981 | # This file tests the tclWinFCmd.c file. # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1996-1997 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # 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.1.1.1 2001/08/03 16:19:05 vincentdarley Exp $ # if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest namespace import -force ::tcltest::* } proc createfile {file {string a}} { set f [open $file w] puts -nonewline $f $string close $f return $string } proc contents {file} { set f [open $file r] set r [read $f] close $f set r } proc cleanup {args} { foreach p ". $args" { set x "" catch { set x [glob -directory $p tf* td*] } if {$x != ""} { catch {eval file delete -force -- $x} } } } set ::tcltest::testConstraints(cdrom) 0 set ::tcltest::testConstraints(exdev) 0 # find a CD-ROM so we can test read-only filesystems. set cdrom {} set nodrive x: foreach p {d e f g h i j k l m n o p q r s t u v w x y z} { set name ${p}:/dummy~~.fil if [catch {set fd [open $name w]}] { set err [lindex $errorCode 1] if {$cdrom == "" && $err == "EACCES"} { set cdrom ${p}: } if {$err == "ENOENT"} { set nodrive ${p}: } } else { close $fd file delete $name } } proc findfile {dir} { foreach p [glob $dir/*] { if {[file type $p] == "file"} { return $p } } foreach p [glob $dir/*] { if {[file type $p] == "directory"} { set f [findfile $p] if {$f != ""} { return $f } } } return "" } if {$cdrom != ""} { set ::tcltest::testConstraints(cdrom) 1 set cdfile [findfile $cdrom] } if {[file exists c:/] && [file exists d:/]} { catch {file delete d:/tf1} if {[catch {close [open d:/tf1 w]}] == 0} { file delete d:/tf1 set ::tcltest::testConstraints(exdev) 1 } } file delete -force -- td1 set foo [catch {open td1 w} testfile] if {$foo} { set ::tcltest::testConstraints(longFileNames) 0 } else { close $testfile set ::tcltest::testConstraints(longFileNames) 1 file delete -force -- td1 } # A really long file name # length of longname is 1216 chars, which should be greater than any static # buffer or allowable filename. set longname "abcdefghihjllmnopqrstuvwxyz01234567890" append longname $longname append longname $longname append longname $longname append longname $longname append longname $longname # Uses the "testfile" command instead of the "file" command. The "file" # command provides several layers of sanity checks on the arguments and # it can be difficult to actually forward "insane" arguments to the # low-level posix emulation layer. test winFCmd-1.1 {TclpRenameFile: errno: EACCES} {pcOnly cdrom} { list [catch {testfile mv $cdfile $cdrom/dummy~~.fil} msg] $msg } {1 EACCES} test winFCmd-1.2 {TclpRenameFile: errno: EEXIST} {pcOnly} { cleanup file mkdir td1/td2/td3 file mkdir td2 list [catch {testfile mv td2 td1/td2} msg] $msg } {1 EEXIST} test winFCmd-1.3 {TclpRenameFile: errno: EINVAL} {pcOnly} { cleanup list [catch {testfile mv / td1} msg] $msg } {1 EINVAL} test winFCmd-1.4 {TclpRenameFile: errno: EINVAL} {pcOnly} { cleanup file mkdir td1 list [catch {testfile mv td1 td1/td2} msg] $msg } {1 EINVAL} test winFCmd-1.5 {TclpRenameFile: errno: EISDIR} {pcOnly} { cleanup file mkdir td1 createfile tf1 list [catch {testfile mv tf1 td1} msg] $msg } {1 EISDIR} test winFCmd-1.6 {TclpRenameFile: errno: ENOENT} {pcOnly} { cleanup list [catch {testfile mv tf1 tf2} msg] $msg } {1 ENOENT} test winFCmd-1.7 {TclpRenameFile: errno: ENOENT} {pcOnly} { cleanup list [catch {testfile mv "" tf2} msg] $msg } {1 ENOENT} test winFCmd-1.8 {TclpRenameFile: errno: ENOENT} {pcOnly} { cleanup createfile tf1 list [catch {testfile mv tf1 ""} msg] $msg } {1 ENOENT} test winFCmd-1.9 {TclpRenameFile: errno: ENOTDIR} {pcOnly} { cleanup file mkdir td1 createfile tf1 list [catch {testfile mv td1 tf1} msg] $msg } {1 ENOTDIR} test winFCmd-1.10 {TclpRenameFile: errno: EXDEV} {pcOnly exdev} { file delete -force d:/tf1 file mkdir c:/tf1 set msg [list [catch {testfile mv c:/tf1 d:/tf1} msg] $msg] file delete -force c:/tf1 set msg } {1 EXDEV} test winFCmd-1.11 {TclpRenameFile: errno: EACCES} {pcOnly} { cleanup set fd [open tf1 w] set msg [list [catch {testfile mv tf1 tf2} msg] $msg] close $fd set msg } {1 EACCES} test winFCmd-1.12 {TclpRenameFile: errno: EACCES} {pcOnly} { cleanup createfile tf1 set fd [open tf2 w] set msg [list [catch {testfile mv tf1 tf2} msg] $msg] close $fd set msg } {1 EACCES} test winFCmd-1.13 {TclpRenameFile: errno: EACCES} {pcOnly} { cleanup list [catch {testfile mv nul tf1} msg] $msg } {1 EACCES} test winFCmd-1.14 {TclpRenameFile: errno: EACCES} {95} { cleanup createfile tf1 list [catch {testfile mv tf1 nul} msg] $msg } {1 EACCES} test winFCmd-1.15 {TclpRenameFile: errno: EEXIST} {nt} { cleanup createfile tf1 list [catch {testfile mv tf1 nul} msg] $msg } {1 EEXIST} test winFCmd-1.16 {TclpRenameFile: MoveFile() != FALSE} {pcOnly} { cleanup createfile tf1 tf1 testfile mv tf1 tf2 list [file exists tf1] [contents tf2] } {0 tf1} test winFCmd-1.17 {TclpRenameFile: MoveFile() == FALSE} {pcOnly} { cleanup list [catch {testfile mv tf1 tf2} msg] $msg } {1 ENOENT} test winFCmd-1.18 {TclpRenameFile: srcAttr == -1} {pcOnly} { cleanup list [catch {testfile mv tf1 tf2} msg] $msg } {1 ENOENT} test winFCmd-1.19 {TclpRenameFile: errno == EACCES} {pcOnly} { cleanup list [catch {testfile mv nul tf1} msg] $msg } {1 EACCES} test winFCmd-1.20 {TclpRenameFile: src is dir} {nt} { # under 95, this would actually succeed and move the current dir out from # under the current process! cleanup file delete /tf1 list [catch {testfile mv [pwd] /tf1} msg] $msg } {1 EACCES} test winFCmd-1.21 {TclpRenameFile: long src} {pcOnly} { cleanup list [catch {testfile mv $longname tf1} msg] $msg } {1 ENAMETOOLONG} test winFCmd-1.22 {TclpRenameFile: long dst} {pcOnly} { cleanup createfile tf1 list [catch {testfile mv tf1 $longname} msg] $msg } {1 ENAMETOOLONG} test winFCmd-1.23 {TclpRenameFile: move dir into self} {pcOnly} { cleanup file mkdir td1 list [catch {testfile mv [pwd]/td1 td1/td2} msg] $msg } {1 EINVAL} test winFCmd-1.24 {TclpRenameFile: move a root dir} {pcOnly} { cleanup list [catch {testfile mv / c:/} msg] $msg } {1 EINVAL} test winFCmd-1.25 {TclpRenameFile: cross file systems} {pcOnly cdrom} { cleanup file mkdir td1 list [catch {testfile mv td1 $cdrom/td1} msg] $msg } {1 EXDEV} test winFCmd-1.26 {TclpRenameFile: readonly fs} {pcOnly cdrom} { cleanup list [catch {testfile mv $cdfile $cdrom/dummy~~.fil} msg] $msg } {1 EACCES} test winFCmd-1.27 {TclpRenameFile: open file} {pcOnly} { cleanup set fd [open tf1 w] set msg [list [catch {testfile mv tf1 tf2} msg] $msg] close $fd set msg } {1 EACCES} test winFCmd-1.28 {TclpRenameFile: errno == EEXIST} {pcOnly} { cleanup createfile tf1 createfile tf2 testfile mv tf1 tf2 list [file exist tf1] [file exist tf2] } {0 1} test winFCmd-1.29 {TclpRenameFile: src is dir} {pcOnly} { cleanup file mkdir td1 createfile tf1 list [catch {testfile mv td1 tf1} msg] $msg } {1 ENOTDIR} test winFCmd-1.30 {TclpRenameFile: dst is dir} {pcOnly} { cleanup file mkdir td1 file mkdir td2/td2 list [catch {testfile mv td1 td2} msg] $msg } {1 EEXIST} test winFCmd-1.31 {TclpRenameFile: TclpRemoveDirectory fails} {pcOnly} { cleanup file mkdir td1 file mkdir td2/td2 list [catch {testfile mv td1 td2} msg] $msg } {1 EEXIST} test winFCmd-1.32 {TclpRenameFile: TclpRemoveDirectory succeeds} {pcOnly} { cleanup file mkdir td1/td2 file mkdir td2 testfile mv td1 td2 list [file exist td1] [file exist td2] [file exist td2/td2] } {0 1 1} test winFCmd-1.33 {TclpRenameFile: After removing dst dir, MoveFile fails} \ {pcOnly exdev} { file mkdir d:/td1 testchmod 000 d:/td1 file mkdir c:/tf1 set msg [list [catch {testfile mv c:/tf1 d:/td1} msg] $msg] set msg "$msg [file writable d:/td1]" file delete d:/td1 file delete -force c:/tf1 set msg } {1 EXDEV 0} test winFCmd-1.34 {TclpRenameFile: src is dir, dst is not} {pcOnly} { file mkdir td1 createfile tf1 list [catch {testfile mv td1 tf1} msg] $msg } {1 ENOTDIR} test winFCmd-1.35 {TclpRenameFile: src is not dir, dst is} {pcOnly} { file mkdir td1 createfile tf1 list [catch {testfile mv tf1 td1} msg] $msg } {1 EISDIR} test winFCmd-1.36 {TclpRenameFile: src and dst not dir} {pcOnly} { createfile tf1 tf1 createfile tf2 tf2 testfile mv tf1 tf2 contents tf2 } {tf1} test winFCmd-1.37 {TclpRenameFile: need to restore temp file} {pcOnly} { # Can't figure out how to cause this. # Need a file that can't be copied. } {} test winFCmd-2.1 {TclpCopyFile: errno: EACCES} {pcOnly cdrom} { cleanup list [catch {testfile cp $cdfile $cdrom/dummy~~.fil} msg] $msg } {1 EACCES} test winFCmd-2.2 {TclpCopyFile: errno: EISDIR} {pcOnly} { cleanup file mkdir td1 list [catch {testfile cp td1 tf1} msg] $msg } {1 EISDIR} test winFCmd-2.3 {TclpCopyFile: errno: EISDIR} {pcOnly} { cleanup createfile tf1 file mkdir td1 list [catch {testfile cp tf1 td1} msg] $msg } {1 EISDIR} test winFCmd-2.4 {TclpCopyFile: errno: ENOENT} {pcOnly} { cleanup list [catch {testfile cp tf1 tf2} msg] $msg } {1 ENOENT} test winFCmd-2.5 {TclpCopyFile: errno: ENOENT} {pcOnly} { cleanup list [catch {testfile cp "" tf2} msg] $msg } {1 ENOENT} test winFCmd-2.6 {TclpCopyFile: errno: ENOENT} {pcOnly} { cleanup createfile tf1 list [catch {testfile cp tf1 ""} msg] $msg } {1 ENOENT} test winFCmd-2.7 {TclpCopyFile: errno: EACCES} {95} { cleanup createfile tf1 set fd [open tf2 w] set msg [list [catch {testfile cp tf1 tf2} msg] $msg] close $fd set msg } {1 EACCES} test winFCmd-2.8 {TclpCopyFile: errno: EACCES} {nt} { cleanup list [catch {testfile cp nul tf1} msg] $msg } {1 EACCES} test winFCmd-2.9 {TclpCopyFile: errno: ENOENT} {95} { cleanup list [catch {testfile cp nul tf1} msg] $msg } {1 ENOENT} test winFCmd-2.10 {TclpCopyFile: CopyFile succeeds} {pcOnly} { cleanup createfile tf1 tf1 testfile cp tf1 tf2 list [contents tf1] [contents tf2] } {tf1 tf1} test winFCmd-2.11 {TclpCopyFile: CopyFile succeeds} {pcOnly} { cleanup createfile tf1 tf1 createfile tf2 tf2 testfile cp tf1 tf2 list [contents tf1] [contents tf2] } {tf1 tf1} test winFCmd-2.12 {TclpCopyFile: CopyFile succeeds} {pcOnly} { cleanup createfile tf1 tf1 testchmod 000 tf1 testfile cp tf1 tf2 list [contents tf2] [file writable tf2] } {tf1 0} test winFCmd-2.13 {TclpCopyFile: CopyFile fails} {pcOnly} { cleanup createfile tf1 file mkdir td1 list [catch {testfile cp tf1 td1} msg] $msg } {1 EISDIR} test winFCmd-2.14 {TclpCopyFile: errno == EACCES} {pcOnly} { cleanup file mkdir td1 list [catch {testfile cp td1 tf1} msg] $msg } {1 EISDIR} test winFCmd-2.15 {TclpCopyFile: src is directory} {pcOnly} { cleanup file mkdir td1 list [catch {testfile cp td1 tf1} msg] $msg } {1 EISDIR} test winFCmd-2.16 {TclpCopyFile: dst is directory} {pcOnly} { cleanup createfile tf1 file mkdir td1 list [catch {testfile cp tf1 td1} msg] $msg } {1 EISDIR} test winFCmd-2.17 {TclpCopyFile: dst is readonly} {pcOnly} { cleanup createfile tf1 tf1 createfile tf2 tf2 testchmod 000 tf2 testfile cp tf1 tf2 list [file writable tf2] [contents tf2] } {1 tf1} test winFCmd-2.18 {TclpCopyFile: still can't copy onto dst} {95} { cleanup createfile tf1 createfile tf2 testchmod 000 tf2 set fd [open tf2] set msg [list [catch {testfile cp tf1 tf2} msg] $msg] close $fd set msg "$msg [file writable tf2]" } {1 EACCES 0} test winFCmd-3.1 {TclpDeleteFile: errno: EACCES} {pcOnly cdrom} { list [catch {testfile rm $cdfile $cdrom/dummy~~.fil} msg] $msg } {1 EACCES} test winFCmd-3.2 {TclpDeleteFile: errno: EISDIR} {pcOnly} { cleanup file mkdir td1 list [catch {testfile rm td1} msg] $msg } {1 EISDIR} test winFCmd-3.3 {TclpDeleteFile: errno: ENOENT} {pcOnly} { cleanup list [catch {testfile rm tf1} msg] $msg } {1 ENOENT} test winFCmd-3.4 {TclpDeleteFile: errno: ENOENT} {pcOnly} { cleanup list [catch {testfile rm ""} msg] $msg } {1 ENOENT} test winFCmd-3.5 {TclpDeleteFile: errno: EACCES} {pcOnly} { cleanup set fd [open tf1 w] set msg [list [catch {testfile rm tf1} msg] $msg] close $fd set msg } {1 EACCES} test winFCmd-3.6 {TclpDeleteFile: errno: EACCES} {pcOnly} { cleanup list [catch {testfile rm nul} msg] $msg } {1 EACCES} test winFCmd-3.7 {TclpDeleteFile: DeleteFile succeeds} {pcOnly} { cleanup createfile tf1 testfile rm tf1 file exist tf1 } {0} test winFCmd-3.8 {TclpDeleteFile: DeleteFile fails} {pcOnly} { cleanup file mkdir td1 list [catch {testfile rm td1} msg] $msg } {1 EISDIR} test winFCmd-3.9 {TclpDeleteFile: errno == EACCES} {pcOnly} { cleanup set fd [open tf1 w] set msg [list [catch {testfile rm tf1} msg] $msg] close $fd set msg } {1 EACCES} test winFCmd-3.10 {TclpDeleteFile: path is readonly} {pcOnly} { cleanup createfile tf1 testchmod 000 tf1 testfile rm tf1 file exists tf1 } {0} test winFCmd-3.11 {TclpDeleteFile: still can't remove path} {pcOnly} { cleanup set fd [open tf1 w] testchmod 000 tf1 set msg [list [catch {testfile rm tf1} msg] $msg] close $fd set msg } {1 EACCES} test winFCmd-4.1 {TclpCreateDirectory: errno: EACCES} {nt cdrom} { list [catch {testfile mkdir $cdrom/dummy~~.dir} msg] $msg } {1 EACCES} test winFCmd-4.2 {TclpCreateDirectory: errno: EACCES} {95 cdrom} { list [catch {testfile mkdir $cdrom/dummy~~.dir} msg] $msg } {1 ENOSPC} test winFCmd-4.3 {TclpCreateDirectory: errno: EEXIST} {pcOnly} { cleanup file mkdir td1 list [catch {testfile mkdir td1} msg] $msg } {1 EEXIST} test winFCmd-4.4 {TclpCreateDirectory: errno: ENOENT} {pcOnly} { cleanup list [catch {testfile mkdir td1/td2} msg] $msg } {1 ENOENT} test winFCmd-4.5 {TclpCreateDirectory: CreateDirectory succeeds} {pcOnly} { cleanup testfile mkdir td1 file type td1 } {directory} test winFCmd-5.1 {TclpCopyDirectory: calls TraverseWinTree} {pcOnly} { cleanup file mkdir td1 testfile cpdir td1 td2 list [file type td1] [file type td2] } {directory directory} test winFCmd-6.1 {TclpRemoveDirectory: errno: EACCES} {pcOnly} { cleanup file mkdir td1 testchmod 000 td1 testfile rmdir td1 file exist td1 } {0} test winFCmd-6.2 {TclpRemoveDirectory: errno: EEXIST} {pcOnly fsIsWritable} { cleanup file mkdir td1/td2 list [catch {testfile rmdir td1} msg] $msg } {1 {td1 EEXIST}} test winFCmd-6.3 {TclpRemoveDirectory: errno: EACCES} {pcOnly} { # can't test this w/o removing everything on your hard disk first! # testfile rmdir / } {} test winFCmd-6.4 {TclpRemoveDirectory: errno: ENOENT} {pcOnly} { cleanup list [catch {testfile rmdir td1} msg] $msg } {1 {td1 ENOENT}} test winFCmd-6.5 {TclpRemoveDirectory: errno: ENOENT} {pcOnly} { cleanup list [catch {testfile rmdir ""} msg] $msg } {1 ENOENT} test winFCmd-6.6 {TclpRemoveDirectory: errno: ENOTDIR} {pcOnly fsIsWritable} { cleanup createfile tf1 list [catch {testfile rmdir tf1} msg] $msg } {1 {tf1 ENOTDIR}} test winFCmd-6.7 {TclpRemoveDirectory: RemoveDirectory succeeds} {pcOnly fsIsWritable} { cleanup file mkdir td1 testfile rmdir td1 file exists td1 } {0} test winFCmd-6.8 {TclpRemoveDirectory: RemoveDirectory fails} {pcOnly fsIsWritable} { cleanup createfile tf1 list [catch {testfile rmdir tf1} msg] $msg } {1 {tf1 ENOTDIR}} test winFCmd-6.9 {TclpRemoveDirectory: errno == EACCES} {pcOnly fsIsWritable} { cleanup file mkdir td1 testchmod 000 td1 testfile rmdir td1 file exists td1 } {0} test winFCmd-6.10 {TclpRemoveDirectory: attr == -1} {95} { cleanup list [catch {testfile rmdir nul} msg] $msg } {1 {nul EACCES}} test winFCmd-6.11 {TclpRemoveDirectory: attr == -1} {nt} { cleanup list [catch {testfile rmdir /} msg] $msg } {1 {\ EACCES}} test winFCmd-6.12 {TclpRemoveDirectory: errno == EACCES} {95 fsIsWritable} { cleanup createfile tf1 list [catch {testfile rmdir tf1} msg] $msg } {1 {tf1 ENOTDIR}} test winFCmd-6.13 {TclpRemoveDirectory: write-protected} {pcOnly fsIsWritable} { cleanup file mkdir td1 testchmod 000 td1 testfile rmdir td1 file exists td1 } {0} test winFCmd-6.14 {TclpRemoveDirectory: check if empty dir} {95 fsIsWritable} { cleanup file mkdir td1/td2 list [catch {testfile rmdir td1} msg] $msg } {1 {td1 EEXIST}} test winFCmd-6.15 {TclpRemoveDirectory: !recursive} {pcOnly fsIsWritable} { cleanup file mkdir td1/td2 list [catch {testfile rmdir td1} msg] $msg } {1 {td1 EEXIST}} test winFCmd-6.16 {TclpRemoveDirectory: recursive, but errno != EEXIST} {pcOnly} { cleanup createfile tf1 list [catch {testfile rmdir -force tf1} msg] $msg } {1 {tf1 ENOTDIR}} test winFCmd-6.17 {TclpRemoveDirectory: calls TraverseWinTree} {pcOnly fsIsWritable} { cleanup file mkdir td1/td2 testfile rmdir -force td1 file exists td1 } {0} test winFCmd-7.1 {TraverseWinTree: targetPtr == NULL} {pcOnly fsIsWritable} { cleanup file mkdir td1/td2/td3 testfile rmdir -force td1 file exists td1 } {0} test winFCmd-7.2 {TraverseWinTree: targetPtr != NULL} {pcOnly fsIsWritable} { cleanup file mkdir td1/td2/td3 testfile cpdir td1 td2 list [file exists td1] [file exists td2] } {1 1} test winFCmd-7.3 {TraverseWinTree: sourceAttr == -1} {pcOnly} { cleanup list [catch {testfile cpdir td1 td2} msg] $msg } {1 {td1 ENOENT}} test winFCmd-7.4 {TraverseWinTree: source isn't directory} {pcOnly fsIsWritable} { cleanup file mkdir td1 createfile td1/tf1 tf1 testfile cpdir td1 td2 contents td2/tf1 } {tf1} test winFCmd-7.5 {TraverseWinTree: call TraversalCopy: DOTREE_F} {pcOnly fsIsWritable} { cleanup file mkdir td1 createfile td1/tf1 tf1 testfile cpdir td1 td2 contents td2/tf1 } {tf1} test winFCmd-7.6 {TraverseWinTree: call TraversalDelete: DOTREE_F} {pcOnly fsIsWritable} { cleanup file mkdir td1 createfile td1/tf1 tf1 testfile rmdir -force td1 file exists td1 } {0} test winFCmd-7.7 {TraverseWinTree: append \ to source if necessary} {pcOnly fsIsWritable} { cleanup file mkdir td1 createfile td1/tf1 tf1 testfile cpdir td1 td2 contents td2/tf1 } {tf1} test winFCmd-7.8 {TraverseWinTree: append \ to source if necessary} {95 cdrom} { list [catch {testfile rmdir $cdrom/} msg] $msg } "1 {$cdrom\\ EEXIST}" test winFCmd-7.9 {TraverseWinTree: append \ to source if necessary} {nt cdrom} { list [catch {testfile rmdir $cdrom/} msg] $msg } "1 {$cdrom\\ EACCES}" test winFCmd-7.10 {TraverseWinTree: can't read directory: handle == INVALID} \ {pcOnly} { # can't make it happen } {} test winFCmd-7.11 {TraverseWinTree: call TraversalCopy: DOTREE_PRED} {pcOnly fsIsWritable} { cleanup file mkdir td1 testchmod 000 td1 createfile td1/tf1 tf1 testfile cpdir td1 td2 list [file exists td2] [file writable td2] } {1 0} test winFCmd-7.12 {TraverseWinTree: call TraversalDelete: DOTREE_PRED} {pcOnly fsIsWritable} { cleanup file mkdir td1 createfile td1/tf1 tf1 testfile rmdir -force td1 file exists td1 } {0} test winFCmd-7.13 {TraverseWinTree: append \ to target if necessary} {pcOnly fsIsWritable} { cleanup file mkdir td1 createfile td1/tf1 tf1 testfile cpdir td1 td2 contents td2/tf1 } {tf1} test winFCmd-7.14 {TraverseWinTree: append \ to target if necessary} {95 fsIsWritable} { cleanup file mkdir td1 list [catch {testfile cpdir td1 /} msg] $msg } {1 {\ EEXIST}} test winFCmd-7.15 {TraverseWinTree: append \ to target if necessary} {nt fsIsWritable} { cleanup file mkdir td1 list [catch {testfile cpdir td1 /} msg] $msg } {1 {\ EACCES}} test winFCmd-7.16 {TraverseWinTree: recurse on files: no files} {pcOnly fsIsWritable} { cleanup file mkdir td1 testfile cpdir td1 td2 } {} test winFCmd-7.17 {TraverseWinTree: recurse on files: one file} {pcOnly fsIsWritable} { cleanup file mkdir td1 createfile td1/td2 testfile cpdir td1 td2 glob td2/* } {td2/td2} test winFCmd-7.18 {TraverseWinTree: recurse on files: several files and dir} \ {pcOnly fsIsWritable} { cleanup file mkdir td1 createfile td1/tf1 createfile td1/tf2 file mkdir td1/td2/td3 createfile td1/tf3 createfile td1/tf4 testfile cpdir td1 td2 lsort [glob td2/*] } {td2/td2 td2/tf1 td2/tf2 td2/tf3 td2/tf4} test winFCmd-7.19 {TraverseWinTree: call TraversalCopy: DOTREE_POSTD} {pcOnly fsIsWritable} { cleanup file mkdir td1 testchmod 000 td1 createfile td1/tf1 tf1 testfile cpdir td1 td2 list [file exists td2] [file writable td2] } {1 0} test winFCmd-7.20 {TraverseWinTree: call TraversalDelete: DOTREE_POSTD} \ {pcOnly fsIsWritable} { cleanup file mkdir td1 createfile td1/tf1 tf1 testfile rmdir -force td1 file exists td1 } {0} test winFCmd-7.21 {TraverseWinTree: fill errorPtr} {pcOnly} { cleanup list [catch {testfile cpdir td1 td2} msg] $msg } {1 {td1 ENOENT}} test winFCmd-8.1 {TraversalCopy: DOTREE_F} {pcOnly fsIsWritable} { cleanup file mkdir td1 list [catch {testfile cpdir td1 td1} msg] $msg } {1 {td1 EEXIST}} test winFCmd-8.2 {TraversalCopy: DOTREE_PRED} {pcOnly fsIsWritable} { cleanup file mkdir td1/td2 testchmod 000 td1 testfile cpdir td1 td2 list [file writable td1] [file writable td1/td2] } {0 1} test winFCmd-8.3 {TraversalCopy: DOTREE_POSTD} {pcOnly fsIsWritable} { cleanup file mkdir td1 testfile cpdir td1 td2 } {} test winFCmd-9.1 {TraversalDelete: DOTREE_F} {pcOnly fsIsWritable} { cleanup file mkdir td1 createfile td1/tf1 testfile rmdir -force td1 } {} test winFCmd-9.2 {TraversalDelete: DOTREE_F} {95 fsIsWritable} { cleanup file mkdir td1 set fd [open td1/tf1 w] set msg [list [catch {testfile rmdir -force td1} msg] $msg] close $fd set msg } {1 {td1\tf1 EACCES}} test winFCmd-9.3 {TraversalDelete: DOTREE_PRED} {pcOnly fsIsWritable} { cleanup file mkdir td1/td2 testchmod 000 td1 testfile rmdir -force td1 file exists td1 } {0} test winFCmd-9.4 {TraversalDelete: DOTREE_POSTD} {pcOnly fsIsWritable} { cleanup file mkdir td1/td1/td3/td4/td5 testfile rmdir -force td1 } {} test winFCmd-10.1 {AttributesPosixError - get} {pcOnly} { cleanup list [catch {file attributes td1 -archive} msg] $msg } {1 {could not read "td1": no such file or directory}} test winFCmd-10.2 {AttributesPosixError - set} {pcOnly} { cleanup list [catch {file attributes td1 -archive 0} msg] $msg } {1 {could not read "td1": no such file or directory}} test winFCmd-11.1 {GetWinFileAttributes} {pcOnly fsIsWritable} { cleanup close [open td1 w] list [catch {file attributes td1 -archive} msg] $msg [cleanup] } {0 1 {}} test winFCmd-11.2 {GetWinFileAttributes} {pcOnly fsIsWritable} { cleanup close [open td1 w] list [catch {file attributes td1 -readonly} msg] $msg [cleanup] } {0 0 {}} test winFCmd-11.3 {GetWinFileAttributes} {pcOnly fsIsWritable} { cleanup close [open td1 w] list [catch {file attributes td1 -hidden} msg] $msg [cleanup] } {0 0 {}} test winFCmd-11.4 {GetWinFileAttributes} {pcOnly fsIsWritable} { cleanup close [open td1 w] list [catch {file attributes td1 -system} msg] $msg [cleanup] } {0 0 {}} test winfcmd-11.5 {GetWinFileAttributes} {pcOnly} { # attr of relative paths that resolve to root was failing # don't care about answer, just that test runs. set old [pwd] cd c:/ file attr c: file attr c:. file attr . cd $old } {} test winFCmd-12.1 {ConvertFileNameFormat} {pcOnly fsIsWritable} { cleanup close [open td1 w] list [catch {string tolower [file attributes td1 -longname]} msg] $msg [cleanup] } {0 td1 {}} test winFCmd-12.2 {ConvertFileNameFormat} {pcOnly fsIsWritable} { cleanup file mkdir td1 close [open td1/td1 w] list [catch {string tolower [file attributes td1/td1 -longname]} msg] $msg [cleanup] } {0 td1/td1 {}} test winFCmd-12.3 {ConvertFileNameFormat} {pcOnly fsIsWritable} { cleanup file mkdir td1 file mkdir td1/td2 close [open td1/td3 w] list [catch {string tolower [file attributes td1/td2/../td3 -longname]} msg] $msg [cleanup] } {0 td1/td2/../td3 {}} test winFCmd-12.4 {ConvertFileNameFormat} {pcOnly fsIsWritable} { cleanup close [open td1 w] list [catch {string tolower [file attributes ./td1 -longname]} msg] $msg [cleanup] } {0 ./td1 {}} test winFCmd-12.5 {ConvertFileNameFormat: absolute path} {pcOnly} { list [file attributes / -longname] [file attributes \\ -longname] } {/ /} test winFCmd-12.6 {ConvertFileNameFormat: absolute path with drive} {pcOnly} { catch {file delete -force -- c:/td1} close [open c:/td1 w] list [catch {string tolower [file attributes c:/td1 -longname]} msg] $msg [file delete -force -- c:/td1] } {0 c:/td1 {}} test winFCmd-12.7 {ConvertFileNameFormat} {nonPortable pcOnly} { string tolower [file attributes //bisque/tcl/ws -longname] } {//bisque/tcl/ws} test winFCmd-12.8 {ConvertFileNameFormat} {pcOnly longFileNames fsIsWritable} { cleanup close [open td1 w] list [catch {string tolower [file attributes td1 -longname]} msg] $msg [cleanup] } {0 td1 {}} test winFCmd-12.10 {ConvertFileNameFormat} {longFileNames pcOnly fsIsWritable} { cleanup close [open td1td1td1 w] list [catch {file attributes td1td1td1 -shortname}] [cleanup] } {0 {}} test winFCmd-12.11 {ConvertFileNameFormat} {longFileNames pcOnly fsIsWritable} { cleanup close [open td1 w] list [catch {string tolower [file attributes td1 -shortname]} msg] $msg [cleanup] } {0 td1 {}} test winFCmd-13.1 {GetWinFileLongName} {pcOnly fsIsWritable} { cleanup close [open td1 w] list [catch {string tolower [file attributes td1 -longname]} msg] $msg [cleanup] } {0 td1 {}} test winFCmd-14.1 {GetWinFileShortName} {pcOnly fsIsWritable} { cleanup close [open td1 w] list [catch {string tolower [file attributes td1 -shortname]} msg] $msg [cleanup] } {0 td1 {}} test winFCmd-15.1 {SetWinFileAttributes} {pcOnly} { cleanup list [catch {file attributes td1 -archive 0} msg] $msg } {1 {could not read "td1": no such file or directory}} test winFCmd-15.2 {SetWinFileAttributes - archive} {pcOnly fsIsWritable} { cleanup close [open td1 w] list [catch {file attributes td1 -archive 1} msg] $msg [file attributes td1 -archive] [cleanup] } {0 {} 1 {}} test winFCmd-15.3 {SetWinFileAttributes - archive} {pcOnly fsIsWritable} { cleanup close [open td1 w] list [catch {file attributes td1 -archive 0} msg] $msg [file attributes td1 -archive] [cleanup] } {0 {} 0 {}} test winFCmd-15.4 {SetWinFileAttributes - hidden} {pcOnly fsIsWritable} { cleanup close [open td1 w] list [catch {file attributes td1 -hidden 1} msg] $msg [file attributes td1 -hidden] [file attributes td1 -hidden 0] [cleanup] } {0 {} 1 {} {}} test winFCmd-15.5 {SetWinFileAttributes - hidden} {pcOnly fsIsWritable} { cleanup close [open td1 w] list [catch {file attributes td1 -hidden 0} msg] $msg [file attributes td1 -hidden] [cleanup] } {0 {} 0 {}} test winFCmd-15.6 {SetWinFileAttributes - readonly} {pcOnly fsIsWritable} { cleanup close [open td1 w] list [catch {file attributes td1 -readonly 1} msg] $msg [file attributes td1 -readonly] [cleanup] } {0 {} 1 {}} test winFCmd-15.7 {SetWinFileAttributes - readonly} {pcOnly fsIsWritable} { cleanup close [open td1 w] list [catch {file attributes td1 -readonly 0} msg] $msg [file attributes td1 -readonly] [cleanup] } {0 {} 0 {}} test winFCmd-15.8 {SetWinFileAttributes - system} {pcOnly fsIsWritable} { cleanup close [open td1 w] list [catch {file attributes td1 -system 1} msg] $msg [file attributes td1 -system] [cleanup] } {0 {} 1 {}} test winFCmd-15.9 {SetWinFileAttributes - system} {pcOnly fsIsWritable} { cleanup close [open td1 w] list [catch {file attributes td1 -system 0} msg] $msg [file attributes td1 -system] [cleanup] } {0 {} 0 {}} test winFCmd-15.10 {SetWinFileAttributes - failing} {pcOnly cdrom} { cleanup catch {file attributes $cdfile -archive 1} } {1} # 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. #foreach source {tef ted tnf tnd "" nul com1} { # foreach chmodsrc {000 755} { # foreach dest "tfn tfe tdn tdempty tdfull td1/td2 $p $p/td1 {} nul" { # foreach chmoddst {000 755} { # puts hi # cleanup # file delete -force ted tef # file mkdir ted # createfile tef # createfile tfe # file mkdir tdempty # file mkdir tdfull/td1/td2 # # catch {testchmod $chmodsrc $source} # catch {testchmod $chmoddst $dest} # # if [catch {file rename $source $dest} msg] { # puts "file rename $source ($chmodsrc) $dest ($chmoddst)" # puts $msg # } # } # } # } #} # cleanup cleanup ::tcltest::cleanupTests return |
Added tests/winFile.test.
> | 1 | # This file tests the tclWinFile.c file. # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1997 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # 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.1.1.1 2001/08/03 16:19:05 vincentdarley Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest namespace import -force ::tcltest::* } test winFile-1.1 {TclpGetUserHome} {pcOnly} { list [catch {glob ~nosuchuser} msg] $msg } {1 {user "nosuchuser" doesn't exist}} test winFile-1.2 {TclpGetUserHome} {nt nonPortable} { # The administrator account should always exist. catch {glob ~administrator} } {0} test winFile-1.2 {TclpGetUserHome} {95} { # Find some user in system.ini and then see if they have a home. set f [open $::env(windir)/system.ini] set x 0 while {![eof $f]} { set line [gets $f] if {$line == "\[Password Lists]"} { gets $f set name [lindex [split [gets $f] =] 0] if {$name != ""} { set x [catch {glob ~$name}] break } } } close $f set x } {0} test winFile-1.3 {TclpGetUserHome} {nt nonPortable} { catch {glob ~stanton@workgroup} } {0} test winFile-2.1 {TclpMatchFiles: case sensitivity} {pcOnly fsIsWritable} { makeFile {} GlobCapS set result [list [glob -nocomplain GlobC*] [glob -nocomplain globc*]] removeFile GlobCapS set result } {GlobCapS GlobCapS} test winFile-2.2 {TclpMatchFiles: case sensitivity} {pcOnly fsIsWritable} { makeFile {} globlower set result [list [glob -nocomplain globl*] [glob -nocomplain gLOBl*]] removeFile globlower set result } {globlower globlower} # cleanup ::tcltest::cleanupTests return |
Added win/makefile.vc.
> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 | # Makefile.vc # # This makefile is suitable for use with # Microsoft Visual C++ 2.x and 4.0. # # This makefile was hacked from Sun's 'example.zip' # Copyright (c) 1996 Sun Microsystems, Inc. # Copyright 1997 Tom Poindexter. # Copyright 2001 Vince Darley. # MACHINE = IX86 VFS_VERSION = 1.0 DLL_VERSION = 10 PROJECT = vfs$(DLL_VERSION) # # Project directories -- these may need to be customized for your site # # ROOT -- location of the example files. # TOOLS32 -- location of VC++ compiler installation. # TCL -- location where Tcl is installed. # TCLLIB -- define the Tcl lib (with correct version) # note that the tcl vclibs should have been unpacked in $(TCL)\lib !! ROOT = .. WINDIR = $(ROOT)\win GENERICDIR = $(ROOT)\generic TOOLS32 = C:\Progra~1\devstudio\vc TOOLS32_rc = C:\Progra~1\devstudio\sharedide cc32 = "$(TOOLS32)\bin\cl.exe" link32 = "$(TOOLS32)\bin\link.exe" libpath32 = /LIBPATH:"$(TOOLS32)\lib" lib32 = "$(TOOLS32)\bin\lib.exe" rc32 = "$(TOOLS32_rc)\bin\rc.exe" include32 = -I"$(TOOLS32)\include" # point TCL and TCLLIB to your tcl distribution TCL = c:\progra~1\tcl TCLLIB = $(TCL)\lib\tclstub84.lib # comment the following line to compile with symbols NODEBUG=1 ###################################################################### # Link flags ###################################################################### !IF "$(NODEBUG)" == "1" ldebug = /RELEASE !ELSE ldebug = -debug:full -debugtype:cv !ENDIF # declarations common to all linker options lflags = /NODEFAULTLIB /NOLOGO /MACHINE:$(MACHINE) $(libpath32) # declarations for use on Intel i386, i486, and Pentium systems !IF "$(MACHINE)" == "IX86" DLLENTRY = @12 dlllflags = $(lflags) -entry:_DllMainCRTStartup$(DLLENTRY) -dll !ELSE IF "$(MACHINE)" == "IA64" DLLENTRY = @12 dlllflags = $(lflags) -dll !ELSE dlllflags = $(lflags) -entry:_DllMainCRTStartup$(DLLENTRY) -dll !ENDIF conlflags = $(lflags) -subsystem:console -entry:mainCRTStartup guilflags = $(lflags) -subsystem:windows -entry:WinMainCRTStartup !IF "$(MACHINE)" == "PPC" libc = libc$(DBGX).lib libcdll = crtdll$(DBGX).lib !ELSE libc = libc$(DBGX).lib oldnames.lib libcdll = msvcrt$(DBGX).lib oldnames.lib !ENDIF baselibs = kernel32.lib $(optlibs) advapi32.lib user32.lib winlibs = $(baselibs) gdi32.lib comdlg32.lib winspool.lib guilibs = $(libc) $(winlibs) conlibs = $(libc) $(baselibs) guilibsdll = $(libcdll) $(winlibs) conlibsdll = $(libcdll) $(baselibs) VFSOBJS = \ $(WINDIR)\vfs.obj # # Visual C++ tools # PATH=$(COMMON32)/bin;$(TOOLS32)\bin;$(PATH) cc32 = $(TOOLS32)\bin\cl -I$(TOOLS32)\include CP = copy RM = del INCLUDES = \ -I../../tcl8.4/generic \ -I../../tcl8.4/windows \ -I$(TOOLS32)/include \ -I../generic DEFINES = -nologo $(DEBUGDEFINES) -DUSE_TCL_STUBS -DVERSION=\"1.0\" # # Global makefile settings # DLLOBJS = \ $(WINDIR)\vfs.obj # Targets all: $(PROJECT).dll $(PROJECT).dll: $(DLLOBJS) $(link32) $(ldebug) $(dlllflags) $(TCLLIB) \ $(guilibsdll) -out:$(PROJECT).dll $(DLLOBJS) # Implicit Targets #.c.obj: # $(cc32) $(cdebug) $(cflags) $(cvarsdll) $(INCLUDES) \ # $(DEFINES) -Fo$(WINDIR)\ $< $(WINDIR)\vfs.obj: $(GENERICDIR)\vfs.c $(cc32) $(cdebug) $(cflags) $(cvarsdll) $(INCLUDES) \ $(DEFINES) -Fo$(WINDIR)\ $? clean: -$(RM) $(WINDIR)\*.obj -$(RM) $(PROJECT).dll -$(RM) $(PROJECT).lib -$(RM) $(PROJECT).exp |
Added win/vfs.exp.
cannot compute difference between binary files
Added win/vfs.lib.
cannot compute difference between binary files
Added win/vfs10.exp.
cannot compute difference between binary files
Added win/vfs10.lib.
cannot compute difference between binary files