summaryrefslogtreecommitdiffstats
path: root/unix
diff options
context:
space:
mode:
authorvincentdarley <vincentdarley>2001-08-30 08:53:14 (GMT)
committervincentdarley <vincentdarley>2001-08-30 08:53:14 (GMT)
commit209cbd9eea8f0938d87548bdea9bd8970d18a1fb (patch)
treecf952115d99a903d3c817b01278505ed6aaff55d /unix
parentea7d3c538d82fb64a201fedfb9376f6dcafbd102 (diff)
downloadtcl-209cbd9eea8f0938d87548bdea9bd8970d18a1fb.zip
tcl-209cbd9eea8f0938d87548bdea9bd8970d18a1fb.tar.gz
tcl-209cbd9eea8f0938d87548bdea9bd8970d18a1fb.tar.bz2
filesystem
Diffstat (limited to 'unix')
-rw-r--r--unix/tclLoadAout.c12
-rw-r--r--unix/tclLoadDl.c14
-rw-r--r--unix/tclLoadDld.c16
-rw-r--r--unix/tclLoadDyld.c7
-rw-r--r--unix/tclLoadNext.c9
-rw-r--r--unix/tclLoadOSF.c9
-rw-r--r--unix/tclLoadShl.c9
-rw-r--r--unix/tclUnixChan.c19
-rw-r--r--unix/tclUnixFCmd.c249
-rw-r--r--unix/tclUnixFile.c224
-rw-r--r--unix/tclUnixPort.h11
11 files changed, 225 insertions, 354 deletions
diff --git a/unix/tclLoadAout.c b/unix/tclLoadAout.c
index da85d16..51e38b3 100644
--- a/unix/tclLoadAout.c
+++ b/unix/tclLoadAout.c
@@ -14,7 +14,7 @@
* and Design Engineering (MADE) Initiative through ARPA contract
* F33615-94-C-4400.
*
- * RCS: @(#) $Id: tclLoadAout.c,v 1.4 2000/03/27 18:34:32 ericm Exp $
+ * RCS: @(#) $Id: tclLoadAout.c,v 1.5 2001/08/30 08:53:15 vincentdarley Exp $
*/
#include "tclInt.h"
@@ -136,9 +136,9 @@ static void UnlinkSymbolTable _ANSI_ARGS_((void));
*/
int
-TclpLoadFile(interp, fileName, sym1, sym2, proc1Ptr, proc2Ptr, clientDataPtr)
+TclpLoadFile(interp, pathPtr, sym1, sym2, proc1Ptr, proc2Ptr, clientDataPtr)
Tcl_Interp *interp; /* Used for error reporting. */
- char *fileName; /* Name of the file containing the desired
+ Tcl_Obj *pathPtr; /* Name of the file containing the desired
* code (UTF-8). */
char *sym1, *sym2; /* Names of two procedures to look up in
* the file's symbol table. */
@@ -189,13 +189,13 @@ TclpLoadFile(interp, fileName, sym1, sym2, proc1Ptr, proc2Ptr, clientDataPtr)
Tcl_DStringAppend (&linkCommandBuf, " -G 0 ", -1);
#endif
Tcl_DStringAppend (&linkCommandBuf, " -u TclLoadDictionary_", -1);
- TclGuessPackageName(fileName, &linkCommandBuf);
+ TclGuessPackageName(Tcl_GetString(pathPtr), &linkCommandBuf);
Tcl_DStringAppend (&linkCommandBuf, " -A ", -1);
Tcl_DStringAppend (&linkCommandBuf, inputSymbolTable, -1);
Tcl_DStringAppend (&linkCommandBuf, " -N -T XXXXXXXX ", -1);
- Tcl_DStringAppend (&linkCommandBuf, fileName, -1);
+ Tcl_DStringAppend (&linkCommandBuf, Tcl_GetString(pathPtr), -1);
Tcl_DStringAppend (&linkCommandBuf, " ", -1);
- if (FindLibraries (interp, fileName, &linkCommandBuf) != TCL_OK) {
+ if (FindLibraries (interp, Tcl_GetString(pathPtr), &linkCommandBuf) != TCL_OK) {
Tcl_DStringFree (&linkCommandBuf);
return TCL_ERROR;
}
diff --git a/unix/tclLoadDl.c b/unix/tclLoadDl.c
index 2a868d8..bfe52e9 100644
--- a/unix/tclLoadDl.c
+++ b/unix/tclLoadDl.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: tclLoadDl.c,v 1.3 1999/04/16 00:48:04 stanton Exp $
+ * RCS: @(#) $Id: tclLoadDl.c,v 1.4 2001/08/30 08:53:15 vincentdarley Exp $
*/
#include "tclInt.h"
@@ -57,9 +57,9 @@
*/
int
-TclpLoadFile(interp, fileName, sym1, sym2, proc1Ptr, proc2Ptr, clientDataPtr)
+TclpLoadFile(interp, pathPtr, sym1, sym2, proc1Ptr, proc2Ptr, clientDataPtr)
Tcl_Interp *interp; /* Used for error reporting. */
- char *fileName; /* Name of the file containing the desired
+ Tcl_Obj *pathPtr; /* Name of the file containing the desired
* code. */
char *sym1, *sym2; /* Names of two procedures to look up in
* the file's symbol table. */
@@ -74,15 +74,15 @@ TclpLoadFile(interp, fileName, sym1, sym2, proc1Ptr, proc2Ptr, clientDataPtr)
Tcl_DString newName, ds;
char *native;
- native = Tcl_UtfToExternalDString(NULL, fileName, -1, &ds);
+ native = Tcl_FSGetNativePath(pathPtr);
handle = dlopen(native, RTLD_NOW | RTLD_GLOBAL); /* INTL: Native. */
- Tcl_DStringFree(&ds);
*clientDataPtr = (ClientData) handle;
if (handle == NULL) {
- Tcl_AppendResult(interp, "couldn't load file \"", fileName,
- "\": ", dlerror(), (char *) NULL);
+ Tcl_AppendResult(interp, "couldn't load file \"",
+ Tcl_GetString(pathPtr),
+ "\": ", dlerror(), (char *) NULL);
return TCL_ERROR;
}
diff --git a/unix/tclLoadDld.c b/unix/tclLoadDld.c
index 1f9e702..2b15148 100644
--- a/unix/tclLoadDld.c
+++ b/unix/tclLoadDld.c
@@ -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: tclLoadDld.c,v 1.3 1999/04/16 00:48:04 stanton Exp $
+ * RCS: @(#) $Id: tclLoadDld.c,v 1.4 2001/08/30 08:53:15 vincentdarley Exp $
*/
#include "tclInt.h"
@@ -49,9 +49,9 @@
*/
int
-TclpLoadFile(interp, fileName, sym1, sym2, proc1Ptr, proc2Ptr, clientDataPtr)
+TclpLoadFile(interp, pathPtr, sym1, sym2, proc1Ptr, proc2Ptr, clientDataPtr)
Tcl_Interp *interp; /* Used for error reporting. */
- char *fileName; /* Name of the file containing the desired
+ Tcl_Obj *pathPtr; /* Name of the file containing the desired
* code. */
char *sym1, *sym2; /* Names of two procedures to look up in
* the file's symbol table. */
@@ -64,7 +64,8 @@ TclpLoadFile(interp, fileName, sym1, sym2, proc1Ptr, proc2Ptr, clientDataPtr)
{
static int firstTime = 1;
int returnCode;
-
+ char *fileName = Tcl_GetString(pathPtr);
+
/*
* The dld package needs to know the pathname to the tcl binary.
* If that's not know, return an error.
@@ -87,9 +88,10 @@ TclpLoadFile(interp, fileName, sym1, sym2, proc1Ptr, proc2Ptr, clientDataPtr)
firstTime = 0;
}
- if ((returnCode = dld_link(fileName)) != 0) {
- Tcl_AppendResult(interp, "couldn't load file \"", fileName,
- "\": ", dld_strerror(returnCode), (char *) NULL);
+ if ((returnCode = dld_link(Tcl_GetString(pathPtr)) != 0) {
+ Tcl_AppendResult(interp, "couldn't load file \"",
+ Tcl_GetString(pathPtr),
+ "\": ", dld_strerror(returnCode), (char *) NULL);
return TCL_ERROR;
}
*proc1Ptr = (Tcl_PackageInitProc *) dld_get_func(sym1);
diff --git a/unix/tclLoadDyld.c b/unix/tclLoadDyld.c
index 9acaaa5..58eb5a5 100644
--- a/unix/tclLoadDyld.c
+++ b/unix/tclLoadDyld.c
@@ -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: tclLoadDyld.c,v 1.2 2000/04/25 17:55:45 hobbs Exp $
+ * RCS: @(#) $Id: tclLoadDyld.c,v 1.3 2001/08/30 08:53:15 vincentdarley Exp $
*/
#include "tclInt.h"
@@ -40,9 +40,9 @@
*/
int
-TclpLoadFile(interp, fileName, sym1, sym2, proc1Ptr, proc2Ptr, clientDataPtr)
+TclpLoadFile(interp, pathPtr, sym1, sym2, proc1Ptr, proc2Ptr, clientDataPtr)
Tcl_Interp *interp; /* Used for error reporting. */
- char *fileName; /* Name of the file containing the desired
+ Tcl_Obj *pathPtr; /* Name of the file containing the desired
* code. */
char *sym1, *sym2; /* Names of two procedures to look up in
* the file's symbol table. */
@@ -59,6 +59,7 @@ TclpLoadFile(interp, fileName, sym1, sym2, proc1Ptr, proc2Ptr, clientDataPtr)
NSSymbol symbol;
char *name;
+ char *fileName = Tcl_GetString(pathPtr);
err = NSCreateObjectFileImageFromFile(fileName, &image);
if (err != NSObjectFileImageSuccess) {
switch (err) {
diff --git a/unix/tclLoadNext.c b/unix/tclLoadNext.c
index f29c996..f460524 100644
--- a/unix/tclLoadNext.c
+++ b/unix/tclLoadNext.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: tclLoadNext.c,v 1.3 1999/04/16 00:48:04 stanton Exp $
+ * RCS: @(#) $Id: tclLoadNext.c,v 1.4 2001/08/30 08:53:15 vincentdarley Exp $
*/
#include "tclInt.h"
@@ -39,9 +39,9 @@
*/
int
-TclpLoadFile(interp, fileName, sym1, sym2, proc1Ptr, proc2Ptr, clientDataPtr)
+TclpLoadFile(interp, pathPtr, sym1, sym2, proc1Ptr, proc2Ptr, clientDataPtr)
Tcl_Interp *interp; /* Used for error reporting. */
- char *fileName; /* Name of the file containing the desired
+ Tcl_Obj *pathPtr; /* Name of the file containing the desired
* code. */
char *sym1, *sym2; /* Names of two procedures to look up in
* the file's symbol table. */
@@ -57,7 +57,8 @@ TclpLoadFile(interp, fileName, sym1, sym2, proc1Ptr, proc2Ptr, clientDataPtr)
int len, maxlen;
char *files[]={fileName,NULL};
NXStream *errorStream=NXOpenMemory(0,0,NX_READWRITE);
-
+ char *fileName = Tcl_GetString(pathPtr);
+
if(!rld_load(errorStream,&header,files,NULL)) {
NXGetMemoryBuffer(errorStream,&data,&len,&maxlen);
Tcl_AppendResult(interp,"couldn't load file \"",fileName,"\": ",data,NULL);
diff --git a/unix/tclLoadOSF.c b/unix/tclLoadOSF.c
index 9e8b3ad..cd6a393 100644
--- a/unix/tclLoadOSF.c
+++ b/unix/tclLoadOSF.c
@@ -31,7 +31,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclLoadOSF.c,v 1.3 1999/04/16 00:48:04 stanton Exp $
+ * RCS: @(#) $Id: tclLoadOSF.c,v 1.4 2001/08/30 08:53:15 vincentdarley Exp $
*/
#include "tclInt.h"
@@ -60,9 +60,9 @@
*/
int
-TclpLoadFile(interp, fileName, sym1, sym2, proc1Ptr, proc2Ptr, clientDataPtr)
+TclpLoadFile(interp, pathPtr, sym1, sym2, proc1Ptr, proc2Ptr, clientDataPtr)
Tcl_Interp *interp; /* Used for error reporting. */
- char *fileName; /* Name of the file containing the desired
+ Tcl_Obj *pathPtr; /* Name of the file containing the desired
* code. */
char *sym1, *sym2; /* Names of two procedures to look up in
* the file's symbol table. */
@@ -75,7 +75,8 @@ TclpLoadFile(interp, fileName, sym1, sym2, proc1Ptr, proc2Ptr, clientDataPtr)
{
ldr_module_t lm;
char *pkg;
-
+ char *fileName = Tcl_GetString(pathPtr);
+
lm = (Tcl_PackageInitProc *) load(fileName, LDR_NOFLAGS);
if (lm == LDR_NULL_MODULE) {
Tcl_AppendResult(interp, "couldn't load file \"", fileName,
diff --git a/unix/tclLoadShl.c b/unix/tclLoadShl.c
index 0623986..0d7c648 100644
--- a/unix/tclLoadShl.c
+++ b/unix/tclLoadShl.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: tclLoadShl.c,v 1.4 2001/04/09 23:09:58 kennykb Exp $
+ * RCS: @(#) $Id: tclLoadShl.c,v 1.5 2001/08/30 08:53:15 vincentdarley Exp $
*/
#include <dl.h>
@@ -47,9 +47,9 @@
*/
int
-TclpLoadFile(interp, fileName, sym1, sym2, proc1Ptr, proc2Ptr, clientDataPtr)
+TclpLoadFile(interp, pathPtr, sym1, sym2, proc1Ptr, proc2Ptr, clientDataPtr)
Tcl_Interp *interp; /* Used for error reporting. */
- char *fileName; /* Name of the file containing the desired
+ Tcl_Obj *pathPtr; /* Name of the file containing the desired
* code. */
char *sym1, *sym2; /* Names of two procedures to look up in
* the file's symbol table. */
@@ -62,7 +62,8 @@ TclpLoadFile(interp, fileName, sym1, sym2, proc1Ptr, proc2Ptr, clientDataPtr)
{
shl_t handle;
Tcl_DString newName;
-
+ char *fileName = Tcl_GetString(pathPtr);
+
/*
* The flags below used to be BIND_IMMEDIATE; they were changed at
* the suggestion of Wolfgang Kechel (wolfgang@prs.de): "This
diff --git a/unix/tclUnixChan.c b/unix/tclUnixChan.c
index d31cc6c..9f31e8f 100644
--- a/unix/tclUnixChan.c
+++ b/unix/tclUnixChan.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: tclUnixChan.c,v 1.20 2001/06/18 13:13:23 dkf Exp $
+ * RCS: @(#) $Id: tclUnixChan.c,v 1.21 2001/08/30 08:53:15 vincentdarley Exp $
*/
#include "tclInt.h" /* Internal definitions for Tcl. */
@@ -1281,10 +1281,10 @@ TtyInit(fd, initialize)
*/
Tcl_Channel
-TclpOpenFileChannel(interp, fileName, modeString, permissions)
+TclpOpenFileChannel(interp, pathPtr, modeString, permissions)
Tcl_Interp *interp; /* Interpreter for error reporting;
* can be NULL. */
- char *fileName; /* Name of file to open. */
+ Tcl_Obj *pathPtr; /* Name of file to open. */
char *modeString; /* A list of POSIX open modes or
* a string such as "rw". */
int permissions; /* If the open involves creating a
@@ -1295,7 +1295,6 @@ TclpOpenFileChannel(interp, fileName, modeString, permissions)
FileState *fsPtr;
char *native, *translation;
char channelName[16 + TCL_INTEGER_SPACE];
- Tcl_DString ds, buffer;
Tcl_ChannelType *channelTypePtr;
#ifdef DEPRECATED
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
@@ -1323,19 +1322,17 @@ TclpOpenFileChannel(interp, fileName, modeString, permissions)
return NULL;
}
- native = Tcl_TranslateFileName(interp, fileName, &buffer);
+ native = Tcl_FSGetNativePath(pathPtr);
if (native == NULL) {
return NULL;
}
- native = Tcl_UtfToExternalDString(NULL, native, -1, &ds);
- fd = open(native, mode, permissions); /* INTL: Native. */
- Tcl_DStringFree(&ds);
- Tcl_DStringFree(&buffer);
+ fd = open(native, mode, permissions);
if (fd < 0) {
if (interp != (Tcl_Interp *) NULL) {
- Tcl_AppendResult(interp, "couldn't open \"", fileName, "\": ",
- Tcl_PosixError(interp), (char *) NULL);
+ Tcl_AppendResult(interp, "couldn't open \"",
+ Tcl_GetString(pathPtr), "\": ",
+ Tcl_PosixError(interp), (char *) NULL);
}
return NULL;
}
diff --git a/unix/tclUnixFCmd.c b/unix/tclUnixFCmd.c
index 23eeda6..264a7a6 100644
--- a/unix/tclUnixFCmd.c
+++ b/unix/tclUnixFCmd.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: tclUnixFCmd.c,v 1.10 2001/08/23 18:20:50 hobbs Exp $
+ * RCS: @(#) $Id: tclUnixFCmd.c,v 1.11 2001/08/30 08:53:15 vincentdarley Exp $
*
* Portions of this code were derived from NetBSD source code which has
* the following copyright notice:
@@ -150,77 +150,10 @@ static int TraverseUnixTree _ANSI_ARGS_((
Tcl_DString *sourcePtr, Tcl_DString *destPtr,
Tcl_DString *errorPtr));
-int
-TclpObjCreateDirectory(pathPtr)
- Tcl_Obj *pathPtr;
-{
- return DoCreateDirectory(Tcl_FSGetNativePath(pathPtr));
-}
-
-int
-TclpObjDeleteFile(pathPtr)
- Tcl_Obj *pathPtr;
-{
- return DoDeleteFile(Tcl_FSGetNativePath(pathPtr));
-}
-
-int
-TclpObjCopyDirectory(srcPathPtr, destPathPtr, errorPtr)
- Tcl_Obj *srcPathPtr;
- Tcl_Obj *destPathPtr;
- Tcl_Obj **errorPtr;
-{
- Tcl_DString ds;
- int ret;
- ret = TclpCopyDirectory(Tcl_FSGetTranslatedStringPath(NULL,srcPathPtr),
- Tcl_FSGetTranslatedStringPath(NULL,destPathPtr), &ds);
- if (ret != TCL_OK) {
- *errorPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), -1);
- Tcl_DStringFree(&ds);
- Tcl_IncrRefCount(*errorPtr);
- }
- return ret;
-}
-
-int
-TclpObjCopyFile(srcPathPtr, destPathPtr)
- Tcl_Obj *srcPathPtr;
- Tcl_Obj *destPathPtr;
-{
- return DoCopyFile(Tcl_FSGetNativePath(srcPathPtr),
- Tcl_FSGetNativePath(destPathPtr));
-}
-
-int
-TclpObjRemoveDirectory(pathPtr, recursive, errorPtr)
- Tcl_Obj *pathPtr;
- int recursive;
- Tcl_Obj **errorPtr;
-{
- Tcl_DString ds;
- int ret;
- ret = TclpRemoveDirectory(Tcl_FSGetTranslatedStringPath(NULL, pathPtr),recursive, &ds);
- if (ret != TCL_OK) {
- *errorPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), -1);
- Tcl_DStringFree(&ds);
- Tcl_IncrRefCount(*errorPtr);
- }
- return ret;
-}
-
-int
-TclpObjRenameFile(srcPathPtr, destPathPtr)
- Tcl_Obj *srcPathPtr;
- Tcl_Obj *destPathPtr;
-{
- return DoRenameFile(Tcl_FSGetNativePath(srcPathPtr),
- Tcl_FSGetNativePath(destPathPtr));
-}
-
/*
*---------------------------------------------------------------------------
*
- * TclpRenameFile, DoRenameFile --
+ * TclpObjRenameFile, DoRenameFile --
*
* Changes the name of an existing file or directory, from src to dst.
* If src and dst refer to the same file or directory, does nothing
@@ -252,23 +185,14 @@ TclpObjRenameFile(srcPathPtr, destPathPtr)
*---------------------------------------------------------------------------
*/
-int
-TclpRenameFile(src, dst)
- CONST char *src; /* Pathname of file or dir to be renamed
- * (UTF-8). */
- CONST char *dst; /* New pathname of file or directory
- * (UTF-8). */
-{
- int result;
- Tcl_DString srcString, dstString;
- Tcl_UtfToExternalDString(NULL, src, -1, &srcString);
- Tcl_UtfToExternalDString(NULL, dst, -1, &dstString);
- result = DoRenameFile(Tcl_DStringValue(&srcString),
- Tcl_DStringValue(&dstString));
- Tcl_DStringFree(&srcString);
- Tcl_DStringFree(&dstString);
- return result;
+int
+TclpObjRenameFile(srcPathPtr, destPathPtr)
+ Tcl_Obj *srcPathPtr;
+ Tcl_Obj *destPathPtr;
+{
+ return DoRenameFile(Tcl_FSGetNativePath(srcPathPtr),
+ Tcl_FSGetNativePath(destPathPtr));
}
static int
@@ -355,7 +279,7 @@ DoRenameFile(src, dst)
/*
*---------------------------------------------------------------------------
*
- * TclpCopyFile, DoCopyFile --
+ * TclpObjCopyFile, DoCopyFile --
*
* Copy a single file (not a directory). If dst already exists and
* is not a directory, it is removed.
@@ -380,20 +304,12 @@ DoRenameFile(src, dst)
*/
int
-TclpCopyFile(src, dst)
- CONST char *src; /* Pathname of file to be copied (UTF-8). */
- CONST char *dst; /* Pathname of file to copy to (UTF-8). */
+TclpObjCopyFile(srcPathPtr, destPathPtr)
+ Tcl_Obj *srcPathPtr;
+ Tcl_Obj *destPathPtr;
{
- int result;
- Tcl_DString srcString, dstString;
-
- Tcl_UtfToExternalDString(NULL, src, -1, &srcString);
- Tcl_UtfToExternalDString(NULL, dst, -1, &dstString);
- result = DoCopyFile(Tcl_DStringValue(&srcString),
- Tcl_DStringValue(&dstString));
- Tcl_DStringFree(&srcString);
- Tcl_DStringFree(&dstString);
- return result;
+ return DoCopyFile(Tcl_FSGetNativePath(srcPathPtr),
+ Tcl_FSGetNativePath(destPathPtr));
}
static int
@@ -561,7 +477,7 @@ CopyFile(src, dst, statBufPtr)
/*
*---------------------------------------------------------------------------
*
- * TclpDeleteFile, DoDeleteFile --
+ * TclpObjDeleteFile, DoDeleteFile --
*
* Removes a single file (not a directory).
*
@@ -580,17 +496,11 @@ CopyFile(src, dst, statBufPtr)
*---------------------------------------------------------------------------
*/
-int
-TclpDeleteFile(path)
- CONST char *path; /* Pathname of file to be removed (UTF-8). */
+int
+TclpObjDeleteFile(pathPtr)
+ Tcl_Obj *pathPtr;
{
- int result;
- Tcl_DString pathString;
-
- Tcl_UtfToExternalDString(NULL, path, -1, &pathString);
- result = DoDeleteFile(Tcl_DStringValue(&pathString));
- Tcl_DStringFree(&pathString);
- return result;
+ return DoDeleteFile(Tcl_FSGetNativePath(pathPtr));
}
static int
@@ -629,17 +539,11 @@ DoDeleteFile(path)
*---------------------------------------------------------------------------
*/
-int
-TclpCreateDirectory(path)
- CONST char *path; /* Pathname of directory to create (UTF-8). */
+int
+TclpObjCreateDirectory(pathPtr)
+ Tcl_Obj *pathPtr;
{
- int result;
- Tcl_DString pathString;
-
- Tcl_UtfToExternalDString(NULL, path, -1, &pathString);
- result = DoCreateDirectory(Tcl_DStringValue(&pathString));
- Tcl_DStringFree(&pathString);
- return result;
+ return DoCreateDirectory(Tcl_FSGetNativePath(pathPtr));
}
static int
@@ -666,7 +570,7 @@ DoCreateDirectory(path)
/*
*---------------------------------------------------------------------------
*
- * TclpCopyDirectory --
+ * TclpObjCopyDirectory --
*
* Recursively copies a directory. The target directory dst must
* not already exist. Note that this function does not merge two
@@ -677,8 +581,8 @@ DoCreateDirectory(path)
* If the directory was successfully copied, returns TCL_OK.
* Otherwise the return value is TCL_ERROR, errno is set to indicate
* the error, and the pathname of the file that caused the error
- * is stored in errorPtr. See TclpCreateDirectory and TclpCopyFile
- * for a description of possible values for errno.
+ * is stored in errorPtr. See TclpObjCreateDirectory and
+ * TclpObjCopyFile for a description of possible values for errno.
*
* Side effects:
* An exact copy of the directory hierarchy src will be created
@@ -689,27 +593,36 @@ DoCreateDirectory(path)
*---------------------------------------------------------------------------
*/
-int
-TclpCopyDirectory(src, dst, errorPtr)
- CONST char *src; /* Pathname of directory to be copied
- * (UTF-8). */
- CONST char *dst; /* Pathname of target directory (UTF-8). */
- Tcl_DString *errorPtr; /* If non-NULL, uninitialized or free
- * DString filled with UTF-8 name of file
- * causing error. */
+int
+TclpObjCopyDirectory(srcPathPtr, destPathPtr, errorPtr)
+ Tcl_Obj *srcPathPtr;
+ Tcl_Obj *destPathPtr;
+ Tcl_Obj **errorPtr;
{
+ Tcl_DString ds;
Tcl_DString srcString, dstString;
- int result;
+ int ret;
- Tcl_UtfToExternalDString(NULL, src, -1, &srcString);
- Tcl_UtfToExternalDString(NULL, dst, -1, &dstString);
+ Tcl_UtfToExternalDString(NULL,
+ Tcl_FSGetTranslatedStringPath(NULL,srcPathPtr),
+ -1, &srcString);
+ Tcl_UtfToExternalDString(NULL,
+ Tcl_FSGetTranslatedStringPath(NULL,destPathPtr),
+ -1, &dstString);
- result = TraverseUnixTree(TraversalCopy, &srcString, &dstString, errorPtr);
+ ret = TraverseUnixTree(TraversalCopy, &srcString, &dstString, &ds);
Tcl_DStringFree(&srcString);
Tcl_DStringFree(&dstString);
- return result;
+
+ if (ret != TCL_OK) {
+ *errorPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), -1);
+ Tcl_DStringFree(&ds);
+ Tcl_IncrRefCount(*errorPtr);
+ }
+ return ret;
}
+
/*
*---------------------------------------------------------------------------
@@ -737,25 +650,27 @@ TclpCopyDirectory(src, dst, errorPtr)
*---------------------------------------------------------------------------
*/
-int
-TclpRemoveDirectory(path, recursive, errorPtr)
- CONST char *path; /* Pathname of directory to be removed
- * (UTF-8). */
- int recursive; /* If non-zero, removes directories that
- * are nonempty. Otherwise, will only remove
- * empty directories. */
- Tcl_DString *errorPtr; /* If non-NULL, uninitialized or free
- * DString filled with UTF-8 name of file
- * causing error. */
+int
+TclpObjRemoveDirectory(pathPtr, recursive, errorPtr)
+ Tcl_Obj *pathPtr;
+ int recursive;
+ Tcl_Obj **errorPtr;
{
- int result;
+ Tcl_DString ds;
Tcl_DString pathString;
+ int ret;
- Tcl_UtfToExternalDString(NULL, path, -1, &pathString);
- result = DoRemoveDirectory(&pathString, recursive, errorPtr);
+ Tcl_UtfToExternalDString(NULL, Tcl_FSGetTranslatedStringPath(NULL, pathPtr),
+ -1, &pathString);
+ ret = DoRemoveDirectory(&pathString, recursive, &ds);
Tcl_DStringFree(&pathString);
- return result;
+ if (ret != TCL_OK) {
+ *errorPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), -1);
+ Tcl_DStringFree(&ds);
+ Tcl_IncrRefCount(*errorPtr);
+ }
+ return ret;
}
static int
@@ -1696,24 +1611,34 @@ TclpObjNormalizePath(interp, pathPtr, nextCheckpoint)
Tcl_Obj *pathPtr;
int nextCheckpoint;
{
+ char *currentPathEndPosition;
char *path = Tcl_GetString(pathPtr);
-
+
+ currentPathEndPosition = path + nextCheckpoint;
+
while (1) {
- char cur = path[nextCheckpoint];
- if (cur == 0) {
- break;
- }
- if (cur == '/') {
- int access;
- path[nextCheckpoint] = 0;
- access = TclpAccess(path, F_OK);
- path[nextCheckpoint] = '/';
- if (access != 0) {
+ char cur = *currentPathEndPosition;
+ if (cur == '/' || cur == 0) {
+ /* Reached directory separator, or end of string */
+ Tcl_DString ds;
+ char *nativePath;
+ int accessOk;
+
+ nativePath = Tcl_UtfToExternalDString(NULL, path,
+ currentPathEndPosition - path, &ds);
+ accessOk = access(nativePath, F_OK);
+ Tcl_DStringFree(&ds);
+ if (accessOk != 0) {
/* File doesn't exist */
break;
}
+ if (cur == 0) {
+ break;
+ }
}
- nextCheckpoint++;
+ currentPathEndPosition++;
}
+ nextCheckpoint = currentPathEndPosition - path;
+ /* We should really now convert this to a canonical path */
return nextCheckpoint;
}
diff --git a/unix/tclUnixFile.c b/unix/tclUnixFile.c
index bbfebf1..befa699 100644
--- a/unix/tclUnixFile.c
+++ b/unix/tclUnixFile.c
@@ -9,14 +9,12 @@
* 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.11 2001/08/23 17:37:08 vincentdarley Exp $
+ * RCS: @(#) $Id: tclUnixFile.c,v 1.12 2001/08/30 08:53:15 vincentdarley Exp $
*/
#include "tclInt.h"
#include "tclPort.h"
-char * TclpGetCwd _ANSI_ARGS_((Tcl_Interp *interp, Tcl_DString *bufferPtr));
-
/*
*---------------------------------------------------------------------------
@@ -208,6 +206,7 @@ TclpMatchInDirectory(interp, resultPtr, pathPtr, pattern, types)
Tcl_DString ds;
struct stat statBuf;
int matchHidden;
+ int nativeDirLen;
int result = TCL_OK;
Tcl_DString dsOrig;
Tcl_Obj *fileNamePtr;
@@ -241,12 +240,6 @@ TclpMatchInDirectory(interp, resultPtr, pathPtr, pattern, types)
}
}
- if ((TclpStat(dirName, &statBuf) != 0) /* INTL: UTF-8. */
- || !S_ISDIR(statBuf.st_mode)) {
- Tcl_DStringFree(&dsOrig);
- return TCL_OK;
- }
-
/*
* Check to see if the pattern needs to compare with hidden files.
*/
@@ -263,11 +256,19 @@ TclpMatchInDirectory(interp, resultPtr, pathPtr, pattern, types)
*/
native = Tcl_UtfToExternalDString(NULL, dirName, -1, &ds);
+
+ if ((stat(native, &statBuf) != 0) /* INTL: UTF-8. */
+ || !S_ISDIR(statBuf.st_mode)) {
+ Tcl_DStringFree(&dsOrig);
+ Tcl_DStringFree(&ds);
+ return TCL_OK;
+ }
+
d = opendir(native); /* INTL: Native. */
- Tcl_DStringFree(&ds);
if (d == NULL) {
char savedChar = '\0';
Tcl_ResetResult(interp);
+ Tcl_DStringFree(&ds);
/*
* Strip off a trailing '/' if necessary, before reporting the error.
@@ -289,7 +290,10 @@ TclpMatchInDirectory(interp, resultPtr, pathPtr, pattern, types)
return TCL_ERROR;
}
+ nativeDirLen = Tcl_DStringLength(&ds);
+
while (1) {
+ Tcl_DString utfDs;
char *utf;
struct dirent *entryPtr;
@@ -319,7 +323,7 @@ TclpMatchInDirectory(interp, resultPtr, pathPtr, pattern, types)
* and pattern. If so, add the file to the result.
*/
- utf = Tcl_ExternalToUtfDString(NULL, entryPtr->d_name, -1, &ds);
+ utf = Tcl_ExternalToUtfDString(NULL, entryPtr->d_name, -1, &utfDs);
if (Tcl_StringMatch(utf, pattern) != 0) {
int typeOk = 1;
@@ -328,15 +332,23 @@ TclpMatchInDirectory(interp, resultPtr, pathPtr, pattern, types)
fname = Tcl_DStringValue(&dsOrig);
if (types != NULL) {
struct stat buf;
-
+ char *nativeEntry;
+ Tcl_DStringSetLength(&ds, nativeDirLen);
+ Tcl_DStringAppend(&ds, entryPtr->d_name, -1);
+ nativeEntry = Tcl_DStringValue(&ds);
+ /*
+ * The native name of the file is in entryPtr->d_name.
+ * We can use this below.
+ */
+
if (types->perm != 0) {
- if (TclpStat(fname, &buf) != 0) {
+ if (stat(nativeEntry, &buf) != 0) {
/*
* Either the file has disappeared between the
- * 'readdir' call and the 'TclpStat' call, or
+ * 'readdir' call and the 'stat' call, or
* the file is a link to a file which doesn't
* exist (which we could ascertain with
- * TclpLstat), or there is some other strange
+ * lstat), or there is some other strange
* problem. In all these cases, we define this
* to mean the file does not match any defined
* permission, and therefore it is not
@@ -353,11 +365,11 @@ TclpMatchInDirectory(interp, resultPtr, pathPtr, pattern, types)
((types->perm & TCL_GLOB_PERM_RONLY) &&
(buf.st_mode & (S_IWOTH|S_IWGRP|S_IWUSR))) ||
((types->perm & TCL_GLOB_PERM_R) &&
- (TclpAccess(fname, R_OK) != 0)) ||
+ (access(entryPtr->d_name, R_OK) != 0)) ||
((types->perm & TCL_GLOB_PERM_W) &&
- (TclpAccess(fname, W_OK) != 0)) ||
+ (access(entryPtr->d_name, W_OK) != 0)) ||
((types->perm & TCL_GLOB_PERM_X) &&
- (TclpAccess(fname, X_OK) != 0))
+ (access(entryPtr->d_name, X_OK) != 0))
)) {
typeOk = 0;
}
@@ -365,7 +377,7 @@ TclpMatchInDirectory(interp, resultPtr, pathPtr, pattern, types)
if (typeOk && (types->type != 0)) {
if (types->perm == 0) {
/* We haven't yet done a stat on the file */
- if (TclpStat(fname, &buf) != 0) {
+ if (stat(nativeEntry, &buf) != 0) {
/* Posix error occurred */
typeOk = 0;
}
@@ -395,7 +407,7 @@ TclpMatchInDirectory(interp, resultPtr, pathPtr, pattern, types)
typeOk = 0;
#ifdef S_ISLNK
if (types->type & TCL_GLOB_TYPE_LINK) {
- if (TclpLstat(fname, &buf) == 0) {
+ if (lstat(nativeEntry, &buf) == 0) {
if (S_ISLNK(buf.st_mode)) {
typeOk = 1;
}
@@ -411,10 +423,11 @@ TclpMatchInDirectory(interp, resultPtr, pathPtr, pattern, types)
Tcl_NewStringObj(fname, Tcl_DStringLength(&dsOrig)));
}
}
- Tcl_DStringFree(&ds);
+ Tcl_DStringFree(&utfDs);
}
closedir(d);
+ Tcl_DStringFree(&ds);
Tcl_DStringFree(&dsOrig);
return result;
}
@@ -466,7 +479,7 @@ TclpGetUserHome(name, bufferPtr)
/*
*---------------------------------------------------------------------------
*
- * TclpAccess --
+ * TclpObjAccess --
*
* This function replaces the library version of access().
*
@@ -479,26 +492,23 @@ TclpGetUserHome(name, bufferPtr)
*---------------------------------------------------------------------------
*/
-int
-TclpAccess(path, mode)
- CONST char *path; /* Path of file to access (UTF-8). */
- int mode; /* Permission setting. */
+int
+TclpObjAccess(pathPtr, mode)
+ Tcl_Obj *pathPtr; /* Path of file to access */
+ int mode; /* Permission setting. */
{
- int result;
- Tcl_DString ds;
- char *native;
-
- native = Tcl_UtfToExternalDString(NULL, path, -1, &ds);
- result = access(native, mode); /* INTL: Native. */
- Tcl_DStringFree(&ds);
-
- return result;
+ char *path = Tcl_FSGetNativePath(pathPtr);
+ if (path == NULL) {
+ return -1;
+ } else {
+ return access(path, mode);
+ }
}
/*
*---------------------------------------------------------------------------
*
- * TclpChdir --
+ * TclpObjChdir --
*
* This function replaces the library version of chdir().
*
@@ -511,25 +521,22 @@ TclpAccess(path, mode)
*---------------------------------------------------------------------------
*/
-int
-TclpChdir(dirName)
- CONST char *dirName; /* Path to new working directory (UTF-8). */
+int
+TclpObjChdir(pathPtr)
+ Tcl_Obj *pathPtr; /* Path to new working directory */
{
- int result;
- Tcl_DString ds;
- char *native;
-
- native = Tcl_UtfToExternalDString(NULL, dirName, -1, &ds);
- result = chdir(native); /* INTL: Native. */
- Tcl_DStringFree(&ds);
-
- return result;
+ char *path = Tcl_FSGetNativePath(pathPtr);
+ if (path == NULL) {
+ return -1;
+ } else {
+ return chdir(path);
+ }
}
/*
*----------------------------------------------------------------------
*
- * TclpLstat --
+ * TclpObjLstat --
*
* This function replaces the library version of lstat().
*
@@ -542,26 +549,23 @@ TclpChdir(dirName)
*----------------------------------------------------------------------
*/
-int
-TclpLstat(path, bufPtr)
- CONST char *path; /* Path of file to stat (UTF-8). */
+int
+TclpObjLstat(pathPtr, bufPtr)
+ Tcl_Obj *pathPtr; /* Path of file to stat */
struct stat *bufPtr; /* Filled with results of stat call. */
{
- int result;
- Tcl_DString ds;
- char *native;
-
- native = Tcl_UtfToExternalDString(NULL, path, -1, &ds);
- result = lstat(native, bufPtr); /* INTL: Native. */
- Tcl_DStringFree(&ds);
-
- return result;
+ char *path = Tcl_FSGetNativePath(pathPtr);
+ if (path == NULL) {
+ return -1;
+ } else {
+ return lstat(path, bufPtr);
+ }
}
/*
*---------------------------------------------------------------------------
*
- * TclpGetCwd --
+ * TclpObjGetCwd --
*
* This function replaces the library version of getcwd().
*
@@ -579,6 +583,22 @@ TclpLstat(path, bufPtr)
*----------------------------------------------------------------------
*/
+Tcl_Obj*
+TclpObjGetCwd(interp)
+ Tcl_Interp *interp;
+{
+ Tcl_DString ds;
+ if (TclpGetCwd(interp, &ds) != NULL) {
+ Tcl_Obj *cwdPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), -1);
+ Tcl_IncrRefCount(cwdPtr);
+ Tcl_DStringFree(&ds);
+ return cwdPtr;
+ } else {
+ return NULL;
+ }
+}
+
+/* Older string based version */
char *
TclpGetCwd(interp, bufferPtr)
Tcl_Interp *interp; /* If non-NULL, used for error reporting. */
@@ -648,7 +668,7 @@ TclpReadlink(path, linkPtr)
/*
*----------------------------------------------------------------------
*
- * TclpStat --
+ * TclpObjStat --
*
* This function replaces the library version of stat().
*
@@ -661,87 +681,19 @@ TclpReadlink(path, linkPtr)
*----------------------------------------------------------------------
*/
-int
-TclpStat(path, bufPtr)
- CONST char *path; /* Path of file to stat (in UTF-8). */
- struct stat *bufPtr; /* Filled with results of stat call. */
-{
- int result;
- Tcl_DString ds;
- char *native;
-
- native = Tcl_UtfToExternalDString(NULL, path, -1, &ds);
- result = stat(native, bufPtr); /* INTL: Native. */
- Tcl_DStringFree(&ds);
-
- return result;
-}
-
-int
-TclpObjLstat(pathPtr, buf)
- Tcl_Obj *pathPtr;
- struct stat *buf;
-{
- char *path = Tcl_FSGetNativePath(pathPtr);
- if (path == NULL) {
- return -1;
- } else {
- return lstat(path, buf);
- }
-}
-
int
-TclpObjStat(pathPtr, buf)
- Tcl_Obj *pathPtr;
- struct stat *buf;
-{
- char *path = Tcl_FSGetNativePath(pathPtr);
- if (path == NULL) {
- return -1;
- } else {
- return stat(path, buf);
- }
-}
-
-Tcl_Obj*
-TclpObjGetCwd(interp)
- Tcl_Interp *interp;
-{
- Tcl_DString ds;
- if (TclpGetCwd(interp, &ds) != NULL) {
- Tcl_Obj *cwdPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), -1);
- Tcl_IncrRefCount(cwdPtr);
- Tcl_DStringFree(&ds);
- return cwdPtr;
- } else {
- return NULL;
- }
-}
-
-int
-TclpObjChdir(pathPtr)
- Tcl_Obj *pathPtr;
-{
- char *path = Tcl_FSGetNativePath(pathPtr);
- if (path == NULL) {
- return -1;
- } else {
- return chdir(path);
- }
-}
-
-int
-TclpObjAccess(pathPtr, mode)
- Tcl_Obj *pathPtr;
- int mode;
+TclpObjStat(pathPtr, bufPtr)
+ Tcl_Obj *pathPtr; /* Path of file to stat */
+ struct stat *bufPtr; /* Filled with results of stat call. */
{
char *path = Tcl_FSGetNativePath(pathPtr);
if (path == NULL) {
return -1;
} else {
- return access(path, mode);
+ return stat(path, bufPtr);
}
}
+
#ifdef S_IFLNK
diff --git a/unix/tclUnixPort.h b/unix/tclUnixPort.h
index 1e7985d..4ca092a 100644
--- a/unix/tclUnixPort.h
+++ b/unix/tclUnixPort.h
@@ -19,7 +19,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclUnixPort.h,v 1.17 2001/06/17 03:48:19 dgp Exp $
+ * RCS: @(#) $Id: tclUnixPort.h,v 1.18 2001/08/30 08:53:15 vincentdarley Exp $
*/
#ifndef _TCLUNIXPORT
@@ -484,15 +484,6 @@ extern double strtod();
#define TclpExit exit
-#ifdef TclpStat
-#undef TclpStat
-#endif
-
-EXTERN int TclpLstat _ANSI_ARGS_((CONST char *path,
- struct stat *buf));
-EXTERN int TclpStat _ANSI_ARGS_((CONST char *path,
- struct stat *buf));
-
/*
* Platform specific mutex definition used by memory allocators.
* These mutexes are statically allocated and explicitly initialized.