Tcl Source Code

2007-07-28  Jan Nijtmans  <[email protected]>

	* doc/FileSystem.3:        CONSTified many functions using Tcl_FileSystem
	* generic/tcl.decls:       which all are supposed to be a constant, but
	* generic/tclDecls.h:      this was not reflected in the API:
	* generic/tclFileSystem.h:    Tcl_FSGetInternalRep
	* generic/tclIOUtil.c:        Tcl_FSNewNativePath, Tcl_FSData
	* generic/tclPathObj.c:	      Tcl_FSRegister, Tcl_FSUnregister
	* generic/tclTest.c:	      Tcl_FSGetFileSystemForPath ...
	This change complies with TIP #24.
	***POTENTIAL INCOMPATIBILITY***

2008-07-28  Andreas Kupries  <[email protected]>

	* generic/tclBasic.c: Added missing ref count when creating an
	empty string as path (TclEvalEx). In 8.4 the missing code caused
	panics in the testsuite. It doesn't in 8.5. I am guessing that the
	code path with the missing the incr-refcount is not invoked any
	longer. Because the bug in itself is certainly the same.

'\"
'\" Copyright (c) 2001 Vincent Darley
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" RCS: @(#) $Id: FileSystem.3,v 1.64 2008/07/28 21:31:13 nijtmans Exp $
'\" 
.so man.macros
.TH Filesystem 3 8.4 Tcl "Tcl Library Procedures"
.BS
.SH NAME
Tcl_FSRegister, Tcl_FSUnregister, Tcl_FSData, Tcl_FSMountsChanged, Tcl_FSGetFileSystemForPath, Tcl_FSGetPathType, Tcl_FSCopyFile, Tcl_FSCopyDirectory, Tcl_FSCreateDirectory, Tcl_FSDeleteFile, Tcl_FSRemoveDirectory, Tcl_FSRenameFile, Tcl_FSListVolumes, Tcl_FSEvalFile, Tcl_FSEvalFileEx, Tcl_FSLoadFile, Tcl_FSMatchInDirectory, Tcl_FSLink, Tcl_FSLstat, Tcl_FSUtime, Tcl_FSFileAttrsGet, Tcl_FSFileAttrsSet, Tcl_FSFileAttrStrings, Tcl_FSStat, Tcl_FSAccess, Tcl_FSOpenFileChannel, Tcl_FSGetCwd, Tcl_FSChdir, Tcl_FSPathSeparator, Tcl_FSJoinPath, Tcl_FSSplitPath, Tcl_FSEqualPaths, Tcl_FSGetNormalizedPath, Tcl_FSJoinToPath, Tcl_FSConvertToPathType, Tcl_FSGetInternalRep, Tcl_FSGetTranslatedPath, Tcl_FSGetTranslatedStringPath, Tcl_FSNewNativePath, Tcl_FSGetNativePath, Tcl_FSFileSystemInfo, Tcl_AllocStatBuf \- procedures to interact with any filesystem
.SH SYNOPSIS

.sp
ClientData
\fBTcl_FSData\fR(\fIfsPtr\fR)
.sp
void
\fBTcl_FSMountsChanged\fR(\fIfsPtr\fR)
.sp
const Tcl_Filesystem *
\fBTcl_FSGetFileSystemForPath\fR(\fIpathPtr\fR)
.sp
Tcl_PathType
\fBTcl_FSGetPathType\fR(\fIpathPtr\fR)
.sp
int
\fBTcl_FSCopyFile\fR(\fIsrcPathPtr, destPathPtr\fR)

Tcl_Obj *
\fBTcl_FSFileSystemInfo\fR(\fIpathPtr\fR)
.sp
Tcl_StatBuf *
\fBTcl_AllocStatBuf\fR()
.SH ARGUMENTS
.AS Tcl_FSUnloadFileProc **unloadProcPtr out
.AP "const Tcl_Filesystem" *fsPtr in
Points to a structure containing the addresses of procedures that
can be called to perform the various filesystem operations.
.AP Tcl_Obj *pathPtr in
The path represented by this object is used for the operation in
question.  If the object does not already have an internal \fBpath\fR
representation, it will be converted to have one.
.AP Tcl_Obj *srcPathPtr in

given path within that filesystem (which is filesystem dependent).  The
second element may be empty if the filesystem does not provide a
further categorization of files.
.PP
A valid list object is returned, unless the path object is not
recognized, when NULL will be returned.
.PP
\fBTcl_FSGetFileSystemForPath\fR returns a pointer to the
\fBTcl_Filesystem\fR which accepts this path as valid.
.PP
If no filesystem will accept the path, NULL is returned.
.PP
\fBTcl_FSGetPathType\fR determines whether the given path is relative
to the current directory, relative to the current volume, or
absolute.

# Copyright (c) 1998-1999 by Scriptics Corporation.
# Copyright (c) 2001, 2002 by Kevin B. Kenny.  All rights reserved.
# Copyright (c) 2007 Daniel A. Steffen <[email protected]>
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id: tcl.decls,v 1.141 2008/07/28 21:31:15 nijtmans Exp $

library tcl

# Define the tcl interface with several sub interfaces:
#     tclPlat	 - platform specific public
#     tclInt	 - generic private
#     tclPlatInt - platform specific private

}
declare 464 generic {
    Tcl_Obj* Tcl_FSJoinToPath(Tcl_Obj *pathPtr, int objc,
	    Tcl_Obj *CONST objv[])
}
declare 465 generic {
    ClientData Tcl_FSGetInternalRep(Tcl_Obj* pathPtr,
	    CONST86 Tcl_Filesystem *fsPtr)
}
declare 466 generic {
    Tcl_Obj* Tcl_FSGetTranslatedPath(Tcl_Interp *interp, Tcl_Obj* pathPtr)
}
declare 467 generic {
    int Tcl_FSEvalFile(Tcl_Interp *interp, Tcl_Obj *fileName)
}
declare 468 generic {
    Tcl_Obj* Tcl_FSNewNativePath(CONST86 Tcl_Filesystem* fromFilesystem,
	    ClientData clientData)
}
declare 469 generic {
    CONST char* Tcl_FSGetNativePath(Tcl_Obj* pathPtr)
}
declare 470 generic {
    Tcl_Obj* Tcl_FSFileSystemInfo(Tcl_Obj* pathPtr)
}
declare 471 generic {
    Tcl_Obj* Tcl_FSPathSeparator(Tcl_Obj* pathPtr)
}
declare 472 generic {
    Tcl_Obj* Tcl_FSListVolumes(void)
}
declare 473 generic {
    int Tcl_FSRegister(ClientData clientData, CONST86 Tcl_Filesystem *fsPtr)
}
declare 474 generic {
    int Tcl_FSUnregister(CONST86 Tcl_Filesystem *fsPtr)
}
declare 475 generic {
    ClientData Tcl_FSData(CONST86 Tcl_Filesystem *fsPtr)
}
declare 476 generic {
    CONST char* Tcl_FSGetTranslatedStringPath(Tcl_Interp *interp,
	    Tcl_Obj* pathPtr)
}
declare 477 generic {
    CONST86_RETURN Tcl_Filesystem* Tcl_FSGetFileSystemForPath(Tcl_Obj* pathPtr)
}
declare 478 generic {
    Tcl_PathType Tcl_FSGetPathType(Tcl_Obj *pathPtr)
}
# New function due to TIP#49
declare 479 generic {
    int Tcl_OutputBuffered(Tcl_Channel chan)
}
declare 480 generic {
    void Tcl_FSMountsChanged(CONST86 Tcl_Filesystem *fsPtr)
}
# New function due to TIP#56
declare 481 generic {
    int Tcl_EvalTokensStandard(Tcl_Interp *interp, Tcl_Token *tokenPtr,
	    int count)
}

