vfs, winfs testsuite

7 files changed, 93 insertions, 19 deletions

diff --git a/generic/tcl.decls b/generic/tcl.decls
index 7f10c97..ef74bdb 100644
--- a/generic/tcl.decls
+++ b/generic/tcl.decls
@@ -11,7 +11,7 @@
 # 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.88 2002/06/12 09:28:58 vincentdarley Exp $
+# RCS: @(#) $Id: tcl.decls,v 1.89 2002/06/13 09:39:59 vincentdarley Exp $
 
 library tcl
 
@@ -1577,7 +1577,7 @@ declare 445 generic {
 	    Tcl_Obj *pathPtr, CONST char *pattern, Tcl_GlobTypeData *types)
 }
 declare 446 generic {
-    Tcl_Obj * Tcl_FSLink(Tcl_Obj *pathPtr, Tcl_Obj *toPtr)
+    Tcl_Obj * Tcl_FSLink(Tcl_Obj *pathPtr, Tcl_Obj *toPtr, int linkType)
 }
 declare 447 generic {
     int Tcl_FSRemoveDirectory(Tcl_Obj *pathPtr,
diff --git a/generic/tcl.h b/generic/tcl.h
index 0df69dd..c7dd3d2 100644
--- a/generic/tcl.h
+++ b/generic/tcl.h
@@ -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: tcl.h,v 1.124 2002/05/24 21:19:05 dkf Exp $
+ * RCS: @(#) $Id: tcl.h,v 1.125 2002/06/13 09:40:00 vincentdarley Exp $
  */
 
 #ifndef _TCL
@@ -1641,7 +1641,7 @@ typedef int (Tcl_FSFileAttrsSetProc) _ANSI_ARGS_((Tcl_Interp *interp,
 			    int index, Tcl_Obj *pathPtr,
 			    Tcl_Obj *objPtr));
 typedef Tcl_Obj* (Tcl_FSLinkProc) _ANSI_ARGS_((Tcl_Obj *pathPtr, 
-					       Tcl_Obj *toPtr));
+					       Tcl_Obj *toPtr, int linkType));
 typedef int (Tcl_FSLoadFileProc) _ANSI_ARGS_((Tcl_Interp * interp, 
 			    Tcl_Obj *pathPtr,
 			    CONST char * sym1, CONST char * sym2, 
diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c
index 500f988..4cf7eb1 100644
--- a/generic/tclCmdAH.c
+++ b/generic/tclCmdAH.c
@@ -11,7 +11,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclCmdAH.c,v 1.24 2002/04/23 02:54:13 hobbs Exp $
+ * RCS: @(#) $Id: tclCmdAH.c,v 1.25 2002/06/13 09:40:00 vincentdarley Exp $
  */
 
 #include "tclInt.h"
@@ -1101,7 +1101,7 @@ Tcl_FileObjCmd(dummy, interp, objc, objv)
 		return TCL_ERROR;
 	    }
 
-	    contents = Tcl_FSLink(objv[2], NULL);
+	    contents = Tcl_FSLink(objv[2], NULL, 0);
 
 	    if (contents == NULL) {
 	    	Tcl_AppendResult(interp, "could not readlink \"", 
diff --git a/generic/tclDecls.h b/generic/tclDecls.h
index 8062d1e..f97b0fb 100644
--- a/generic/tclDecls.h
+++ b/generic/tclDecls.h
@@ -8,7 +8,7 @@
  * 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.88 2002/06/12 09:28:58 vincentdarley Exp $
+ * RCS: @(#) $Id: tclDecls.h,v 1.89 2002/06/13 09:40:00 vincentdarley Exp $
  */
 
 #ifndef _TCLDECLS
@@ -1416,7 +1416,7 @@ EXTERN int		Tcl_FSMatchInDirectory _ANSI_ARGS_((
 				Tcl_GlobTypeData * types));
 /* 446 */
 EXTERN Tcl_Obj *	Tcl_FSLink _ANSI_ARGS_((Tcl_Obj * pathPtr, 
-				Tcl_Obj * toPtr));
+				Tcl_Obj * toPtr, int linkType));
 /* 447 */
 EXTERN int		Tcl_FSRemoveDirectory _ANSI_ARGS_((Tcl_Obj * pathPtr, 
 				int recursive, Tcl_Obj ** errorPtr));
@@ -2061,7 +2061,7 @@ typedef struct TclStubs {
     int (*tcl_FSDeleteFile) _ANSI_ARGS_((Tcl_Obj * pathPtr)); /* 443 */
     int (*tcl_FSLoadFile) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * pathPtr, CONST char * sym1, CONST char * sym2, Tcl_PackageInitProc ** proc1Ptr, Tcl_PackageInitProc ** proc2Ptr, ClientData * clientDataPtr, Tcl_FSUnloadFileProc ** unloadProcPtr)); /* 444 */
     int (*tcl_FSMatchInDirectory) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * result, Tcl_Obj * pathPtr, CONST char * pattern, Tcl_GlobTypeData * types)); /* 445 */
-    Tcl_Obj * (*tcl_FSLink) _ANSI_ARGS_((Tcl_Obj * pathPtr, Tcl_Obj * toPtr)); /* 446 */
+    Tcl_Obj * (*tcl_FSLink) _ANSI_ARGS_((Tcl_Obj * pathPtr, Tcl_Obj * toPtr, int linkType)); /* 446 */
     int (*tcl_FSRemoveDirectory) _ANSI_ARGS_((Tcl_Obj * pathPtr, int recursive, Tcl_Obj ** errorPtr)); /* 447 */
     int (*tcl_FSRenameFile) _ANSI_ARGS_((Tcl_Obj * srcPathPtr, Tcl_Obj * destPathPtr)); /* 448 */
     int (*tcl_FSLstat) _ANSI_ARGS_((Tcl_Obj * pathPtr, Tcl_StatBuf * buf)); /* 449 */
diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c
index 0858a58..2bf584c 100644
--- a/generic/tclIOUtil.c
+++ b/generic/tclIOUtil.c
@@ -17,7 +17,7 @@
  * 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.48 2002/06/12 09:28:58 vincentdarley Exp $
+ * RCS: @(#) $Id: tclIOUtil.c,v 1.49 2002/06/13 09:40:00 vincentdarley Exp $
  */
 
 #include "tclInt.h"
@@ -2708,15 +2708,16 @@ FSUnloadTempFile(clientData)
  */
 
 Tcl_Obj *
-Tcl_FSLink(pathPtr, toPtr)
+Tcl_FSLink(pathPtr, toPtr, linkType)
     Tcl_Obj *pathPtr;		/* Path of file to readlink or link */
     Tcl_Obj *toPtr;		/* NULL or path to be linked to */
+    int linkType;               /* Type of link to create */
 {
     Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
     if (fsPtr != NULL) {
 	Tcl_FSLinkProc *proc = fsPtr->linkProc;
 	if (proc != NULL) {
-	    return (*proc)(pathPtr, toPtr);
+	    return (*proc)(pathPtr, toPtr, linkType);
 	}
     }
     /*
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 60ea8e1..920d946 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -12,7 +12,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclInt.h,v 1.93 2002/06/11 15:42:21 msofer Exp $
+ * RCS: @(#) $Id: tclInt.h,v 1.94 2002/06/13 09:40:00 vincentdarley Exp $
  */
 
 #ifndef _TCLINT
@@ -1859,7 +1859,8 @@ EXTERN int		TclpMatchInDirectory _ANSI_ARGS_((Tcl_Interp *interp,
 			        Tcl_Obj *resultPtr, Tcl_Obj *pathPtr, 
 				CONST char *pattern, Tcl_GlobTypeData *types));
 EXTERN Tcl_Obj*		TclpObjGetCwd _ANSI_ARGS_((Tcl_Interp *interp));
-EXTERN Tcl_Obj*		TclpObjLink _ANSI_ARGS_((Tcl_Obj *pathPtr, Tcl_Obj *toPtr));
+EXTERN Tcl_Obj*		TclpObjLink _ANSI_ARGS_((Tcl_Obj *pathPtr, 
+				Tcl_Obj *toPtr, int linkType));
 EXTERN int		TclpObjChdir _ANSI_ARGS_((Tcl_Obj *pathPtr));
 EXTERN Tcl_Obj*         TclFileDirname _ANSI_ARGS_((Tcl_Interp *interp, 
 						    Tcl_Obj*pathPtr));
diff --git a/generic/tclTest.c b/generic/tclTest.c
index 7958bf4..1b45e81 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.49 2002/04/23 03:48:33 hobbs Exp $
+ * RCS: @(#) $Id: tclTest.c,v 1.50 2002/06/13 09:40:00 vincentdarley Exp $
  */
 
 #define TCL_TEST
@@ -230,6 +230,8 @@ static int		TestexprstringCmd _ANSI_ARGS_((ClientData dummy,
 			    Tcl_Interp *interp, int argc, char **argv));
 static int		TestfileCmd _ANSI_ARGS_((ClientData dummy,
 			    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+static int		TestfilelinkCmd _ANSI_ARGS_((ClientData dummy,
+			    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
 static int		TestfeventCmd _ANSI_ARGS_((ClientData dummy,
 			    Tcl_Interp *interp, int argc, char **argv));
 static int		TestgetassocdataCmd _ANSI_ARGS_((ClientData dummy,
@@ -368,7 +370,7 @@ static int		TestReportLoadFile _ANSI_ARGS_ ((Tcl_Interp *interp,
 			    ClientData *clientDataPtr,
 			    Tcl_FSUnloadFileProc **unloadProcPtr));
 static Tcl_Obj *	TestReportLink _ANSI_ARGS_ ((Tcl_Obj *path,
-			    Tcl_Obj *to));
+			    Tcl_Obj *to, int linkType));
 static CONST char**	TestReportFileAttrStrings _ANSI_ARGS_ ((
 			    Tcl_Obj *fileName, Tcl_Obj **objPtrRef));
 static int		TestReportFileAttrsGet _ANSI_ARGS_ ((Tcl_Interp *interp,
@@ -525,6 +527,8 @@ Tcltest_Init(interp)
             (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
     Tcl_CreateCommand(interp, "testfevent", TestfeventCmd, (ClientData) 0,
             (Tcl_CmdDeleteProc *) NULL);
+    Tcl_CreateObjCommand(interp, "testfilelink", TestfilelinkCmd, 
+            (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
     Tcl_CreateObjCommand(interp, "testfile", TestfileCmd,
             (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
     Tcl_CreateCommand(interp, "testgetassocdata", TestgetassocdataCmd,
@@ -1968,6 +1972,73 @@ TestexprstringCmd(clientData, interp, argc, argv)
 /*
  *----------------------------------------------------------------------
  *
+ * TestfilelinkCmd --
+ *
+ *	This procedure implements the "testfilelink" command.  It is used
+ *	to test the effects of creating and manipulating filesystem links
+ *	in Tcl.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	May create a link on disk.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TestfilelinkCmd(clientData, interp, objc, objv)
+    ClientData clientData;	/* Not used. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int objc;			/* Number of arguments. */
+    Tcl_Obj *CONST objv[];	/* The argument objects. */
+{
+    Tcl_Obj *contents;
+
+    if (objc < 2 || objc > 3) {
+	Tcl_WrongNumArgs(interp, 1, objv, "source ?target?");
+	return TCL_ERROR;
+    }
+    
+    if (Tcl_FSConvertToPathType(interp, objv[1]) != TCL_OK) {
+	return TCL_ERROR;
+    }
+    
+    if (objc == 3) {
+	/* Create link from source to target */
+	contents = Tcl_FSLink(objv[1], objv[2], 0);
+	if (contents == NULL) {
+	    Tcl_AppendResult(interp, "could not create link from \"", 
+		    Tcl_GetString(objv[1]), "\" to \"", 
+		    Tcl_GetString(objv[2]), "\": ", 
+		    Tcl_PosixError(interp), (char *) NULL);
+	    return TCL_ERROR;
+	}
+    } else {
+	/* Read link */
+	contents = Tcl_FSLink(objv[1], NULL, 0);
+	if (contents == NULL) {
+	    Tcl_AppendResult(interp, "could not read link \"", 
+		    Tcl_GetString(objv[1]), "\": ", 
+		    Tcl_PosixError(interp), (char *) NULL);
+	    return TCL_ERROR;
+	}
+    }
+    Tcl_SetObjResult(interp, contents);
+    if (objc == 2) {
+	/* 
+	 * If we are creating a link, this will actually just
+	 * be objv[3], and we don't own it
+	 */
+	Tcl_DecrRefCount(contents);
+    }
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * TestgetassocdataCmd --
  *
  *	This procedure implements the "testgetassocdata" command. It is
@@ -5760,12 +5831,13 @@ TestReportLoadFile(interp, fileName, sym1, sym2, proc1Ptr, proc2Ptr,
 			  proc1Ptr, proc2Ptr, clientDataPtr, unloadProcPtr);
 }
 static Tcl_Obj *
-TestReportLink(path, to)
+TestReportLink(path, to, linkType)
     Tcl_Obj *path;		/* Path of file to readlink or link */
     Tcl_Obj *to;		/* Path of file to link to, or NULL */
+    int linkType;
 {
-    TestReport("link",path,NULL);
-    return Tcl_FSLink(TestReportGetNativePath(path),NULL);
+    TestReport("link",path,to);
+    return Tcl_FSLink(TestReportGetNativePath(path), to, linkType);
 }
 static int
 TestReportRenameFile(src, dst)