diff options
Diffstat (limited to 'unix')
| -rw-r--r-- | unix/tclLoadAout.c | 12 | ||||
| -rw-r--r-- | unix/tclLoadDl.c | 14 | ||||
| -rw-r--r-- | unix/tclLoadDld.c | 16 | ||||
| -rw-r--r-- | unix/tclLoadDyld.c | 7 | ||||
| -rw-r--r-- | unix/tclLoadNext.c | 9 | ||||
| -rw-r--r-- | unix/tclLoadOSF.c | 9 | ||||
| -rw-r--r-- | unix/tclLoadShl.c | 9 | ||||
| -rw-r--r-- | unix/tclUnixChan.c | 19 | ||||
| -rw-r--r-- | unix/tclUnixFCmd.c | 249 | ||||
| -rw-r--r-- | unix/tclUnixFile.c | 224 | ||||
| -rw-r--r-- | unix/tclUnixPort.h | 11 |
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. |