/*
 * tclDecls.h --
 *
 *	Declarations of functions in the platform independent public Tcl API.
 *
 * 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: tclDecls.h,v 1.143 2008/07/28 21:31:21 nijtmans Exp $
 */

#ifndef _TCLDECLS
#define _TCLDECLS

#undef TCL_STORAGE_CLASS
#ifdef BUILD_tcl

EXTERN Tcl_Obj*		Tcl_FSJoinToPath (Tcl_Obj * pathPtr, int objc, 
				Tcl_Obj *CONST objv[]);
#endif
#ifndef Tcl_FSGetInternalRep_TCL_DECLARED
#define Tcl_FSGetInternalRep_TCL_DECLARED
/* 465 */
EXTERN ClientData	Tcl_FSGetInternalRep (Tcl_Obj* pathPtr, 
				CONST86 Tcl_Filesystem * fsPtr);
#endif
#ifndef Tcl_FSGetTranslatedPath_TCL_DECLARED
#define Tcl_FSGetTranslatedPath_TCL_DECLARED
/* 466 */
EXTERN Tcl_Obj*		Tcl_FSGetTranslatedPath (Tcl_Interp * interp, 
				Tcl_Obj* pathPtr);
#endif
#ifndef Tcl_FSEvalFile_TCL_DECLARED
#define Tcl_FSEvalFile_TCL_DECLARED
/* 467 */
EXTERN int		Tcl_FSEvalFile (Tcl_Interp * interp, 
				Tcl_Obj * fileName);
#endif
#ifndef Tcl_FSNewNativePath_TCL_DECLARED
#define Tcl_FSNewNativePath_TCL_DECLARED
/* 468 */
EXTERN Tcl_Obj*		Tcl_FSNewNativePath (
				CONST86 Tcl_Filesystem* fromFilesystem, 
				ClientData clientData);
#endif
#ifndef Tcl_FSGetNativePath_TCL_DECLARED
#define Tcl_FSGetNativePath_TCL_DECLARED
/* 469 */
EXTERN CONST char*	Tcl_FSGetNativePath (Tcl_Obj* pathPtr);
#endif

/* 472 */
EXTERN Tcl_Obj*		Tcl_FSListVolumes (void);
#endif
#ifndef Tcl_FSRegister_TCL_DECLARED
#define Tcl_FSRegister_TCL_DECLARED
/* 473 */
EXTERN int		Tcl_FSRegister (ClientData clientData, 
				CONST86 Tcl_Filesystem * fsPtr);
#endif
#ifndef Tcl_FSUnregister_TCL_DECLARED
#define Tcl_FSUnregister_TCL_DECLARED
/* 474 */
EXTERN int		Tcl_FSUnregister (CONST86 Tcl_Filesystem * fsPtr);
#endif
#ifndef Tcl_FSData_TCL_DECLARED
#define Tcl_FSData_TCL_DECLARED
/* 475 */
EXTERN ClientData	Tcl_FSData (CONST86 Tcl_Filesystem * fsPtr);
#endif
#ifndef Tcl_FSGetTranslatedStringPath_TCL_DECLARED
#define Tcl_FSGetTranslatedStringPath_TCL_DECLARED
/* 476 */
EXTERN CONST char*	Tcl_FSGetTranslatedStringPath (Tcl_Interp * interp, 
				Tcl_Obj* pathPtr);
#endif
#ifndef Tcl_FSGetFileSystemForPath_TCL_DECLARED
#define Tcl_FSGetFileSystemForPath_TCL_DECLARED
/* 477 */
EXTERN CONST86_RETURN Tcl_Filesystem* Tcl_FSGetFileSystemForPath (
				Tcl_Obj* pathPtr);
#endif
#ifndef Tcl_FSGetPathType_TCL_DECLARED
#define Tcl_FSGetPathType_TCL_DECLARED
/* 478 */
EXTERN Tcl_PathType	Tcl_FSGetPathType (Tcl_Obj * pathPtr);
#endif
#ifndef Tcl_OutputBuffered_TCL_DECLARED
#define Tcl_OutputBuffered_TCL_DECLARED
/* 479 */
EXTERN int		Tcl_OutputBuffered (Tcl_Channel chan);
#endif
#ifndef Tcl_FSMountsChanged_TCL_DECLARED
#define Tcl_FSMountsChanged_TCL_DECLARED
/* 480 */
EXTERN void		Tcl_FSMountsChanged (CONST86 Tcl_Filesystem * fsPtr);
#endif
#ifndef Tcl_EvalTokensStandard_TCL_DECLARED
#define Tcl_EvalTokensStandard_TCL_DECLARED
/* 481 */
EXTERN int		Tcl_EvalTokensStandard (Tcl_Interp * interp, 
				Tcl_Token * tokenPtr, int count);
