summaryrefslogtreecommitdiffstats
path: root/generic/tclTest.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tclTest.c')
-rw-r--r--generic/tclTest.c82
1 files changed, 77 insertions, 5 deletions
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)