vfs, winfs testsuite

17 files changed, 492 insertions, 89 deletions

diff --git a/ChangeLog b/ChangeLog
index 3679e28..56b459b 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,23 @@
+2002-06-13  Vince Darley  <vincentdarley@users.sourceforge.net>
+
+	* tests/fCmd.test:
+	* tests/winFile.test:
+	* tests/fileSystem.test:
+	* generic/tclTest.c:
+	* generic/tclCmdAH.c:
+	* generic/tclIOUtil.c:
+	* doc/FileSystem.3:
+	* mac/tclMacFile.c:
+	* unix/tclUnixFile.c:
+	* win/tclWinFile.c: fixed up further so both compiles and
+	actually works with VC++ 5 or 6.
+	* win/tclWinInt.h: 
+	* win/tclWin32Dll.c: cleaned up code and vfs tests and
+	added tests for the internal changes of 2002-06-12, to see
+	whether WinTcl on NTFS can coexist peacefully with links
+	in the filesystem.  Added new test command 'testfilelink'
+	to enable the newer code to be tested.
+
 2002-06-12  Miguel Sofer  <msofer@users.sourceforge.net>
 
 	* tclBasic.c (Tcl_DeleteTrace): fixed [Bug 568123] (thanks to
diff --git a/doc/FileSystem.3 b/doc/FileSystem.3
index a9ec3e8..c38bcf4 100644
--- a/doc/FileSystem.3
+++ b/doc/FileSystem.3
@@ -4,7 +4,7 @@
 '\" 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.24 2002/06/12 09:28:58 vincentdarley Exp $
+'\" RCS: @(#) $Id: FileSystem.3,v 1.25 2002/06/13 09:39:59 vincentdarley Exp $
 '\" 
 .so man.macros
 .TH Filesystem 3 8.4 Tcl "Tcl Library Procedures"
@@ -64,7 +64,7 @@ int
 \fBTcl_FSMatchInDirectory\fR(\fIinterp, result, pathPtr, pattern, types\fR)
 .sp
 Tcl_Obj*
-\fBTcl_FSLink\fR(\fIpathPtr, toPtr\fR)
+\fBTcl_FSLink\fR(\fIpathPtr, toPtr, linkType\fR)
 .sp
 int
 \fBTcl_FSLstat\fR(\fIpathPtr, statPtr\fR)
@@ -354,7 +354,7 @@ given by \fIpath\fR, or NULL if the symbolic link could not be read.  The
 result is owned by the caller, which should call Tcl_DecrRefCount when
 the result is no longer needed.  If the \fItoPtr\fR is not NULL, Tcl
 should create a link, but this option is not currently supported (it
-is left available for future expansion).
+and the \fIlinkType\fR field are left available for future expansion).
 .PP
 \fBTcl_FSLstat\fR fills the stat structure \fIstatPtr\fR with information
 about the specified file.  You do not need any access rights to the