#endif

    int (*tcl_FSChdir) (Tcl_Obj * pathPtr); /* 458 */
    int (*tcl_FSConvertToPathType) (Tcl_Interp * interp, Tcl_Obj * pathPtr); /* 459 */
    Tcl_Obj* (*tcl_FSJoinPath) (Tcl_Obj * listObj, int elements); /* 460 */
    Tcl_Obj* (*tcl_FSSplitPath) (Tcl_Obj* pathPtr, int * lenPtr); /* 461 */
    int (*tcl_FSEqualPaths) (Tcl_Obj* firstPtr, Tcl_Obj* secondPtr); /* 462 */
    Tcl_Obj* (*tcl_FSGetNormalizedPath) (Tcl_Interp * interp, Tcl_Obj* pathPtr); /* 463 */
    Tcl_Obj* (*tcl_FSJoinToPath) (Tcl_Obj * pathPtr, int objc, Tcl_Obj *CONST objv[]); /* 464 */
    ClientData (*tcl_FSGetInternalRep) (Tcl_Obj* pathPtr, CONST86 Tcl_Filesystem * fsPtr); /* 465 */
    Tcl_Obj* (*tcl_FSGetTranslatedPath) (Tcl_Interp * interp, Tcl_Obj* pathPtr); /* 466 */
    int (*tcl_FSEvalFile) (Tcl_Interp * interp, Tcl_Obj * fileName); /* 467 */
    Tcl_Obj* (*tcl_FSNewNativePath) (CONST86 Tcl_Filesystem* fromFilesystem, ClientData clientData); /* 468 */
    CONST char* (*tcl_FSGetNativePath) (Tcl_Obj* pathPtr); /* 469 */
    Tcl_Obj* (*tcl_FSFileSystemInfo) (Tcl_Obj* pathPtr); /* 470 */
    Tcl_Obj* (*tcl_FSPathSeparator) (Tcl_Obj* pathPtr); /* 471 */
    Tcl_Obj* (*tcl_FSListVolumes) (void); /* 472 */
    int (*tcl_FSRegister) (ClientData clientData, CONST86 Tcl_Filesystem * fsPtr); /* 473 */
    int (*tcl_FSUnregister) (CONST86 Tcl_Filesystem * fsPtr); /* 474 */
    ClientData (*tcl_FSData) (CONST86 Tcl_Filesystem * fsPtr); /* 475 */
    CONST char* (*tcl_FSGetTranslatedStringPath) (Tcl_Interp * interp, Tcl_Obj* pathPtr); /* 476 */
    CONST86_RETURN Tcl_Filesystem* (*tcl_FSGetFileSystemForPath) (Tcl_Obj* pathPtr); /* 477 */
    Tcl_PathType (*tcl_FSGetPathType) (Tcl_Obj * pathPtr); /* 478 */
    int (*tcl_OutputBuffered) (Tcl_Channel chan); /* 479 */
    void (*tcl_FSMountsChanged) (CONST86 Tcl_Filesystem * fsPtr); /* 480 */
    int (*tcl_EvalTokensStandard) (Tcl_Interp * interp, Tcl_Token * tokenPtr, int count); /* 481 */
    void (*tcl_GetTime) (Tcl_Time* timeBuf); /* 482 */
    Tcl_Trace (*tcl_CreateObjTrace) (Tcl_Interp* interp, int level, int flags, Tcl_CmdObjTraceProc* objProc, ClientData clientData, Tcl_CmdObjTraceDeleteProc* delProc); /* 483 */
    int (*tcl_GetCommandInfoFromToken) (Tcl_Command token, Tcl_CmdInfo* infoPtr); /* 484 */
    int (*tcl_SetCommandInfoFromToken) (Tcl_Command token, CONST Tcl_CmdInfo* infoPtr); /* 485 */
    Tcl_Obj * (*tcl_DbNewWideIntObj) (Tcl_WideInt wideValue, CONST char * file, int line); /* 486 */
    int (*tcl_GetWideIntFromObj) (Tcl_Interp * interp, Tcl_Obj * objPtr, Tcl_WideInt * widePtr); /* 487 */

/*
 * tclFileSystem.h --
 *
 *	This file contains the common defintions and prototypes for use by
 *	Tcl's filesystem and path handling layers.
 *
 * Copyright (c) 2003 Vince Darley.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclFileSystem.h,v 1.13 2008/07/28 21:31:21 nijtmans Exp $
 */

#ifndef _TCLFILESYSTEM
#define _TCLFILESYSTEM

#include "tcl.h"

/*
 * struct FilesystemRecord --
 *
 * A filesystem record is used to keep track of each filesystem currently
 * registered with the core, in a linked list. Pointers to these structures
 * are also kept by each "path" Tcl_Obj, and we must retain a refCount on the
 * number of such references.
 */

typedef struct FilesystemRecord {
    ClientData clientData;	/* Client specific data for the new filesystem
				 * (can be NULL) */
    const Tcl_Filesystem *fsPtr;	/* Pointer to filesystem dispatch table. */
    int fileRefCount;		/* How many Tcl_Obj's use this filesystem. */
    struct FilesystemRecord *nextPtr;
				/* The next filesystem registered to Tcl, or
				 * NULL if no more. */
    struct FilesystemRecord *prevPtr;
				/* The previous filesystem registered to Tcl,
				 * or NULL if no more. */

			    Tcl_Obj *pathPtr, ClientData clientData);
MODULE_SCOPE int	TclFSNormalizeToUniquePath(Tcl_Interp *interp,
			    Tcl_Obj *pathPtr, int startAt,
			    ClientData *clientDataPtr);
MODULE_SCOPE Tcl_Obj *	TclFSMakePathRelative(Tcl_Interp *interp,
			    Tcl_Obj *pathPtr, Tcl_Obj *cwdPtr);
MODULE_SCOPE Tcl_Obj *	TclFSInternalToNormalized(
			    const Tcl_Filesystem *fromFilesystem,
			    ClientData clientData,
			    FilesystemRecord **fsRecPtrPtr);
MODULE_SCOPE int	TclFSEnsureEpochOk(Tcl_Obj *pathPtr,
			    const Tcl_Filesystem **fsPtrPtr);
MODULE_SCOPE void	TclFSSetPathDetails(Tcl_Obj *pathPtr,
			    FilesystemRecord *fsRecPtr,
			    ClientData clientData);
MODULE_SCOPE Tcl_Obj *	TclFSNormalizeAbsolutePath(Tcl_Interp *interp,
			    Tcl_Obj *pathPtr, ClientData *clientDataPtr);

/*
 * Private shared variables for use by tclIOUtil.c and tclPathObj.c
 */

MODULE_SCOPE const Tcl_Filesystem tclNativeFilesystem;
MODULE_SCOPE Tcl_ThreadDataKey tclFsDataKey;

/*
 * Private shared functions for use by tclIOUtil.c, tclPathObj.c and
 * tclFileName.c, and any platform-specific filesystem code.
 */

MODULE_SCOPE Tcl_PathType TclFSGetPathType(Tcl_Obj *pathPtr,
			    const Tcl_Filesystem **filesystemPtrPtr,
			    int *driveNameLengthPtr);
MODULE_SCOPE Tcl_PathType TclFSNonnativePathType(const char *pathPtr,
			    int pathLen, const Tcl_Filesystem **filesystemPtrPtr,
			    int *driveNameLengthPtr, Tcl_Obj **driveNameRef);
MODULE_SCOPE Tcl_PathType TclGetPathType(Tcl_Obj *pathPtr,
			    const Tcl_Filesystem **filesystemPtrPtr,
			    int *driveNameLengthPtr, Tcl_Obj **driveNameRef);
MODULE_SCOPE int	TclFSEpochOk(int filesystemEpoch);
MODULE_SCOPE int	TclFSCwdIsNative(void);
MODULE_SCOPE Tcl_Obj *	TclWinVolumeRelativeNormalize(Tcl_Interp *interp,
			    const char *path, Tcl_Obj **useThisCwdPtr);

MODULE_SCOPE Tcl_FSPathInFilesystemProc TclNativePathInFilesystem;
MODULE_SCOPE Tcl_FSCreateInternalRepProc TclNativeCreateNativeRep;

#endif /* _TCLFILESYSTEM */

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

 * Copyright (c) 1991-1994 The Regents of the University of California.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 * Copyright (c) 2001-2004 Vincent Darley.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclIOUtil.c,v 1.155 2008/07/28 21:31:15 nijtmans Exp $
 */

