TclVFS

Changes On Branch vendor
Login

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