@@ -1031,7 +1031,8 @@ only if the filesystem supports links, and may otherwise be NULL.
 .CS
 typedef Tcl_Obj* Tcl_FSLinkProc(
 	Tcl_Obj *\fIpathPtr\fR,
-	Tcl_Obj *\fItoPtr\fR);
+	Tcl_Obj *\fItoPtr\fR,
+	int \fIlinkType\fR);
 .CE
 .PP
 If \fItoPtr\fR is NULL, the function is being asked to read the
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)
diff --git a/mac/tclMacFile.c b/mac/tclMacFile.c
index 210624b..07c1195 100644
--- a/mac/tclMacFile.c
+++ b/mac/tclMacFile.c
@@ -10,7 +10,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclMacFile.c,v 1.21 2002/05/02 20:15:20 vincentdarley Exp $
+ * RCS: @(#) $Id: tclMacFile.c,v 1.22 2002/06/13 09:40:00 vincentdarley Exp $
  */
 
 /*
@@ -1145,9 +1145,10 @@ TclpTempFileName()
 #ifdef S_IFLNK
 
 Tcl_Obj* 
-TclpObjLink(pathPtr, toPtr)
+TclpObjLink(pathPtr, toPtr, linkType)
     Tcl_Obj *pathPtr;
     Tcl_Obj *toPtr;
+    int linkType;
 {
     Tcl_Obj* link = NULL;
 
diff --git a/tests/fCmd.test b/tests/fCmd.test
index 9b3d997..b04262f 100644
--- a/tests/fCmd.test
+++ b/tests/fCmd.test
@@ -10,7 +10,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: fCmd.test,v 1.11 2001/09/04 18:06:34 vincentdarley Exp $
+# RCS: @(#) $Id: fCmd.test,v 1.12 2002/06/13 09:40:00 vincentdarley Exp $
 #
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
@@ -2163,6 +2163,108 @@ test fCmd-27.6 {TclFileAttrsCmd - setting more than one option} {foundGroup} {
     list [catch {eval file attributes foo.tmp [lrange $attrs 0 3]} msg] $msg [file delete -force -- foo.tmp]
 } {0 {} {}}
 
+if {[string equal testfilelink [info commands testfilelink]]} {
+    tcltest::testConstraint testfilelink 1
+    
+    if {[string equal $tcl_platform(platform) "windows"]} {
+	if {[string index $tcl_platform(osVersion) 0] >= 5 \
+	  && ([lindex [file system [temporaryDirectory]] 1] == "NTFS")} {
+	    tcltest::testConstraint linkDirectory 1
+	    tcltest::testConstraint linkFile 1
+	} else {
+	    tcltest::testConstraint linkDirectory 0
+	    tcltest::testConstraint linkFile 0
+	}
+    } else {
+	tcltest::testConstraint linkFile 1
+	tcltest::testConstraint linkDirectory 1
+    }
+
+} else {
+    tcltest::testConstraint testfilelink 0
+    tcltest::testConstraint linkDirectory 0
+    tcltest::testConstraint linkFile 0
+}
+
+test fCmd-28.1 {testfilelink} {testfilelink} {
+    list [catch {testfilelink} msg] $msg
+} {1 {wrong # args: should be "testfilelink source ?target?"}}
+
+test fCmd-28.2 {testfilelink} {testfilelink} {
+    list [catch {testfilelink a b c d} msg] $msg
+} {1 {wrong # args: should be "testfilelink source ?target?"}}
+
+catch {file delete -force abc.dir}
+catch {file delete -force abc2.dir}
+makeDirectory abc.dir
+makeDirectory abc2.dir
+makeFile contents abc.file
+makeFile contents abc2.file
+
+test fCmd-28.3 {testfilelink} {linkDirectory} {
+    list [catch {testfilelink abc.dir abc2.dir} msg] $msg
+} {1 {could not create link from "abc.dir" to "abc2.dir": file already exists}}
+
+test fCmd-28.4 {testfilelink} {linkFile} {
+    list [catch {testfilelink abc.file abc2.file} msg] $msg
+} {1 {could not create link from "abc.file" to "abc2.file": file already exists}}
+
+test fCmd-28.5 {testfilelink} {linkFile} {
+    file delete -force abc.link
+    list [catch {testfilelink abc.link abc.file} msg] $msg
+} {0 abc.file}
+
+catch {file delete -force abc.link}
+
+test fCmd-28.6 {testfilelink} {linkDirectory} {
+    file delete -force abc.link
+    list [catch {testfilelink abc.link abc2.doesnt} msg] $msg
+} {1 {could not create link from "abc.link" to "abc2.doesnt": no such file or directory}}
+
+test fCmd-28.7 {testfilelink} {linkDirectory} {
+    file delete -force abc.link
+    list [catch {testfilelink abc.link abc.dir} msg] $msg
+} {0 abc.dir}
+
+test fCmd-28.7.1 {testfilelink} {linkDirectory} {
+    # duplicate link throws error
+    list [catch {testfilelink abc.link abc.dir} msg] $msg
+} {1 {could not create link from "abc.link" to "abc.dir": file already exists}}
+
+test fCmd-28.8 {testfilelink: deletes link not dir} {linkDirectory} {
+    file delete -force abc.link
+    list [file exists abc.link] [file exists abc.dir]
+} {0 1}
+
+test fCmd-28.9 {testfilelink: copies link not dir} {linkDirectory} {
+    file delete -force abc.link
+    testfilelink abc.link abc.dir
+    file copy abc.link abc2.link
+    list [file type abc2.link] [file tail [testfilelink abc2.link]]
+} {link abc.dir}
+
+file delete -force abc.link
+file delete -force abc2.link
+
+file copy abc.file abc.dir
+file copy abc2.file abc.dir
+
+test fCmd-28.10 {testfilelink: glob inside link} {linkDirectory} {
+    file delete -force abc.link
+    testfilelink abc.link abc.dir
+    glob -dir abc.link -tails *
+} {abc.file abc2.file}
+
+test fCmd-28.11 {testfilelink: glob -type l} {linkDirectory} {
+    glob -dir [pwd] -type l -tails abc*
+} {abc.link}
+
+test fCmd-28.12 {testfilelink: glob -type d} {linkDirectory} {
+    lsort [glob -dir [pwd] -type d -tails abc*]
+} [lsort [list abc.link abc.dir abc2.dir]]
+
+file delete -force abc.link
+
 # cleanup
 cleanup
 ::tcltest::cleanupTests
diff --git a/tests/fileSystem.test b/tests/fileSystem.test
index 5a0713a..eb3f6cb 100644
--- a/tests/fileSystem.test
+++ b/tests/fileSystem.test
@@ -12,57 +12,78 @@
 package require tcltest
 namespace eval ::tcl::test::fileSystem {
 
-    namespace import ::tcltest::cleanupTests
-    namespace import ::tcltest::makeDirectory
-    namespace import ::tcltest::makeFile
-    namespace import ::tcltest::removeDirectory
-    namespace import ::tcltest::removeFile
-    namespace import ::tcltest::test
+    catch {
+	namespace import ::tcltest::cleanupTests
+	namespace import ::tcltest::makeDirectory
+	namespace import ::tcltest::makeFile
+	namespace import ::tcltest::removeDirectory
+	namespace import ::tcltest::removeFile
+	namespace import ::tcltest::test
+    }
+    
+    catch {
+	file delete -force link.file
+	file delete -force dir.link
+	file delete -force [file join dir.file linkinside.file]
+    }
 
 makeFile "test file" gorp.file
 makeDirectory dir.file
 makeFile "test file in directory" [file join dir.file inside.file]
 
-# It would be good to be able to make these work on MacOS too.
-# If we added 'file link from to' we could easily do that.
-catch {exec ln -s gorp.file link.file}
-catch {exec ln -s inside.file dir.file/linkinside.file}
-catch {exec ln -s dir.file dir.link}
+if {[catch {
+    testfilelink link.file gorp.file 
+    testfilelink \
+      [file join dir.file linkinside.file] \
+      [file join dir.file inside.file]
+    testfilelink dir.link dir.file
+}]} {
+    tcltest::testConstraint links 0
+} else {
+    tcltest::testConstraint links 1
+}
 
-test filesystem-1.0 {link normalisation} {unixOnly} {
+test filesystem-1.0 {link normalisation} {links} {
    string equal [file normalize gorp.file] [file normalize link.file]
 } {0}
 
-test filesystem-1.1 {link normalisation} {unixOnly} {
+test filesystem-1.1 {link normalisation} {links} {
    string equal [file normalize dir.file] [file normalize dir.link]
 } {0}
 
-test filesystem-1.2 {link normalisation} {unixOnly} {
-   string equal [file normalize gorp.file/foo] [file normalize link.file/foo]
+test filesystem-1.2 {link normalisation} {links macOrUnix} {
+   string equal [file normalize [file join gorp.file foo]] \
+     [file normalize [file join link.file foo]]
 } {1}
 
-test filesystem-1.3 {link normalisation} {unixOnly} {
-   string equal [file normalize dir.file/foo] [file normalize dir.link/foo]
+test filesystem-1.3 {link normalisation} {links} {
+   string equal [file normalize [file join dir.file foo]] \
+     [file normalize [file join dir.link foo]]
 } {1}
 
-test filesystem-1.4 {link normalisation} {unixOnly} {
-   string equal [file normalize dir.file/inside.file] [file normalize dir.link/inside.file]
+test filesystem-1.4 {link normalisation} {links} {
+   string equal [file normalize [file join dir.file inside.file]] \
+     [file normalize [file join dir.link inside.file]]
 } {1}
 
-test filesystem-1.5 {link normalisation} {unixOnly} {
-   string equal [file normalize dir.file/linkinside.file] [file normalize dir.file/linkinside.file]
+test filesystem-1.5 {link normalisation} {links} {
+   string equal [file normalize [file join dir.file linkinside.file]] \
+     [file normalize [file join dir.file linkinside.file]]
 } {1}
 
-test filesystem-1.6 {link normalisation} {unixOnly} {
-   string equal [file normalize dir.file/linkinside.file] [file normalize dir.link/inside.file]
+test filesystem-1.6 {link normalisation} {links} {
+   string equal [file normalize [file join dir.file linkinside.file]] \
+     [file normalize [file join dir.link inside.file]]
 } {0}
 
-test filesystem-1.7 {link normalisation} {unixOnly} {
-   string equal [file normalize dir.link/linkinside.file/foo] [file normalize dir.file/inside.file/foo]
+test filesystem-1.7 {link normalisation} {links macOrUnix} {
+   string equal [file normalize [file join dir.link linkinside.file foo]] \
+     [file normalize [file join dir.file inside.file foo]]
 } {1}
 
-test filesystem-1.8 {link normalisation} {unixOnly} {
-   string equal [file normalize dir.file/linkinside.filefoo] [file normalize dir.link/inside.filefoo]
+test filesystem-1.8 {link normalisation} {links} {
+   string equal [file normalize [file join dir.file linkinside.filefoo]] \
+     [file normalize [file join dir.link inside.filefoo]]
 } {0}
 
 file delete -force link.file dir.link
diff --git a/tests/winFile.test b/tests/winFile.test
index 0cf76e2..c0b26e3 100644
--- a/tests/winFile.test
+++ b/tests/winFile.test
@@ -10,7 +10,7 @@
 # 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.7 2002/05/02 20:15:20 vincentdarley Exp $
+# RCS: @(#) $Id: winFile.test,v 1.8 2002/06/13 09:40:00 vincentdarley Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
@@ -65,10 +65,14 @@ test winFile-2.2 {TclpMatchFiles: case sensitivity} {pcOnly} {
 test winFile-3.1 {file system} {pcOnly} {
     set res "volume types ok"
     foreach vol [file volumes] {
-	if {![string equal [lindex [file system $vol] 1] [testvolumetype $vol]]} {
-	    set res "For $vol, we found [file system $vol]\
-	      and [testvolumetype $vol] are different"
-	    break
+	# Have to catch in case there is a removable drive (CDROM, floppy)
+	# with nothing in it.
+	catch {
+	    if {![string equal [lindex [file system $vol] 1] [testvolumetype $vol]]} {
+		set res "For $vol, we found [file system $vol]\
+		  and [testvolumetype $vol] are different"
+		break
+	    }
 	}
     }
     set res
diff --git a/unix/tclUnixFile.c b/unix/tclUnixFile.c
index cdd6697..9edd47e 100644
--- a/unix/tclUnixFile.c
+++ b/unix/tclUnixFile.c
@@ -9,7 +9,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclUnixFile.c,v 1.22 2002/06/12 15:05:20 dkf Exp $
+ * RCS: @(#) $Id: tclUnixFile.c,v 1.23 2002/06/13 09:40:01 vincentdarley Exp $
  */
 
 #include "tclInt.h"
@@ -724,9 +724,10 @@ TclpObjStat(pathPtr, bufPtr)
 #ifdef S_IFLNK
 
 Tcl_Obj* 
-TclpObjLink(pathPtr, toPtr)
+TclpObjLink(pathPtr, toPtr, linkType)
     Tcl_Obj *pathPtr;
     Tcl_Obj *toPtr;
+    int linkType;
 {
     extern Tcl_Filesystem nativeFilesystem;
 
@@ -737,11 +738,14 @@ TclpObjLink(pathPtr, toPtr)
 	if (src == NULL || target == NULL) {
 	    return NULL;
 	}
-	if (symlink(src, target) != 0) {
-	    return NULL;
+	/* We don't recognise these codes */
+	if (linkType < 0 || linkType > 2) return NULL;
+	if (linkType == 2) {
+	    if (link(src, target) != 0) return NULL;
 	} else {
-	    return toPtr;
+	    if (symlink(src, target) != 0) return NULL;
 	}
+	return toPtr;
     } else {
 	Tcl_Obj* linkPtr = NULL;
 
diff --git a/win/tclWin32Dll.c b/win/tclWin32Dll.c
index c17285e..e3e95e5 100644
--- a/win/tclWin32Dll.c
+++ b/win/tclWin32Dll.c
@@ -9,7 +9,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclWin32Dll.c,v 1.15 2002/03/15 01:10:19 mdejong Exp $
+ * RCS: @(#) $Id: tclWin32Dll.c,v 1.16 2002/06/13 09:40:01 vincentdarley Exp $
  */
 
 #include "tclWinInt.h"
@@ -84,6 +84,7 @@ static TclWinProcs asciiProcs = {
     (BOOL (WINAPI *)(CONST TCHAR *)) SetCurrentDirectoryA,
     (BOOL (WINAPI *)(CONST TCHAR *, DWORD)) SetFileAttributesA,
     NULL,
+    NULL,
 };
 
 static TclWinProcs unicodeProcs = {
@@ -122,6 +123,7 @@ static TclWinProcs unicodeProcs = {
     (BOOL (WINAPI *)(CONST TCHAR *)) SetCurrentDirectoryW,
     (BOOL (WINAPI *)(CONST TCHAR *, DWORD)) SetFileAttributesW,
     NULL,
+    NULL,
 };
 
 TclWinProcs *tclWinProcs;
@@ -467,6 +469,10 @@ TclWinSetInterfaces(
 	        tclWinProcs->getFileAttributesExProc = 
 		  (BOOL (WINAPI *)(CONST TCHAR *, GET_FILEEX_INFO_LEVELS, 
 		  LPVOID)) GetProcAddress(hInstance, "GetFileAttributesExW");
+		tclWinProcs->createHardLinkProc = 
+		  (BOOL (WINAPI *)(CONST TCHAR *, CONST TCHAR*, 
+		  LPSECURITY_ATTRIBUTES)) GetProcAddress(hInstance, 
+		  "CreateHardLinkW");
 		FreeLibrary(hInstance);
 	    }
 	}
@@ -479,6 +485,10 @@ TclWinSetInterfaces(
 		tclWinProcs->getFileAttributesExProc = 
 		  (BOOL (WINAPI *)(CONST TCHAR *, GET_FILEEX_INFO_LEVELS, 
 		  LPVOID)) GetProcAddress(hInstance, "GetFileAttributesExA");
+		tclWinProcs->createHardLinkProc = 
+		  (BOOL (WINAPI *)(CONST TCHAR *, CONST TCHAR*, 
+		  LPSECURITY_ATTRIBUTES)) GetProcAddress(hInstance, 
+		  "CreateHardLinkA");
 		FreeLibrary(hInstance);
 	    }
 	}
diff --git a/win/tclWinFile.c b/win/tclWinFile.c
index 622be3c..6195c18 100644
--- a/win/tclWinFile.c
+++ b/win/tclWinFile.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: tclWinFile.c,v 1.30 2002/06/12 19:16:01 hobbs Exp $
+ * RCS: @(#) $Id: tclWinFile.c,v 1.31 2002/06/13 09:40:02 vincentdarley Exp $
  */
 
 //#define _WIN32_WINNT  0x0500
@@ -22,14 +22,14 @@
 #include <shlobj.h>
 #include <lmaccess.h>		/* For TclpGetUserHome(). */
 
-extern  int		ConvertFileNameFormat(Tcl_Interp *interp, 
-			    int objIndex, Tcl_Obj *fileName, int longShort,
-			    Tcl_Obj **attributePtrPtr);
+extern  int  ConvertFileNameFormat(Tcl_Interp *interp, 
+    int objIndex, Tcl_Obj *fileName, int longShort, 
+    Tcl_Obj **attributePtrPtr);
 
 /*
- * Declarations for 'link' related information (which may or may
- * not be in the windows headers, and some of which is not very
- * well documented).
+ * Declarations for 'link' related information.  This information
+ * should come with VC++ 6.0, but is not in some older SDKs.
+ * In any case it is not well documented.
  */
 #ifndef IO_REPARSE_TAG_RESERVED_ONE
 #  define IO_REPARSE_TAG_RESERVED_ONE 0x000000001
@@ -90,6 +90,13 @@ extern  int		ConvertFileNameFormat(Tcl_Interp *interp,
 /*
  * Undocumented REPARSE_MOUNTPOINT_HEADER_SIZE structure definition.
  * This is found in winnt.h.
+ * 
+ * IMPORTANT: caution when using this structure, since the actual
+ * structures used will want to store a full path in the 'PathBuffer'
+ * field, but there isn't room (there's only a single WCHAR!).  Therefore
+ * one must artificially create a larger space of memory and then cast it
+ * to this type.  We use the 'DUMMY_REPARSE_BUFFER' struct just below to
+ * deal with this problem.
  */
 
 #define REPARSE_MOUNTPOINT_HEADER_SIZE   8
@@ -120,6 +127,11 @@ typedef struct _REPARSE_DATA_BUFFER {
 } REPARSE_DATA_BUFFER;
 #endif
 
+typedef struct {
+    REPARSE_DATA_BUFFER dummy;
+    WCHAR  dummyBuf[MAX_PATH*3];
+} DUMMY_REPARSE_BUFFER;
+
 /* Other typedefs required by this code */
 
 static time_t		ToCTime(FILETIME fileTime);
@@ -149,12 +161,86 @@ static int NativeMatchType(CONST char *name, int nameLen,
 static int WinIsDrive(CONST char *name, int nameLen);
 static Tcl_Obj* WinReadLink(CONST TCHAR* LinkSource);
 static Tcl_Obj* WinReadLinkDirectory(CONST TCHAR* LinkDirectory);
+static int WinLink(CONST TCHAR* LinkSource, CONST TCHAR* LinkTarget, 
+		   int linkType);
+static int WinSymLinkDirectory(CONST TCHAR* LinkDirectory, 
+			       CONST TCHAR* LinkTarget);
 extern Tcl_Filesystem nativeFilesystem;
 
 
 /*
  *--------------------------------------------------------------------
  *
+ * WinLink
+ *
+ * Make a link from source to target. 
+ *--------------------------------------------------------------------
+ */
+static int 
+WinLink(LinkSource, LinkTarget, linkType)
+    CONST TCHAR* LinkSource;
+    CONST TCHAR* LinkTarget;
+    int linkType;
+{
+    WCHAR	tempFileName[MAX_PATH];
+    TCHAR*	tempFilePart;
+    int         attr;
+    
+    /* Get the full path referenced by the target */
+    if (!(*tclWinProcs->getFullPathNameProc)(LinkTarget, 
+			  MAX_PATH, tempFileName, &tempFilePart)) {
+	/* Invalid file */
+	TclWinConvertError(GetLastError());
+	return -1;
+    }
+
+    /* Make sure source file doesn't exist */
+    attr = (*tclWinProcs->getFileAttributesProc)(LinkSource);
+    if (attr != 0xffffffff) {
+	Tcl_SetErrno(EEXIST);
+	return -1;
+    }
+
+    /* Get the full path referenced by the directory */
+    if (!(*tclWinProcs->getFullPathNameProc)(LinkSource, 
+			  MAX_PATH, tempFileName, &tempFilePart)) {
+	/* Invalid file */
+	TclWinConvertError(GetLastError());
+	return -1;
+    }
+    /* Check the target */
+    attr = (*tclWinProcs->getFileAttributesProc)(LinkTarget);
+    if (attr == 0xffffffff) {
+	/* The target doesn't exist */
+	TclWinConvertError(GetLastError());
+	return -1;
+    } else if ((attr & FILE_ATTRIBUTE_DIRECTORY) == 0) {
+	/* It is a file */
+	if (tclWinProcs->createHardLinkProc == NULL) {
+	    Tcl_SetErrno(ENOTDIR);
+	    return -1;
+	}
+	if (linkType == 1) {
+	    /* Can't symlink files */
+	    return -1;
+	}
+	if (!(*tclWinProcs->createHardLinkProc)(LinkSource, LinkTarget, NULL)) {
+	    TclWinConvertError(GetLastError());
+	    return -1;
+	}
+	return 0;
+    } else {
+	if (linkType == 2) {
+	    /* Can't hard link directories */
+	    return -1;
+	}
+	return WinSymLinkDirectory(LinkSource, LinkTarget);
+    }
+}
+
+/*
+ *--------------------------------------------------------------------
+ *
  * WinReadLink
  *
  * What does 'LinkSource' point to?  We need the original 'pathPtr'
@@ -195,6 +281,67 @@ WinReadLink(LinkSource)
 /*
  *--------------------------------------------------------------------
  *
+ * WinSymLinkDirectory
+ *
+ * This routine creates a NTFS junction, using the undocumented
+ * FSCTL_SET_REPARSE_POINT structure Win2K uses for mount points
+ * and junctions.
+ *
+ * Assumption that LinkTarget is a valid, existing directory.
+ * 
+ * Returns zero on success.
+ *--------------------------------------------------------------------
+ */
+static int 
+WinSymLinkDirectory(LinkDirectory, LinkTarget)
+    CONST TCHAR* LinkDirectory;
+    CONST TCHAR* LinkTarget;
+{
+    DUMMY_REPARSE_BUFFER dummy;
+    REPARSE_DATA_BUFFER *reparseBuffer = (REPARSE_DATA_BUFFER*)&dummy;
+    int         len;
+    WCHAR       nativeTarget[MAX_PATH];
+    WCHAR       *loop;
+    
+    /* Make the native target name */
+    memcpy((VOID*)nativeTarget, (VOID*)L"\\??\\", 4*sizeof(WCHAR));
+    memcpy((VOID*)(nativeTarget + 4), (VOID*)LinkTarget, 
+	   sizeof(WCHAR)*(1+wcslen((WCHAR*)LinkTarget)));
+    len = wcslen(nativeTarget);
+    /* 
+     * We must have backslashes only.  This is VERY IMPORTANT.
+     * If we have any forward slashes everything appears to work,
+     * but the resulting symlink is useless!
+     */
+    for (loop = nativeTarget; *loop != 0; loop++) {
+	if (*loop == L'/') *loop = L'\\';
+    }
+    if ((nativeTarget[len-1] == L'\\') && (nativeTarget[len-2] != L':')) {
+	nativeTarget[len-1] = 0;
+    }
+    
+    /* Build the reparse info */
+    memset(reparseBuffer, 0, sizeof(DUMMY_REPARSE_BUFFER));
+    reparseBuffer->ReparseTag = IO_REPARSE_TAG_MOUNT_POINT;
+    reparseBuffer->SymbolicLinkReparseBuffer.SubstituteNameLength = 
+      wcslen(nativeTarget) * sizeof(WCHAR);
+    reparseBuffer->Reserved = 0;
+    reparseBuffer->SymbolicLinkReparseBuffer.PrintNameLength = 0;
+    reparseBuffer->SymbolicLinkReparseBuffer.PrintNameOffset = 
+      reparseBuffer->SymbolicLinkReparseBuffer.SubstituteNameLength 
+      + sizeof(WCHAR);
+    memcpy(reparseBuffer->SymbolicLinkReparseBuffer.PathBuffer, nativeTarget, 
+      sizeof(WCHAR) 
+      + reparseBuffer->SymbolicLinkReparseBuffer.SubstituteNameLength);
+    reparseBuffer->ReparseDataLength = 
+      reparseBuffer->SymbolicLinkReparseBuffer.SubstituteNameLength + 12;
+	
+    return NativeWriteReparse(LinkDirectory, reparseBuffer);
+}
+
+/*
+ *--------------------------------------------------------------------
+ *
  * TclWinSymLinkCopyDirectory
  *
  * Copy a Windows NTFS junction.  This function assumes that
@@ -209,12 +356,13 @@ TclWinSymLinkCopyDirectory(LinkOriginal, LinkCopy)
     CONST TCHAR* LinkOriginal;  /* Existing junction - reparse point */
     CONST TCHAR* LinkCopy;      /* Will become a duplicate junction */
 {
+    DUMMY_REPARSE_BUFFER dummy;
+    REPARSE_DATA_BUFFER *reparseBuffer = (REPARSE_DATA_BUFFER*)&dummy;
     
-    REPARSE_DATA_BUFFER reparseBuffer;
-    if (NativeReadReparse(LinkOriginal, &reparseBuffer)) {
+    if (NativeReadReparse(LinkOriginal, reparseBuffer)) {
 	return -1;
     }
-    return NativeWriteReparse(LinkCopy, &reparseBuffer);
+    return NativeWriteReparse(LinkCopy, reparseBuffer);
 }
 
 /*
@@ -237,16 +385,17 @@ TclWinSymLinkDelete(LinkOriginal, linkOnly)
     int linkOnly;
 {
     /* It is a symbolic link -- remove it */
+    DUMMY_REPARSE_BUFFER dummy;
+    REPARSE_DATA_BUFFER *reparseBuffer = (REPARSE_DATA_BUFFER*)&dummy;
     HANDLE hFile;
-    REPARSE_DATA_BUFFER buffer;
     int returnedLength;
-    memset(&buffer, 0, sizeof( buffer ));
-    buffer.ReparseTag = IO_REPARSE_TAG_MOUNT_POINT;
+    memset(reparseBuffer, 0, sizeof(DUMMY_REPARSE_BUFFER));
+    reparseBuffer->ReparseTag = IO_REPARSE_TAG_MOUNT_POINT;
     hFile = (*tclWinProcs->createFileProc)(LinkOriginal, GENERIC_WRITE, 0,
 	NULL, OPEN_EXISTING, 
 	FILE_FLAG_OPEN_REPARSE_POINT|FILE_FLAG_BACKUP_SEMANTICS, NULL);
     if (hFile != INVALID_HANDLE_VALUE) {
-	if (!DeviceIoControl(hFile, FSCTL_DELETE_REPARSE_POINT, &buffer, 
+	if (!DeviceIoControl(hFile, FSCTL_DELETE_REPARSE_POINT, reparseBuffer, 
 			     REPARSE_MOUNTPOINT_HEADER_SIZE,
 			     NULL, 0, &returnedLength, NULL)) {	
 	    /* Error setting junction */
@@ -282,18 +431,19 @@ WinReadLinkDirectory(LinkDirectory)
     CONST TCHAR* LinkDirectory;
 {
     int attr;
-    REPARSE_DATA_BUFFER reparseBuffer;
+    DUMMY_REPARSE_BUFFER dummy;
+    REPARSE_DATA_BUFFER *reparseBuffer = (REPARSE_DATA_BUFFER*)&dummy;
     
     attr = (*tclWinProcs->getFileAttributesProc)(LinkDirectory);
     if (!(attr & FILE_ATTRIBUTE_REPARSE_POINT)) {
 	Tcl_SetErrno(EINVAL);
 	return NULL;
     }
-    if (NativeReadReparse(LinkDirectory, &reparseBuffer)) {
+    if (NativeReadReparse(LinkDirectory, reparseBuffer)) {
         return NULL;
     }
     
-    switch (reparseBuffer.ReparseTag) {
+    switch (reparseBuffer->ReparseTag) {
 	case 0x80000000|IO_REPARSE_TAG_SYMBOLIC_LINK: 
 	case IO_REPARSE_TAG_SYMBOLIC_LINK: 
 	case IO_REPARSE_TAG_MOUNT_POINT: {
@@ -301,12 +451,12 @@ WinReadLinkDirectory(LinkDirectory)
 	    ClientData clientData;
 	    Tcl_Obj *retVal;
 	    
-	    len = reparseBuffer.SymbolicLinkReparseBuffer.SubstituteNameLength
+	    len = reparseBuffer->SymbolicLinkReparseBuffer.SubstituteNameLength
 		+ sizeof(WCHAR);
 	    clientData = (ClientData)ckalloc(len);
 	    memcpy((VOID*)clientData,
-		    (VOID*)reparseBuffer.SymbolicLinkReparseBuffer.PathBuffer,
-		    len);
+		   (VOID*)reparseBuffer->SymbolicLinkReparseBuffer.PathBuffer,
+		   len);
 	    
 	    retVal = Tcl_FSNewNativePath(&nativeFilesystem, clientData);
 	    Tcl_IncrRefCount(retVal);
@@ -347,8 +497,8 @@ NativeReadReparse(LinkDirectory, buffer)
     }
     /* Get the link */
     if (!DeviceIoControl(hFile, FSCTL_GET_REPARSE_POINT, NULL, 
-			 0, buffer,
-			 sizeof(REPARSE_DATA_BUFFER), &returnedLength, NULL)) {	
+			 0, buffer, sizeof(DUMMY_REPARSE_BUFFER), 
+			 &returnedLength, NULL)) {	
 	/* Error setting junction */
 	TclWinConvertError(GetLastError());
 	CloseHandle(hFile);
@@ -1705,12 +1855,26 @@ TclpObjLstat(pathPtr, statPtr)
 #ifdef S_IFLNK
 
 Tcl_Obj* 
-TclpObjLink(pathPtr, toPtr)
+TclpObjLink(pathPtr, toPtr, linkType)
     Tcl_Obj *pathPtr;
     Tcl_Obj *toPtr;
+    int linkType;
 {
     if (toPtr != NULL) {
-	return NULL;
+	int res;
+	TCHAR* LinkTarget = (TCHAR*)Tcl_FSGetNativePath(toPtr);
+	TCHAR* LinkSource = (TCHAR*)Tcl_FSGetNativePath(pathPtr);
+	if (LinkSource == NULL || LinkTarget == NULL) {
+	    return NULL;
+	}
+	/* We don't recognise these codes */
+	if (linkType < 0 || linkType > 2) return NULL;
+	res = WinLink(LinkSource, LinkTarget, linkType);
+	if (res == 0) {
+	    return toPtr;
+	} else {
+	    return NULL;
+	}
     } else {
 	TCHAR* LinkSource = (TCHAR*)Tcl_FSGetNativePath(pathPtr);
 	if (LinkSource == NULL) {
diff --git a/win/tclWinInt.h b/win/tclWinInt.h
index 1508e56..eb89c35 100644
--- a/win/tclWinInt.h
+++ b/win/tclWinInt.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: tclWinInt.h,v 1.15 2002/06/12 09:28:59 vincentdarley Exp $
+ * RCS: @(#) $Id: tclWinInt.h,v 1.16 2002/06/13 09:40:02 vincentdarley Exp $
  */
 
 #ifndef _TCLWININT
@@ -91,6 +91,8 @@ typedef struct TclWinProcs {
     BOOL (WINAPI *setFileAttributesProc)(CONST TCHAR *, DWORD);
     BOOL (WINAPI *getFileAttributesExProc)(CONST TCHAR *, 
 	    GET_FILEEX_INFO_LEVELS, LPVOID);
+    BOOL (WINAPI *createHardLinkProc)(CONST TCHAR*, CONST TCHAR*, 
+				      LPSECURITY_ATTRIBUTES);
 } TclWinProcs;
 
 EXTERN TclWinProcs *tclWinProcs;