#include "tclInt.h"
#ifdef __WIN32__
#   include "tclWinInt.h"
#endif
#include "tclFileSystem.h"

MODULE_SCOPE const TclFileAttrProcs	tclpFileAttrProcs[];

/*
 * The following functions are obsolete string based APIs, and should be
 * removed in a future release (Tcl 9 would be a good time).
 */


/* Obsolete */
int
Tcl_Stat(
    const char *path,		/* Path of file to stat (in current CP). */
    struct stat *oldStyleBuf)	/* Filled with results of stat call. */
{
    int ret;

#ifdef HAVE_ST_BLOCKS
	oldStyleBuf->st_blksize	= buf.st_blksize;
	oldStyleBuf->st_blocks	= (blkcnt_t) buf.st_blocks;
#endif
    }
    return ret;
}

/* Obsolete */
int
Tcl_Access(
    const char *path,		/* Path of file to access (in current CP). */
    int mode)			/* Permission setting. */
{
    int ret;
    Tcl_Obj *pathPtr = Tcl_NewStringObj(path,-1);

    Tcl_IncrRefCount(pathPtr);
    ret = Tcl_FSAccess(pathPtr,mode);
    Tcl_DecrRefCount(pathPtr);

    return ret;
}

/* Obsolete */
Tcl_Channel
Tcl_OpenFileChannel(
    Tcl_Interp *interp,		/* Interpreter for error reporting; can be
				 * NULL. */
    const char *path,		/* Name of file to open. */
    const 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 ret;
    Tcl_Obj *pathPtr = Tcl_NewStringObj(path,-1);

    Tcl_IncrRefCount(pathPtr);
    ret = Tcl_FSOpenFileChannel(interp, pathPtr, modeString, permissions);
    Tcl_DecrRefCount(pathPtr);

    return ret;
}

/* Obsolete */
int
Tcl_Chdir(
    const char *dirName)
{
    int ret;
    Tcl_Obj *pathPtr = Tcl_NewStringObj(dirName,-1);
    Tcl_IncrRefCount(pathPtr);
    ret = Tcl_FSChdir(pathPtr);
    Tcl_DecrRefCount(pathPtr);
    return ret;
}

/* Obsolete */
char *
Tcl_GetCwd(
    Tcl_Interp *interp,
    Tcl_DString *cwdPtr)
{
    Tcl_Obj *cwd = Tcl_FSGetCwd(interp);

    if (cwd == NULL) {
	return NULL;
    }
    Tcl_DStringInit(cwdPtr);
    Tcl_DStringAppend(cwdPtr, Tcl_GetString(cwd), -1);
    Tcl_DecrRefCount(cwd);
    return Tcl_DStringValue(cwdPtr);
}

/* Obsolete */
int
Tcl_EvalFile(
    Tcl_Interp *interp,		/* Interpreter in which to process file. */
    const char *fileName)	/* Name of file to process. Tilde-substitution
				 * will be performed on this name. */
{
    int ret;
    Tcl_Obj *pathPtr = Tcl_NewStringObj(fileName,-1);

    Tcl_IncrRefCount(pathPtr);
    ret = Tcl_FSEvalFile(interp, pathPtr);
    Tcl_DecrRefCount(pathPtr);
    return ret;
}

/*
 * The 3 hooks for Stat, Access and OpenFileChannel are obsolete. The
 * complete, general hooked filesystem APIs should be used instead. This
 * define decides whether to include the obsolete hooks and related code. If
 * these are removed, we'll also want to remove them from stubs/tclInt. The
 * only known users of these APIs are prowrap and mktclapp. New
 * code/extensions should not use them, since they do not provide as full
 * support as the full filesystem API.
 *
 * As soon as prowrap and mktclapp are updated to use the full filesystem
 * support, I suggest all these hooks are removed.
 */



/*
 * Declare the native filesystem support. These functions should be considered
 * private to Tcl, and should really not be called directly by any code other
 * than this file (i.e. neither by Tcl's core nor by extensions). Similarly,
 * the old string-based Tclp... native filesystem functions should not be
 * called.

 * Define the native filesystem dispatch table. If necessary, it is ok to make
 * this non-static, but it should only be accessed by the functions actually
 * listed within it (or perhaps other helper functions of them). Anything
 * which is not part of this 'native filesystem implementation' should not be
 * delving inside here!
 */

const Tcl_Filesystem tclNativeFilesystem = {
    "native",
    sizeof(Tcl_Filesystem),
    TCL_FILESYSTEM_VERSION_2,
    &TclNativePathInFilesystem,
    &TclNativeDupInternalRep,
    &NativeFreeInternalRep,
    &TclpNativeToNormalized,

typedef struct FsDivertLoad {
    Tcl_LoadHandle loadHandle;
    Tcl_FSUnloadFileProc *unloadProcPtr;
    Tcl_Obj *divertedFile;
    const Tcl_Filesystem *divertedFilesystem;
    ClientData divertedFileNativeRep;
} FsDivertLoad;

/*
 * Now move on to the basic filesystem implementation
 */

static void
FsThrExitProc(
    ClientData cd)

	if (--fsRecPtr->fileRefCount <= 0) {
	    ckfree((char *) fsRecPtr);
	}
	fsRecPtr = tmpFsRecPtr;
    }
    tsdPtr->initialized = 0;
}

int
TclFSCwdIsNative(void)
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey);

    if (tsdPtr->cwdClientData != NULL) {
	return 1;
    } else {
	return 0;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * TclFSCwdPointerEquals --
 *
 *	Check whether the current working directory is equal to the path
 *	given.

	    Tcl_IncrRefCount(*pathPtrPtr);
	    return 1;
	} else {
	    return 0;
	}
    }
}

#ifdef TCL_THREADS
static void
FsRecacheFilesystemList(void)
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey);
    FilesystemRecord *fsRecPtr, *tmpFsRecPtr = NULL;

    if (tsdPtr->initialized == 0) {
	Tcl_CreateThreadExitHandler(FsThrExitProc, tsdPtr);
	tsdPtr->initialized = 1;
    }
}
#endif /* TCL_THREADS */

static FilesystemRecord *
FsGetFirstFilesystem(void)
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey);
    FilesystemRecord *fsRecPtr;

#ifndef TCL_THREADS

	tsdPtr->filesystemEpoch = theFilesystemEpoch;
    }
    Tcl_MutexUnlock(&filesystemMutex);
    fsRecPtr = tsdPtr->filesystemList;
#endif
    return fsRecPtr;
}

/*
 * The epoch can be changed both by filesystems being added or removed and by
 * env(HOME) changing.
 */

int
TclFSEpochOk(
    int filesystemEpoch)
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey);
    (void) FsGetFirstFilesystem();
    return (filesystemEpoch == tsdPtr->filesystemEpoch);
}

/*
 * If non-NULL, clientData is owned by us and must be freed later.
 */

