summaryrefslogtreecommitdiffstats
path: root/generic/tclTest.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tclTest.c')
-rw-r--r--generic/tclTest.c156
1 files changed, 104 insertions, 52 deletions
diff --git a/generic/tclTest.c b/generic/tclTest.c
index f88412a..af93ff6 100644
--- a/generic/tclTest.c
+++ b/generic/tclTest.c
@@ -13,7 +13,7 @@
* 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.28 2001/08/30 08:53:15 vincentdarley Exp $
+ * RCS: @(#) $Id: tclTest.c,v 1.29 2001/09/04 18:06:34 vincentdarley Exp $
*/
#define TCL_TEST
@@ -319,7 +319,6 @@ static Tcl_FSStatProc TestReportStat;
static Tcl_FSAccessProc TestReportAccess;
static Tcl_FSOpenFileChannelProc TestReportOpenFileChannel;
static Tcl_FSMatchInDirectoryProc TestReportMatchInDirectory;
-static Tcl_FSGetCwdProc TestReportGetCwd;
static Tcl_FSChdirProc TestReportChdir;
static Tcl_FSLstatProc TestReportLstat;
static Tcl_FSCopyFileProc TestReportCopyFile;
@@ -331,20 +330,22 @@ static Tcl_FSRemoveDirectoryProc TestReportRemoveDirectory;
static Tcl_FSLoadFileProc TestReportLoadFile;
static Tcl_FSUnloadFileProc TestReportUnloadFile;
static Tcl_FSLinkProc TestReportLink;
-static Tcl_FSListVolumesProc TestReportListVolumes;
static Tcl_FSFileAttrStringsProc TestReportFileAttrStrings;
static Tcl_FSFileAttrsGetProc TestReportFileAttrsGet;
static Tcl_FSFileAttrsSetProc TestReportFileAttrsSet;
static Tcl_FSUtimeProc TestReportUtime;
static Tcl_FSNormalizePathProc TestReportNormalizePath;
+static Tcl_FSPathInFilesystemProc TestReportInFilesystem;
+static Tcl_FSFreeInternalRepProc TestReportFreeInternalRep;
+static Tcl_FSDupInternalRepProc TestReportDupInternalRep;
static Tcl_Filesystem testReportingFilesystem = {
"reporting",
sizeof(Tcl_Filesystem),
TCL_FILESYSTEM_VERSION_1,
- NULL, /* path in */
- NULL, /* native dup */
- NULL, /* native free */
+ &TestReportInFilesystem, /* path in */
+ &TestReportDupInternalRep,
+ &TestReportFreeInternalRep,
NULL, /* native to norm */
NULL, /* convert to native */
&TestReportNormalizePath,
@@ -356,7 +357,7 @@ static Tcl_Filesystem testReportingFilesystem = {
&TestReportMatchInDirectory,
&TestReportUtime,
&TestReportLink,
- &TestReportListVolumes,
+ NULL /* list volumes */,
&TestReportFileAttrStrings,
&TestReportFileAttrsGet,
&TestReportFileAttrsSet,
@@ -368,8 +369,7 @@ static Tcl_Filesystem testReportingFilesystem = {
&TestReportRenameFile,
&TestReportCopyDirectory,
&TestReportLoadFile,
- &TestReportUnloadFile,
- &TestReportGetCwd,
+ NULL /* cwd */,
&TestReportChdir
};
@@ -5257,10 +5257,62 @@ TestFilesystemObjCmd(dummy, interp, objc, objv)
return res;
}
+static int
+TestReportInFilesystem(Tcl_Obj *pathPtr, ClientData *clientDataPtr) {
+ static Tcl_Obj* lastPathPtr = NULL;
+
+ if (pathPtr == lastPathPtr) {
+ /* Reject all files second time around */
+ return -1;
+ } else {
+ Tcl_Obj * newPathPtr;
+ /* Try to claim all files first time around */
+
+ newPathPtr = Tcl_DuplicateObj(pathPtr);
+ lastPathPtr = newPathPtr;
+ Tcl_IncrRefCount(newPathPtr);
+ if (Tcl_FSGetFileSystemForPath(newPathPtr) == NULL) {
+ /* Nothing claimed it. Therefore we don't either */
+ Tcl_DecrRefCount(newPathPtr);
+ lastPathPtr = NULL;
+ return -1;
+ } else {
+ lastPathPtr = NULL;
+ *clientDataPtr = (ClientData) newPathPtr;
+ return TCL_OK;
+ }
+ }
+}
+
+/*
+ * Simple helper function to extract the native vfs representation of a
+ * path object, or NULL if no such representation exists.
+ */
+Tcl_Obj*
+TestReportGetNativePath(Tcl_Obj* pathObjPtr) {
+ return (Tcl_Obj*) Tcl_FSGetInternalRep(pathObjPtr, &testReportingFilesystem);
+}
+
+void
+TestReportFreeInternalRep(ClientData clientData) {
+ Tcl_Obj *nativeRep = (Tcl_Obj*)clientData;
+ if (nativeRep != NULL) {
+ /* Free the path */
+ Tcl_DecrRefCount(nativeRep);
+ }
+}
+
+ClientData
+TestReportDupInternalRep(ClientData clientData) {
+ Tcl_Obj *original = (Tcl_Obj*)clientData;
+ Tcl_IncrRefCount(original);
+ return clientData;
+}
+
static void
-TestReport(cmd, arg1, arg2)
+TestReport(cmd, path, arg2)
CONST char* cmd;
- Tcl_Obj* arg1;
+ Tcl_Obj* path;
Tcl_Obj* arg2;
{
Tcl_Interp* interp = (Tcl_Interp*) Tcl_FSData(&testReportingFilesystem);
@@ -5273,8 +5325,8 @@ TestReport(cmd, arg1, arg2)
Tcl_DStringAppend(&ds, "puts stderr ",-1);
Tcl_DStringStartSublist(&ds);
Tcl_DStringAppendElement(&ds, cmd);
- if (arg1 != NULL) {
- Tcl_DStringAppendElement(&ds, Tcl_GetString(arg1));
+ if (path != NULL) {
+ Tcl_DStringAppendElement(&ds, Tcl_GetString(path));
}
if (arg2 != NULL) {
Tcl_DStringAppendElement(&ds, Tcl_GetString(arg2));
@@ -5292,7 +5344,7 @@ TestReportStat(path, buf)
struct stat *buf; /* Filled with results of stat call. */
{
TestReport("stat",path, NULL);
- return -1;
+ return Tcl_FSStat(TestReportGetNativePath(path),buf);
}
static int
TestReportLstat(path, buf)
@@ -5300,7 +5352,7 @@ TestReportLstat(path, buf)
struct stat *buf; /* Filled with results of stat call. */
{
TestReport("lstat",path, NULL);
- return -1;
+ return Tcl_FSLstat(TestReportGetNativePath(path),buf);
}
static int
TestReportAccess(path, mode)
@@ -5308,7 +5360,7 @@ TestReportAccess(path, mode)
int mode; /* Permission setting. */
{
TestReport("access",path,NULL);
- return -1;
+ return Tcl_FSAccess(TestReportGetNativePath(path),mode);
}
static Tcl_Channel
TestReportOpenFileChannel(interp, fileName, modeString, permissions)
@@ -5322,7 +5374,8 @@ TestReportOpenFileChannel(interp, fileName, modeString, permissions)
* it? */
{
TestReport("open",fileName, NULL);
- return NULL;
+ return Tcl_FSOpenFileChannel(interp, TestReportGetNativePath(fileName),
+ modeString, permissions);
}
static int
@@ -5335,24 +5388,20 @@ TestReportMatchInDirectory(interp, resultPtr, dirPtr, pattern, types)
* May be NULL. */
{
TestReport("matchindirectory",dirPtr, NULL);
- return -1;
-}
-static Tcl_Obj *
-TestReportGetCwd(interp)
- Tcl_Interp *interp;
-{
- TestReport("cwd",NULL,NULL);
- return NULL;
+ return Tcl_FSMatchInDirectory(interp, resultPtr,
+ TestReportGetNativePath(dirPtr), pattern,
+ types);
}
static int
TestReportChdir(dirName)
Tcl_Obj *dirName;
{
TestReport("chdir",dirName,NULL);
- return -1;
+ return Tcl_FSChdir(TestReportGetNativePath(dirName));
}
static int
-TestReportLoadFile(interp, fileName, sym1, sym2, proc1Ptr, proc2Ptr, clientDataPtr)
+TestReportLoadFile(interp, fileName, sym1, sym2, proc1Ptr, proc2Ptr,
+ clientDataPtr, unloadProcPtr)
Tcl_Interp *interp; /* Used for error reporting. */
Tcl_Obj *fileName; /* Name of the file containing the desired
* code. */
@@ -5363,10 +5412,15 @@ TestReportLoadFile(interp, fileName, sym1, sym2, proc1Ptr, proc2Ptr, clientDataP
* to sym1 and sym2. */
ClientData *clientDataPtr; /* Filled with token for dynamically loaded
* file which will be passed back to
- * TclpUnloadFile() to unload the file. */
+ * (*unloadProcPtr)() to unload the file. */
+ Tcl_FSUnloadFileProc **unloadProcPtr;
+ /* Filled with address of Tcl_FSUnloadFileProc
+ * function which should be used for
+ * this file. */
{
TestReport("loadfile",fileName,NULL);
- return -1;
+ return Tcl_FSLoadFile(interp, TestReportGetNativePath(fileName), sym1, sym2,
+ proc1Ptr, proc2Ptr, clientDataPtr, unloadProcPtr);
}
static void
TestReportUnloadFile(clientData)
@@ -5383,13 +5437,7 @@ TestReportLink(path, to)
Tcl_Obj *to; /* Path of file to link to, or NULL */
{
TestReport("link",path,NULL);
- return NULL;
-}
-static Tcl_Obj *
-TestReportListVolumes()
-{
- TestReport("listvolumes",NULL,NULL);
- return NULL;
+ return Tcl_FSLink(TestReportGetNativePath(path),NULL);
}
static int
TestReportRenameFile(src, dst)
@@ -5399,7 +5447,8 @@ TestReportRenameFile(src, dst)
* (UTF-8). */
{
TestReport("renamefile",src,dst);
- return -1;
+ return Tcl_FSRenameFile(TestReportGetNativePath(src),
+ TestReportGetNativePath(dst));
}
static int
TestReportCopyFile(src, dst)
@@ -5407,33 +5456,34 @@ TestReportCopyFile(src, dst)
Tcl_Obj *dst; /* Pathname of file to copy to (UTF-8). */
{
TestReport("copyfile",src,dst);
- return -1;
+ return Tcl_FSCopyFile(TestReportGetNativePath(src),
+ TestReportGetNativePath(dst));
}
static int
TestReportDeleteFile(path)
Tcl_Obj *path; /* Pathname of file to be removed (UTF-8). */
{
TestReport("deletefile",path,NULL);
- return -1;
+ return Tcl_FSDeleteFile(TestReportGetNativePath(path));
}
static int
TestReportCreateDirectory(path)
Tcl_Obj *path; /* Pathname of directory to create (UTF-8). */
{
TestReport("createdirectory",path,NULL);
- return -1;
+ return Tcl_FSCreateDirectory(TestReportGetNativePath(path));
}
static int
TestReportCopyDirectory(src, dst, errorPtr)
Tcl_Obj *src; /* Pathname of directory to be copied
* (UTF-8). */
Tcl_Obj *dst; /* Pathname of target directory (UTF-8). */
- Tcl_Obj **errorPtr; /* If non-NULL, uninitialized or free
- * DString filled with UTF-8 name of file
- * causing error. */
+ Tcl_Obj **errorPtr; /* If non-NULL, to be filled with UTF-8 name
+ * of file causing error. */
{
TestReport("copydirectory",src,dst);
- return -1;
+ return Tcl_FSCopyDirectory(TestReportGetNativePath(src),
+ TestReportGetNativePath(dst), errorPtr);
}
static int
TestReportRemoveDirectory(path, recursive, errorPtr)
@@ -5442,12 +5492,12 @@ TestReportRemoveDirectory(path, recursive, errorPtr)
int recursive; /* If non-zero, removes directories that
* are nonempty. Otherwise, will only remove
* empty directories. */
- Tcl_Obj **errorPtr; /* If non-NULL, uninitialized or free
- * DString filled with UTF-8 name of file
- * causing error. */
+ Tcl_Obj **errorPtr; /* If non-NULL, to be filled with UTF-8 name
+ * of file causing error. */
{
TestReport("removedirectory",path,NULL);
- return -1;
+ return Tcl_FSRemoveDirectory(TestReportGetNativePath(path), recursive,
+ errorPtr);
}
static char**
TestReportFileAttrStrings(fileName, objPtrRef)
@@ -5455,7 +5505,7 @@ TestReportFileAttrStrings(fileName, objPtrRef)
Tcl_Obj** objPtrRef;
{
TestReport("fileattributestrings",fileName,NULL);
- return NULL;
+ return Tcl_FSFileAttrStrings(TestReportGetNativePath(fileName), objPtrRef);
}
static int
TestReportFileAttrsGet(interp, index, fileName, objPtrRef)
@@ -5465,7 +5515,8 @@ TestReportFileAttrsGet(interp, index, fileName, objPtrRef)
Tcl_Obj **objPtrRef; /* for output. */
{
TestReport("fileattributesget",fileName,NULL);
- return -1;
+ return Tcl_FSFileAttrsGet(interp, index,
+ TestReportGetNativePath(fileName), objPtrRef);
}
static int
TestReportFileAttrsSet(interp, index, fileName, objPtr)
@@ -5475,7 +5526,8 @@ TestReportFileAttrsSet(interp, index, fileName, objPtr)
Tcl_Obj *objPtr; /* for input. */
{
TestReport("fileattributesset",fileName,objPtr);
- return -1;
+ return Tcl_FSFileAttrsSet(interp, index,
+ TestReportGetNativePath(fileName), objPtr);
}
static int
TestReportUtime (fileName, tval)
@@ -5483,7 +5535,7 @@ TestReportUtime (fileName, tval)
struct utimbuf *tval;
{
TestReport("utime",fileName,NULL);
- return -1;
+ return Tcl_FSUtime(TestReportGetNativePath(fileName), tval);
}
static int
TestReportNormalizePath(interp, pathPtr, nextCheckpoint)