static void
FsUpdateCwd(
    Tcl_Obj *cwdObj,

	tsdPtr->cwdClientData = NULL;
    } else {
	tsdPtr->cwdPathPtr = Tcl_NewStringObj(str, len);
	tsdPtr->cwdClientData = clientData;
	Tcl_IncrRefCount(tsdPtr->cwdPathPtr);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * TclFinalizeFilesystem --
 *
 *	Clean up the filesystem. After this, calls to all Tcl_FS... functions
 *	will fail.

     * filesystem is likely to fail.
     */

#ifdef __WIN32__
    TclWinEncodingsCleanup();
#endif
}

/*
 *----------------------------------------------------------------------
 *
 * TclResetFilesystem --
 *
 *	Restore the filesystem to a pristine state.
 *

     * Cleans up the win32 API filesystem proc lookup table. This must happen
     * very late in finalization so that deleting of copied dlls can occur.
     */

    TclWinResetInterfaces();
#endif
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_FSRegister --
 *
 *	Insert the filesystem function table at the head of the list of
 *	functions which are used during calls to all file-system operations.

 *
 *----------------------------------------------------------------------
 */

int
Tcl_FSRegister(
    ClientData clientData,	/* Client specific data for this fs */
    const Tcl_Filesystem *fsPtr)	/* The filesystem record for the new fs. */
{
    FilesystemRecord *newFilesystemPtr;

    if (fsPtr == NULL) {
	return TCL_ERROR;
    }

     */

    theFilesystemEpoch++;
    Tcl_MutexUnlock(&filesystemMutex);

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_FSUnregister --
 *
 *	Remove the passed filesystem from the list of filesystem function
 *	tables. It also ensures that the built-in (native) filesystem is not

 *	updated immediately.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_FSUnregister(
    const Tcl_Filesystem *fsPtr)	/* The filesystem record to remove. */
{
    int retVal = TCL_ERROR;
    FilesystemRecord *fsRecPtr;

    Tcl_MutexLock(&filesystemMutex);

    /*

	    fsRecPtr = fsRecPtr->nextPtr;
	}
    }

    Tcl_MutexUnlock(&filesystemMutex);
    return retVal;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_FSMatchInDirectory --
 *
 *	This routine is used by the globbing code to search a directory for
 *	all files which match a given pattern. The appropriate function for

	    }
	}
	TclDecrRefCount(tmpResultPtr);
    }
    Tcl_DecrRefCount(cwd);
    return ret;
}

/*
 *----------------------------------------------------------------------
 *
 * FsAddMountsToGlobResult --
 *
 *	This routine is used by the globbing code to take the results of a
 *	directory listing and add any mounted paths to that listing. This is

	     */
	}
    }

  endOfMounts:
    Tcl_DecrRefCount(mounts);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_FSMountsChanged --
 *
 *	Notify the filesystem that the available mounted filesystems (or
 *	within any one filesystem type, the number or location of mount

 *	if it really doesn't understand them or if they don't exist).
 *
 *----------------------------------------------------------------------
 */

void
Tcl_FSMountsChanged(
    const Tcl_Filesystem *fsPtr)
{
    /*
     * We currently don't do anything with this parameter. We could in the
     * future only invalidate files for this filesystem or otherwise take more
     * advanced action.
     */

    (void)fsPtr;

    /*
     * Increment the filesystem epoch counter, since existing paths might now
     * belong to different filesystems.
     */

    Tcl_MutexLock(&filesystemMutex);
    theFilesystemEpoch++;
    Tcl_MutexUnlock(&filesystemMutex);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_FSData --
 *
 *	Retrieve the clientData field for the filesystem given, or NULL if
 *	that filesystem is not registered.

 *	None.
 *
 *----------------------------------------------------------------------
 */

ClientData
Tcl_FSData(
    const Tcl_Filesystem *fsPtr) /* The filesystem record to query. */
{
    ClientData retVal = NULL;
    FilesystemRecord *fsRecPtr = FsGetFirstFilesystem();

    /*
     * Traverse the list of filesystems look for a particular one. If found,
     * return that filesystem's clientData (originally provided when calling
     * Tcl_FSRegister).
     */

    while ((retVal == NULL) && (fsRecPtr != NULL)) {
	if (fsRecPtr->fsPtr == fsPtr) {
	    retVal = fsRecPtr->clientData;
	}
	fsRecPtr = fsRecPtr->nextPtr;
    }

    return retVal;
}

/*
 *---------------------------------------------------------------------------
 *
 * TclFSNormalizeToUniquePath --
 *
 *	Takes a path specification containing no ../, ./ sequences, and
 *	converts it into a unique path for the given platform. On Unix, this

	 *		if (retVal == length-of(pathPtr)) {break;}
	 * but there's not much benefit.
	 */
    }

    return startAt;
}

/*
 *---------------------------------------------------------------------------
 *
 * TclGetOpenMode --
 *
 *	This routine is an obsolete, limited version of TclGetOpenModeEx()
 *	below. It exists only to satisfy any extensions imprudently using it

    const char *modeString,	/* Mode string, e.g. "r+" or "RDONLY CREAT" */
    int *seekFlagPtr)		/* Set this to 1 if the caller should seek to
				 * EOF during the opening of the file. */
{
    int binary = 0;
    return TclGetOpenModeEx(interp, modeString, seekFlagPtr, &binary);
}

/*
 *---------------------------------------------------------------------------
 *
 * TclGetOpenModeEx --
 *
 *	Computes a POSIX mode mask for opening a file, from a given string,
 *	and also sets flags to indicate whether the caller should seek to EOF

	    Tcl_AppendResult(interp, "access mode must include either"
		    " RDONLY, WRONLY, or RDWR", NULL);
	}
	return -1;
    }
    return mode;
}

/*
 * Tcl_FSEvalFile is Tcl_FSEvalFileEx without encoding argument.
 */

int
Tcl_FSEvalFile(
    Tcl_Interp *interp,		/* Interpreter in which to process file. */
    Tcl_Obj *pathPtr)		/* Path of file to process. Tilde-substitution
				 * will be performed on this name. */
{
    return Tcl_FSEvalFileEx(interp, pathPtr, NULL);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_FSEvalFileEx --
 *
 *	Read in a file and process the entire file as one gigantic Tcl
 *	command.

		(overflow ? "..." : ""), interp->errorLine));
    }

  end:
    Tcl_DecrRefCount(objPtr);
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetErrno --
 *
 *	Gets the current value of the Tcl error code variable. This is
 *	currently the global variable "errno" but could in the future change

    /*
     * On some platforms, errno is really a thread local (implemented by the C
     * library).
     */

    return errno;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_SetErrno --
 *
 *	Sets the Tcl error code variable to the supplied value.
 *

    /*
     * On some platforms, errno is really a thread local (implemented by the C
     * library).
     */

    errno = err;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_PosixError --
 *
 *	This function is typically called after UNIX kernel calls return
 *	errors. It stores machine-readable information about the error in

    msg = Tcl_ErrnoMsg(errno);
    id = Tcl_ErrnoId();
    if (interp) {
	Tcl_SetErrorCode(interp, "POSIX", id, msg, NULL);
    }
    return msg;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_FSStat --
 *
 *	This function replaces the library version of stat and lsat.
 *

    if (fsPtr != NULL && fsPtr->statProc != NULL) {
	return fsPtr->statProc(pathPtr, buf);
    }
    Tcl_SetErrno(ENOENT);
    return -1;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_FSLstat --
 *
 *	This function replaces the library version of lstat. The appropriate
 *	function for the filesystem to which pathPtr belongs will be called.

	if (fsPtr->statProc != NULL) {
	    return fsPtr->statProc(pathPtr, buf);
	}
    }
    Tcl_SetErrno(ENOENT);
    return -1;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_FSAccess --
 *
 *	This function replaces the library version of access. The appropriate
 *	function for the filesystem to which pathPtr belongs will be called.

    if (fsPtr != NULL && fsPtr->accessProc != NULL) {
	return fsPtr->accessProc(pathPtr, mode);
    }
    Tcl_SetErrno(ENOENT);
    return -1;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_FSOpenFileChannel --
 *
 *	The appropriate function for the filesystem to which pathPtr belongs
 *	will be called.

    Tcl_SetErrno(ENOENT);
    if (interp != NULL) {
	Tcl_AppendResult(interp, "couldn't open \"", Tcl_GetString(pathPtr),
		"\": ", Tcl_PosixError(interp), NULL);
    }
    return NULL;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_FSUtime --
 *
 *	This function replaces the library version of utime. The appropriate
 *	function for the filesystem to which pathPtr belongs will be called.

    if (fsPtr != NULL && fsPtr->utimeProc != NULL) {
	return fsPtr->utimeProc(pathPtr, tval);
    }
    /* TODO: set errno here? Tcl_SetErrno(ENOENT); */
    return -1;
}

/*
 *----------------------------------------------------------------------
 *
 * NativeFileAttrStrings --
 *
 *	This function implements the platform dependent 'file attributes'
 *	subcommand, for the native filesystem, for listing the set of possible

static const char **
NativeFileAttrStrings(
    Tcl_Obj *pathPtr,
    Tcl_Obj **objPtrRef)
{
    return tclpFileAttrStrings;
}

/*
 *----------------------------------------------------------------------
 *
 * NativeFileAttrsGet --
 *
 *	This function implements the platform dependent 'file attributes'
 *	subcommand, for the native filesystem, for 'get' operations. This

    int index,			/* index of the attribute command. */
    Tcl_Obj *pathPtr,		/* path of file we are operating on. */
    Tcl_Obj **objPtrRef)	/* for output. */
{
    return (*tclpFileAttrProcs[index].getProc)(interp, index, pathPtr,
	    objPtrRef);
}

/*
 *----------------------------------------------------------------------
 *
 * NativeFileAttrsSet --
 *
 *	This function implements the platform dependent 'file attributes'
 *	subcommand, for the native filesystem, for 'set' operations. This

    Tcl_Interp *interp,		/* The interpreter for error reporting. */
    int index,			/* index of the attribute command. */
    Tcl_Obj *pathPtr,		/* path of file we are operating on. */
    Tcl_Obj *objPtr)		/* set to this value. */
{
    return (*tclpFileAttrProcs[index].setProc)(interp, index, pathPtr, objPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_FSFileAttrStrings --
 *
 *	This function implements part of the hookable 'file attributes'
 *	subcommand. The appropriate function for the filesystem to which

    if (fsPtr != NULL && fsPtr->fileAttrStringsProc != NULL) {
	return fsPtr->fileAttrStringsProc(pathPtr, objPtrRef);
    }
    Tcl_SetErrno(ENOENT);
    return NULL;
}

/*
 *----------------------------------------------------------------------
 *
 * TclFSFileAttrIndex --
 *
 *	Helper function for converting an attribute name to an index into the
 *	attribute table.

	}
	TclDecrRefCount(listObj);
	return TCL_ERROR;
    } else {
	return TCL_ERROR;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_FSFileAttrsGet --
 *
 *	This function implements read access for the hookable 'file
 *	attributes' subcommand. The appropriate function for the filesystem to

    if (fsPtr != NULL && fsPtr->fileAttrsGetProc != NULL) {
	return fsPtr->fileAttrsGetProc(interp, index, pathPtr, objPtrRef);
    }
    Tcl_SetErrno(ENOENT);
    return -1;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_FSFileAttrsSet --
 *
 *	This function implements write access for the hookable 'file
 *	attributes' subcommand. The appropriate function for the filesystem to

    if (fsPtr != NULL && fsPtr->fileAttrsSetProc != NULL) {
	return fsPtr->fileAttrsSetProc(interp, index, pathPtr, objPtr);
    }
    Tcl_SetErrno(ENOENT);
    return -1;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_FSGetCwd --
 *
 *	This function replaces the library version of getcwd().
 *

  cdDidNotChange:
    if (tsdPtr->cwdPathPtr != NULL) {
	Tcl_IncrRefCount(tsdPtr->cwdPathPtr);
    }

    return tsdPtr->cwdPathPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_FSChdir --
 *
 *	This function replaces the library version of chdir().
 *

	} else {
	    FsUpdateCwd(normDirName, NULL);
	}
    }

    return retVal;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_FSLoadFile --
 *
 *	Dynamically loads a binary code file into memory and returns the
 *	addresses of two functions within that file, if they are defined. The

     * This also means that the signatures Tcl_FSUnloadFileProc and
     * Tcl_FSLoadFileProc are both misleading.
     */

    *handlePtr = clientData;
    return res;
}

/*
 *----------------------------------------------------------------------
 *
 * TclLoadFile --
 *
 *	Dynamically loads a binary code file into memory and returns the
 *	addresses of a number of given functions within that file, if they are

				 * (*unloadProcPtr)() to unload the file. */
    Tcl_FSUnloadFileProc **unloadProcPtr)
				/* Filled with address of Tcl_FSUnloadFileProc
				 * function which should be used for this
				 * file. */
{
    const Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
    const Tcl_Filesystem *copyFsPtr;
    Tcl_Obj *copyToPtr;
    Tcl_LoadHandle newLoadHandle = NULL;
    ClientData newClientData = NULL;
    Tcl_FSUnloadFileProc *newUnloadProcPtr = NULL;
    FsDivertLoad *tvdlPtr;
    int retVal;

    *clientDataPtr = handle;

    *proc1Ptr = TclpFindSymbol(interp, handle, sym1);
    *proc2Ptr = TclpFindSymbol(interp, handle, sym2);
    return TCL_OK;
}

/*
 *---------------------------------------------------------------------------
 *
 * FSUnloadTempFile --
 *
 *	This function is called when we loaded a library of code via an
 *	intermediate temporary file. This function ensures the library is

	 */

	Tcl_DecrRefCount(tvdlPtr->divertedFile);
    }

    ckfree((char *) tvdlPtr);
}

/*
 *---------------------------------------------------------------------------
 *
 * Tcl_FSLink --
 *
 *	This function replaces the library version of readlink() and can also
 *	be used to make links. The appropriate function for the filesystem to

#ifndef S_IFLNK
    errno = EINVAL; /* TODO: Change to Tcl_SetErrno()? */
#else
    Tcl_SetErrno(ENOENT);
#endif /* S_IFLNK */
    return NULL;
}

/*
 *---------------------------------------------------------------------------
 *
 * Tcl_FSListVolumes --
 *
 *	Lists the currently mounted volumes. The chain of functions that have
 *	been "inserted" into the filesystem will be called in succession; each

	    }
	}
	fsRecPtr = fsRecPtr->nextPtr;
    }

    return resultPtr;
}

/*
 *---------------------------------------------------------------------------
 *
 * FsListMounts --
 *
 *	List all mounts within the given directory, which match the given
 *	pattern.

		    pattern, &mountsOnly);
	}
	fsRecPtr = fsRecPtr->nextPtr;
    }

    return resultPtr;
}

/*
 *---------------------------------------------------------------------------
 *
 * Tcl_FSSplitPath --
 *
 *	This function takes the given Tcl_Obj, which should be a valid path,
 *	and returns a Tcl List object containing each segment of that path as

Tcl_Obj *
Tcl_FSSplitPath(
    Tcl_Obj *pathPtr,		/* Path to split. */
    int *lenPtr)		/* int to store number of path elements. */
{
    Tcl_Obj *result = NULL;	/* Needed only to prevent gcc warnings. */
    const Tcl_Filesystem *fsPtr;
    char separator = '/';
    int driveNameLength;
    char *p;

    /*
     * Perform platform specific splitting.
     */

     */

    if (lenPtr != NULL) {
	TclListObjLength(NULL, result, lenPtr);
    }
    return result;
}

/* Simple helper function */
Tcl_Obj *
TclFSInternalToNormalized(
    const Tcl_Filesystem *fromFilesystem,
    ClientData clientData,
    FilesystemRecord **fsRecPtrPtr)
{
    FilesystemRecord *fsRecPtr = FsGetFirstFilesystem();

    while (fsRecPtr != NULL) {
	if (fsRecPtr->fsPtr == fromFilesystem) {
	    *fsRecPtrPtr = fsRecPtr;
	    break;
	}
	fsRecPtr = fsRecPtr->nextPtr;
    }

    if ((fsRecPtr == NULL)
	    || (fromFilesystem->internalToNormalizedProc == NULL)) {
	return NULL;
    }
    return (*fromFilesystem->internalToNormalizedProc)(clientData);
}

/*
 *----------------------------------------------------------------------
 *
 * TclGetPathType --
 *
 *	Helper function used by FSGetPathType.
 *

 *
 *----------------------------------------------------------------------
 */

Tcl_PathType
TclGetPathType(
    Tcl_Obj *pathPtr,		/* Path to determine type for */
    const Tcl_Filesystem **filesystemPtrPtr,
				/* If absolute path and this is not NULL, then
				 * set to the filesystem which claims this
				 * path. */
    int *driveNameLengthPtr,	/* If the path is absolute, and this is
				 * non-NULL, then set to the length of the
				 * driveName. */
    Tcl_Obj **driveNameRef)	/* If the path is absolute, and this is

		driveNameRef);
	if ((type == TCL_PATH_ABSOLUTE) && (filesystemPtrPtr != NULL)) {
	    *filesystemPtrPtr = &tclNativeFilesystem;
	}
    }
    return type;
}

/*
 *----------------------------------------------------------------------
 *
 * TclFSNonnativePathType --
 *
 *	Helper function used by TclGetPathType. Its purpose is to check
 *	whether the given path starts with a string which corresponds to a

 *----------------------------------------------------------------------
 */

Tcl_PathType
TclFSNonnativePathType(
    const char *path,		/* Path to determine type for */
    int pathLen,		/* Length of the path */
    const Tcl_Filesystem **filesystemPtrPtr,
				/* If absolute path and this is not NULL, then
				 * set to the filesystem which claims this
				 * path. */
    int *driveNameLengthPtr,	/* If the path is absolute, and this is
				 * non-NULL, then set to the length of the
				 * driveName. */
    Tcl_Obj **driveNameRef)	/* If the path is absolute, and this is

		}
	    }
	}
	fsRecPtr = fsRecPtr->nextPtr;
    }
    return type;
}

/*
 *---------------------------------------------------------------------------
 *
 * Tcl_FSRenameFile --
 *
 *	If the two paths given belong to the same filesystem, we call that
 *	filesystems rename function. Otherwise we simply return the POSIX

	retVal = fsPtr->renameFileProc(srcPathPtr, destPathPtr);
    }
    if (retVal == -1) {
	Tcl_SetErrno(EXDEV);
    }
    return retVal;
}

/*
 *---------------------------------------------------------------------------
 *
 * Tcl_FSCopyFile --
 *
 *	If the two paths given belong to the same filesystem, we call that
 *	filesystem's copy function. Otherwise we simply return the POSIX error

	retVal = fsPtr->copyFileProc(srcPathPtr, destPathPtr);
    }
    if (retVal == -1) {
	Tcl_SetErrno(EXDEV);
    }
    return retVal;
}

/*
 *---------------------------------------------------------------------------
 *
 * TclCrossFilesystemCopy --
 *
 *	Helper for above function, and for Tcl_FSLoadFile, to copy files from
 *	one filesystem to another. This function will overwrite the target

	tval.modtime = sourceStatBuf.st_mtime;
	Tcl_FSUtime(target, &tval);
    }

  done:
    return result;
}

/*
 *---------------------------------------------------------------------------
 *
 * Tcl_FSDeleteFile --
 *
 *	The appropriate function for the filesystem to which pathPtr belongs
 *	will be called.

    if (fsPtr != NULL && fsPtr->deleteFileProc != NULL) {
	return fsPtr->deleteFileProc(pathPtr);
    }
    Tcl_SetErrno(ENOENT);
    return -1;
}

/*
 *---------------------------------------------------------------------------
 *
 * Tcl_FSCreateDirectory --
 *
 *	The appropriate function for the filesystem to which pathPtr belongs
 *	will be called.

    if (fsPtr != NULL && fsPtr->createDirectoryProc != NULL) {
	return fsPtr->createDirectoryProc(pathPtr);
    }
    Tcl_SetErrno(ENOENT);
    return -1;
}

/*
 *---------------------------------------------------------------------------
 *
 * Tcl_FSCopyDirectory --
 *
 *	If the two paths given belong to the same filesystem, we call that
 *	filesystems copy-directory function. Otherwise we simply return the

	retVal = fsPtr->copyDirectoryProc(srcPathPtr, destPathPtr, errorPtr);
    }
    if (retVal == -1) {
	Tcl_SetErrno(EXDEV);
    }
    return retVal;
}

/*
 *---------------------------------------------------------------------------
 *
 * Tcl_FSRemoveDirectory --
 *
 *	The appropriate function for the filesystem to which pathPtr belongs
 *	will be called.

	    }
	}
	return fsPtr->removeDirectoryProc(pathPtr, recursive, errorPtr);
    }
    Tcl_SetErrno(ENOENT);
    return -1;
}

/*
 *---------------------------------------------------------------------------
 *
 * Tcl_FSGetFileSystemForPath --
 *
 *	This function determines which filesystem to use for a particular path
 *	object, and returns the filesystem which accepts this file. If no
 *	filesystem will accept this object as a valid file path, then NULL is
 *	returned.
 *
 * Results:
 *	NULL or a filesystem which will accept this path.
 *
 * Side effects:
 *	The object may be converted to a path type.
 *
 *---------------------------------------------------------------------------
 */

const Tcl_Filesystem *
Tcl_FSGetFileSystemForPath(
    Tcl_Obj *pathPtr)
{
    FilesystemRecord *fsRecPtr;
    const Tcl_Filesystem *retVal = NULL;

    if (pathPtr == NULL) {
	Tcl_Panic("Tcl_FSGetFileSystemForPath called with NULL object");
	return NULL;
    }

    /*

	    TclFSSetPathDetails(pathPtr, fsRecPtr, clientData);
	    return fsRecPtr->fsPtr;
	}
    }

    return NULL;
}

/*
 *---------------------------------------------------------------------------
 *
 * Tcl_FSGetNativePath --
 *
 *	This function is for use by the Win/Unix native filesystems, so that
 *	they can easily retrieve the native (char* or TCHAR*) representation

const char *
Tcl_FSGetNativePath(
    Tcl_Obj *pathPtr)
{
    return (const char *) Tcl_FSGetInternalRep(pathPtr, &tclNativeFilesystem);
}

/*
 *---------------------------------------------------------------------------
 *
 * NativeFreeInternalRep --
 *
 *	Free a native internal representation, which will be non-NULL.
 *

static void
NativeFreeInternalRep(
    ClientData clientData)
{
    ckfree((char *) clientData);
}

/*
 *---------------------------------------------------------------------------
 *
 * Tcl_FSFileSystemInfo --
 *
 *	This function returns a list of two elements. The first element is the
 *	name of the filesystem (e.g. "native" or "vfs"), and the second is the

	if (typePtr != NULL) {
	    Tcl_ListObjAppendElement(NULL, resPtr, typePtr);
	}
    }

    return resPtr;
}

/*
 *---------------------------------------------------------------------------
 *
 * Tcl_FSPathSeparator --
 *
 *	This function returns the separator to be used for a given path. The
 *	object returned should have a refCount of zero

	 * wish to use the standard forward slash.
	 */

	TclNewLiteralStringObj(resultObj, "/");
	return resultObj;
    }
}

/*
 *---------------------------------------------------------------------------
 *
 * NativeFilesystemSeparator --
 *
 *	This function is part of the native filesystem support, and returns
 *	the separator for the given path.

    case TCL_PLATFORM_WINDOWS:
	separator = "\\";
	break;
    }
    return Tcl_NewStringObj(separator,1);
}


/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

/*
 * tclPathObj.c --
 *
 *	This file contains the implementation of Tcl's "path" object type used
 *	to represent and manipulate a general (virtual) filesystem entity in
 *	an efficient manner.
 *
 * Copyright (c) 2003 Vince Darley.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclPathObj.c,v 1.73 2008/07/28 21:31:19 nijtmans Exp $
 */

#include "tclInt.h"
#include "tclFileSystem.h"

/*
 * Prototypes for functions defined later in this file.

 *
 *----------------------------------------------------------------------
 */

Tcl_PathType
TclFSGetPathType(
    Tcl_Obj *pathPtr,
    const Tcl_Filesystem **filesystemPtrPtr,
    int *driveNameLengthPtr)
{
    FsPath *fsPathPtr;

    if (Tcl_FSConvertToPathType(NULL, pathPtr) != TCL_OK) {
	return TclGetPathType(pathPtr, filesystemPtrPtr, driveNameLengthPtr,
		NULL);

Tcl_FSJoinPath(
    Tcl_Obj *listObj,		/* Path elements to join, may have a zero
				 * reference count. */
    int elements)		/* Number of elements to use (-1 = all) */
{
    Tcl_Obj *res;
    int i;
    const Tcl_Filesystem *fsPtr = NULL;

    if (elements < 0) {
	if (Tcl_ListObjLength(NULL, listObj, &elements) != TCL_OK) {
	    return NULL;
	}
    } else {
	/*

 *	New memory may be allocated.
 *
 *---------------------------------------------------------------------------
 */

Tcl_Obj *
Tcl_FSNewNativePath(
    const Tcl_Filesystem *fromFilesystem,
    ClientData clientData)
{
    Tcl_Obj *pathPtr;
    FsPath *fsPathPtr;

    FilesystemRecord *fsFromPtr;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey);

 *
 *---------------------------------------------------------------------------
 */

ClientData
Tcl_FSGetInternalRep(
    Tcl_Obj *pathPtr,
    const Tcl_Filesystem *fsPtr)
{
    FsPath *srcFsPathPtr;

    if (Tcl_FSConvertToPathType(NULL, pathPtr) != TCL_OK) {
	return NULL;
    }
    srcFsPathPtr = PATHOBJ(pathPtr);

 *
 *---------------------------------------------------------------------------
 */

int
TclFSEnsureEpochOk(
    Tcl_Obj *pathPtr,
    const Tcl_Filesystem **fsPtrPtr)
{
    FsPath *srcFsPathPtr;

    if (pathPtr->typePtr != &tclFsPathType) {
	return TCL_OK;
    }

 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 * Copyright (c) 1998-2000 Ajuba Solutions.
 * Copyright (c) 2003 by Kevin B. Kenny.  All rights reserved.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclTest.c,v 1.118 2008/07/28 21:31:19 nijtmans Exp $
 */

#define TCL_TEST
#include "tclInt.h"

/*
 * Required for Testregexp*Cmd

static int		TestNumUtfCharsCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
static int		TestHashSystemHashCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);

static const Tcl_Filesystem testReportingFilesystem = {
    "reporting",
    sizeof(Tcl_Filesystem),
    TCL_FILESYSTEM_VERSION_1,
    &TestReportInFilesystem, /* path in */
    &TestReportDupInternalRep,
    &TestReportFreeInternalRep,
    NULL, /* native to norm */

    &TestReportCopyDirectory,
    &TestReportLstat,
    &TestReportLoadFile,
    NULL /* cwd */,
    &TestReportChdir
};

static const Tcl_Filesystem simpleFilesystem = {
    "simple",
    sizeof(Tcl_Filesystem),
    TCL_FILESYSTEM_VERSION_1,
    &SimplePathInFilesystem,
    NULL,
    NULL,
    /* No internal to normalized, since we don't create any