summaryrefslogtreecommitdiffstats
path: root/unix/tclUnixFile.c
diff options
context:
space:
mode:
Diffstat (limited to 'unix/tclUnixFile.c')
-rw-r--r--unix/tclUnixFile.c528
1 files changed, 244 insertions, 284 deletions
diff --git a/unix/tclUnixFile.c b/unix/tclUnixFile.c
index 80ef634..0a2099c 100644
--- a/unix/tclUnixFile.c
+++ b/unix/tclUnixFile.c
@@ -4,17 +4,17 @@
* This file contains wrappers around UNIX file handling functions.
* These wrappers mask differences between Windows and UNIX.
*
- * Copyright © 1995-1998 Sun Microsystems, Inc.
+ * Copyright (c) 1995-1998 Sun Microsystems, Inc.
*
- * See the file "license.terms" for information on usage and redistribution
- * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/
#include "tclInt.h"
#include "tclFileSystem.h"
-static int NativeMatchType(Tcl_Interp *interp, const char* nativeEntry,
- const char* nativeName, Tcl_GlobTypeData *types);
+static int NativeMatchType(Tcl_Interp *interp, CONST char* nativeEntry,
+ CONST char* nativeName, Tcl_GlobTypeData *types);
/*
*---------------------------------------------------------------------------
@@ -34,36 +34,30 @@ static int NativeMatchType(Tcl_Interp *interp, const char* nativeEntry,
*---------------------------------------------------------------------------
*/
-#ifdef __CYGWIN__
void
TclpFindExecutable(
- TCL_UNUSED(const char *) /*argv0*/)
+ CONST char *argv0) /* The value of the application's argv[0]
+ * (native). */
{
- size_t length;
- wchar_t buf[PATH_MAX] = L"";
- char name[PATH_MAX * 3 + 1];
-
+ Tcl_Encoding encoding;
+#ifdef __CYGWIN__
+ int length;
+ char buf[PATH_MAX * 2];
+ char name[PATH_MAX * TCL_UTF_MAX + 1];
GetModuleFileNameW(NULL, buf, PATH_MAX);
- cygwin_conv_path(3, buf, name, sizeof(name));
+ cygwin_conv_path(3, buf, name, PATH_MAX);
length = strlen(name);
if ((length > 4) && !strcasecmp(name + length - 4, ".exe")) {
/* Strip '.exe' part. */
length -= 4;
}
+ encoding = Tcl_GetEncoding(NULL, NULL);
TclSetObjNameOfExecutable(
- Tcl_NewStringObj(name, length), NULL);
-}
+ Tcl_NewStringObj(name, length), encoding);
#else
-void
-TclpFindExecutable(
- const char *argv0) /* The value of the application's argv[0]
- * (native). */
-{
- Tcl_Encoding encoding;
const char *name, *p;
Tcl_StatBuf statBuf;
Tcl_DString buffer, nameString, cwd, utfName;
- Tcl_Obj *obj;
if (argv0 == NULL) {
return;
@@ -104,21 +98,21 @@ TclpFindExecutable(
*/
while (1) {
- while (TclIsSpaceProcM(*p)) {
+ while (TclIsSpaceProc(*p)) {
p++;
}
name = p;
while ((*p != ':') && (*p != 0)) {
p++;
}
- TclDStringClear(&buffer);
+ Tcl_DStringSetLength(&buffer, 0);
if (p != name) {
Tcl_DStringAppend(&buffer, name, p - name);
if (p[-1] != '/') {
- TclDStringAppendLiteral(&buffer, "/");
+ Tcl_DStringAppend(&buffer, "/", 1);
}
}
- name = Tcl_DStringAppend(&buffer, argv0, TCL_INDEX_NONE);
+ name = Tcl_DStringAppend(&buffer, argv0, -1);
/*
* INTL: The following calls to access() and stat() should not be
@@ -131,16 +125,15 @@ TclpFindExecutable(
&& S_ISREG(statBuf.st_mode)) {
goto gotName;
}
- if (p[0] == '\0') {
+ if (*p == '\0') {
break;
- } else if (p[1] == 0) {
+ } else if (*(p+1) == 0) {
p = "./";
} else {
p++;
}
}
- TclNewObj(obj);
- TclSetObjNameOfExecutable(obj, NULL);
+ TclSetObjNameOfExecutable(Tcl_NewObj(), NULL);
goto done;
/*
@@ -155,16 +148,15 @@ TclpFindExecutable(
#endif
{
encoding = Tcl_GetEncoding(NULL, NULL);
- Tcl_ExternalToUtfDString(encoding, name, TCL_INDEX_NONE, &utfName);
+ Tcl_ExternalToUtfDString(encoding, name, -1, &utfName);
TclSetObjNameOfExecutable(
- Tcl_NewStringObj(Tcl_DStringValue(&utfName), TCL_INDEX_NONE), encoding);
+ Tcl_NewStringObj(Tcl_DStringValue(&utfName), -1), encoding);
Tcl_DStringFree(&utfName);
goto done;
}
if (TclpGetCwd(NULL, &cwd) == NULL) {
- TclNewObj(obj);
- TclSetObjNameOfExecutable(obj, NULL);
+ TclSetObjNameOfExecutable(Tcl_NewObj(), NULL);
goto done;
}
@@ -179,29 +171,30 @@ TclpFindExecutable(
}
Tcl_DStringInit(&nameString);
- Tcl_DStringAppend(&nameString, name, TCL_INDEX_NONE);
+ Tcl_DStringAppend(&nameString, name, -1);
Tcl_DStringFree(&buffer);
Tcl_UtfToExternalDString(NULL, Tcl_DStringValue(&cwd),
Tcl_DStringLength(&cwd), &buffer);
if (Tcl_DStringValue(&cwd)[Tcl_DStringLength(&cwd) -1] != '/') {
- TclDStringAppendLiteral(&buffer, "/");
+ Tcl_DStringAppend(&buffer, "/", 1);
}
Tcl_DStringFree(&cwd);
- TclDStringAppendDString(&buffer, &nameString);
+ Tcl_DStringAppend(&buffer, Tcl_DStringValue(&nameString),
+ Tcl_DStringLength(&nameString));
Tcl_DStringFree(&nameString);
encoding = Tcl_GetEncoding(NULL, NULL);
- Tcl_ExternalToUtfDString(encoding, Tcl_DStringValue(&buffer), TCL_INDEX_NONE,
+ Tcl_ExternalToUtfDString(encoding, Tcl_DStringValue(&buffer), -1,
&utfName);
TclSetObjNameOfExecutable(
- Tcl_NewStringObj(Tcl_DStringValue(&utfName), TCL_INDEX_NONE), encoding);
+ Tcl_NewStringObj(Tcl_DStringValue(&utfName), -1), encoding);
Tcl_DStringFree(&utfName);
done:
Tcl_DStringFree(&buffer);
-}
#endif
+}
/*
*----------------------------------------------------------------------
@@ -227,12 +220,12 @@ TclpMatchInDirectory(
Tcl_Interp *interp, /* Interpreter to receive errors. */
Tcl_Obj *resultPtr, /* List object to lappend results. */
Tcl_Obj *pathPtr, /* Contains path to directory to search. */
- const char *pattern, /* Pattern to match against. */
+ CONST char *pattern, /* Pattern to match against. */
Tcl_GlobTypeData *types) /* Object containing list of acceptable types.
* May be NULL. In particular the directory
* flag is very important. */
{
- const char *native;
+ CONST char *native;
Tcl_Obj *fileNamePtr;
int matchResult = 0;
@@ -253,13 +246,12 @@ TclpMatchInDirectory(
/*
* Match a file directly.
*/
-
Tcl_Obj *tailPtr;
- const char *nativeTail;
+ CONST char *nativeTail;
- native = (const char *)Tcl_FSGetNativePath(pathPtr);
+ native = (CONST char*) Tcl_FSGetNativePath(pathPtr);
tailPtr = TclPathPart(interp, pathPtr, TCL_PATH_TAIL);
- nativeTail = (const char *)Tcl_FSGetNativePath(tailPtr);
+ nativeTail = (CONST char*) Tcl_FSGetNativePath(tailPtr);
matchResult = NativeMatchType(interp, native, nativeTail, types);
if (matchResult == 1) {
Tcl_ListObjAppendElement(interp, resultPtr, pathPtr);
@@ -267,23 +259,23 @@ TclpMatchInDirectory(
Tcl_DecrRefCount(tailPtr);
Tcl_DecrRefCount(fileNamePtr);
} else {
- TclDIR *d;
+ DIR *d;
Tcl_DirEntry *entryPtr;
- const char *dirName;
- size_t dirLength, nativeDirLen;
+ CONST char *dirName;
+ int dirLength;
int matchHidden, matchHiddenPat;
+ int nativeDirLen;
Tcl_StatBuf statBuf;
Tcl_DString ds; /* native encoding of dir */
Tcl_DString dsOrig; /* utf-8 encoding of dir */
Tcl_DStringInit(&dsOrig);
- dirName = TclGetString(fileNamePtr);
- dirLength = fileNamePtr->length;
+ dirName = Tcl_GetStringFromObj(fileNamePtr, &dirLength);
Tcl_DStringAppend(&dsOrig, dirName, dirLength);
/*
* Make sure that the directory part of the name really is a
- * directory. If the directory name is "", use the name "." instead,
+ * directory. If the directory name is "", use the name "." instead,
* because some UNIX systems don't treat "" like "." automatically.
* Keep the "" for use in generating file names, otherwise "glob
* foo.c" would return "./foo.c".
@@ -299,7 +291,7 @@ TclpMatchInDirectory(
*/
if (dirName[dirLength-1] != '/') {
- dirName = TclDStringAppendLiteral(&dsOrig, "/");
+ dirName = Tcl_DStringAppend(&dsOrig, "/", 1);
dirLength++;
}
}
@@ -308,7 +300,7 @@ TclpMatchInDirectory(
* Now open the directory for reading and iterate over the contents.
*/
- native = Tcl_UtfToExternalDString(NULL, dirName, TCL_INDEX_NONE, &ds);
+ native = Tcl_UtfToExternalDString(NULL, dirName, -1, &ds);
if ((TclOSstat(native, &statBuf) != 0) /* INTL: Native. */
|| !S_ISDIR(statBuf.st_mode)) {
@@ -318,13 +310,14 @@ TclpMatchInDirectory(
return TCL_OK;
}
- d = TclOSopendir(native); /* INTL: Native. */
+ d = opendir(native); /* INTL: Native. */
if (d == NULL) {
Tcl_DStringFree(&ds);
if (interp != NULL) {
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "couldn't read directory \"%s\": %s",
- Tcl_DStringValue(&dsOrig), Tcl_PosixError(interp)));
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "couldn't read directory \"",
+ Tcl_DStringValue(&dsOrig), "\": ",
+ Tcl_PosixError(interp), (char *) NULL);
}
Tcl_DStringFree(&dsOrig);
Tcl_DecrRefCount(fileNamePtr);
@@ -339,11 +332,11 @@ TclpMatchInDirectory(
matchHiddenPat = (pattern[0] == '.')
|| ((pattern[0] == '\\') && (pattern[1] == '.'));
- matchHidden = matchHiddenPat
+ matchHidden = matchHiddenPat
|| (types && (types->perm & TCL_GLOB_PERM_HIDDEN));
while ((entryPtr = TclOSreaddir(d)) != NULL) { /* INTL: Native. */
Tcl_DString utfDs;
- const char *utfname;
+ CONST char *utfname;
/*
* Skip this file if it doesn't agree with the hidden parameters
@@ -351,19 +344,13 @@ TclpMatchInDirectory(
*/
if (*entryPtr->d_name == '.') {
- if (!matchHidden) {
- continue;
- }
+ if (!matchHidden) continue;
} else {
#ifdef MAC_OSX_TCL
- if (matchHiddenPat) {
- continue;
- }
+ if (matchHiddenPat) continue;
/* Also need to check HFS hidden flag in TclMacOSXMatchType. */
#else
- if (matchHidden) {
- continue;
- }
+ if (matchHidden) continue;
#endif
}
@@ -372,14 +359,14 @@ TclpMatchInDirectory(
* and pattern. If so, add the file to the result.
*/
- utfname = Tcl_ExternalToUtfDString(NULL, entryPtr->d_name, TCL_INDEX_NONE,
+ utfname = Tcl_ExternalToUtfDString(NULL, entryPtr->d_name, -1,
&utfDs);
if (Tcl_StringCaseMatch(utfname, pattern, 0)) {
int typeOk = 1;
if (types != NULL) {
Tcl_DStringSetLength(&ds, nativeDirLen);
- native = Tcl_DStringAppend(&ds, entryPtr->d_name, TCL_INDEX_NONE);
+ native = Tcl_DStringAppend(&ds, entryPtr->d_name, -1);
matchResult = NativeMatchType(interp, native,
entryPtr->d_name, types);
typeOk = (matchResult == 1);
@@ -396,15 +383,16 @@ TclpMatchInDirectory(
}
}
- TclOSclosedir(d);
+ closedir(d);
Tcl_DStringFree(&ds);
Tcl_DStringFree(&dsOrig);
Tcl_DecrRefCount(fileNamePtr);
}
if (matchResult < 0) {
return TCL_ERROR;
+ } else {
+ return TCL_OK;
}
- return TCL_OK;
}
/*
@@ -412,13 +400,13 @@ TclpMatchInDirectory(
*
* NativeMatchType --
*
- * This routine is used by the globbing code to check if a file matches a
- * given type description.
+ * This routine is used by the globbing code to check if a file
+ * matches a given type description.
*
* Results:
- * The return value is 1, 0 or -1 indicating whether the file matches the
- * given criteria, does not match them, or an error occurred (in which
- * case an error is left in interp).
+ * The return value is 1, 0 or -1 indicating whether the file
+ * matches the given criteria, does not match them, or an error
+ * occurred (in wich case an error is left in interp).
*
* Side effects:
* None.
@@ -429,12 +417,11 @@ TclpMatchInDirectory(
static int
NativeMatchType(
Tcl_Interp *interp, /* Interpreter to receive errors. */
- const char *nativeEntry, /* Native path to check. */
- const char *nativeName, /* Native filename to check. */
+ CONST char *nativeEntry, /* Native path to check. */
+ CONST char *nativeName, /* Native filename to check. */
Tcl_GlobTypeData *types) /* Type description to match against. */
{
Tcl_StatBuf buf;
-
if (types == NULL) {
/*
* Simply check for the file's existence, but do it with lstat, in
@@ -445,128 +432,124 @@ NativeMatchType(
if (TclOSlstat(nativeEntry, &buf) != 0) {
return 0;
}
- return 1;
- }
+ } else {
+ if (types->perm != 0) {
+ if (TclOSstat(nativeEntry, &buf) != 0) {
+ /*
+ * Either the file has disappeared between the 'readdir' call
+ * and the 'stat' call, or the file is a link to a file which
+ * doesn't exist (which we could ascertain with 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 added to the list of
+ * files to return.
+ */
+
+ return 0;
+ }
- if (types->perm != 0) {
- if (TclOSstat(nativeEntry, &buf) != 0) {
/*
- * Either the file has disappeared between the 'readdir' call and
- * the 'stat' call, or the file is a link to a file which doesn't
- * exist (which we could ascertain with 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 added to the list of files to return.
+ * readonly means that there are NO write permissions (even for
+ * user), but execute is OK for anybody OR that the user immutable
+ * flag is set (where supported).
*/
- return 0;
- }
-
- /*
- * readonly means that there are NO write permissions (even for user),
- * but execute is OK for anybody OR that the user immutable flag is
- * set (where supported).
- */
-
- if (((types->perm & TCL_GLOB_PERM_RONLY) &&
+ if (((types->perm & TCL_GLOB_PERM_RONLY) &&
#if defined(HAVE_CHFLAGS) && defined(UF_IMMUTABLE)
- !(buf.st_flags & UF_IMMUTABLE) &&
+ !(buf.st_flags & UF_IMMUTABLE) &&
#endif
- (buf.st_mode & (S_IWOTH|S_IWGRP|S_IWUSR))) ||
- ((types->perm & TCL_GLOB_PERM_R) &&
- (access(nativeEntry, R_OK) != 0)) ||
- ((types->perm & TCL_GLOB_PERM_W) &&
- (access(nativeEntry, W_OK) != 0)) ||
- ((types->perm & TCL_GLOB_PERM_X) &&
- (access(nativeEntry, X_OK) != 0))
+ (buf.st_mode & (S_IWOTH|S_IWGRP|S_IWUSR))) ||
+ ((types->perm & TCL_GLOB_PERM_R) &&
+ (access(nativeEntry, R_OK) != 0)) ||
+ ((types->perm & TCL_GLOB_PERM_W) &&
+ (access(nativeEntry, W_OK) != 0)) ||
+ ((types->perm & TCL_GLOB_PERM_X) &&
+ (access(nativeEntry, X_OK) != 0))
#ifndef MAC_OSX_TCL
- || ((types->perm & TCL_GLOB_PERM_HIDDEN) &&
- (*nativeName != '.'))
-#endif /* MAC_OSX_TCL */
+ || ((types->perm & TCL_GLOB_PERM_HIDDEN) &&
+ (*nativeName != '.'))
+#endif
) {
- return 0;
+ return 0;
+ }
}
- }
- if (types->type != 0) {
- if (types->perm == 0) {
- /*
- * We haven't yet done a stat on the file.
- */
-
- if (TclOSstat(nativeEntry, &buf) != 0) {
+ if (types->type != 0) {
+ if (types->perm == 0) {
/*
- * Posix error occurred. The only ok case is if this is a link
- * to a nonexistent file, and the user did 'glob -l'. So we
- * check that here:
+ * We haven't yet done a stat on the file.
*/
- if ((types->type & TCL_GLOB_TYPE_LINK)
- && (TclOSlstat(nativeEntry, &buf) == 0)
- && S_ISLNK(buf.st_mode)) {
- return 1;
+ if (TclOSstat(nativeEntry, &buf) != 0) {
+ /*
+ * Posix error occurred. The only ok case is if this is a
+ * link to a nonexistent file, and the user did 'glob -l'.
+ * So we check that here:
+ */
+
+ if (types->type & TCL_GLOB_TYPE_LINK) {
+ if (TclOSlstat(nativeEntry, &buf) == 0) {
+ if (S_ISLNK(buf.st_mode)) {
+ return 1;
+ }
+ }
+ }
+ return 0;
}
- return 0;
}
- }
- /*
- * In order bcdpsfl as in 'find -t'
- */
+ /*
+ * In order bcdpfls as in 'find -t'
+ */
- if ( ((types->type & TCL_GLOB_TYPE_BLOCK)&& S_ISBLK(buf.st_mode)) ||
+ if (((types->type & TCL_GLOB_TYPE_BLOCK)&& S_ISBLK(buf.st_mode)) ||
((types->type & TCL_GLOB_TYPE_CHAR) && S_ISCHR(buf.st_mode)) ||
((types->type & TCL_GLOB_TYPE_DIR) && S_ISDIR(buf.st_mode)) ||
((types->type & TCL_GLOB_TYPE_PIPE) && S_ISFIFO(buf.st_mode))||
+ ((types->type & TCL_GLOB_TYPE_FILE) && S_ISREG(buf.st_mode))
#ifdef S_ISSOCK
- ((types->type & TCL_GLOB_TYPE_SOCK) && S_ISSOCK(buf.st_mode))||
+ ||((types->type & TCL_GLOB_TYPE_SOCK) && S_ISSOCK(buf.st_mode))
#endif /* S_ISSOCK */
- ((types->type & TCL_GLOB_TYPE_FILE) && S_ISREG(buf.st_mode))) {
- /*
- * Do nothing - this file is ok.
- */
- } else {
+ ) {
+ /*
+ * Do nothing - this file is ok.
+ */
+ } else {
#ifdef S_ISLNK
- if ((types->type & TCL_GLOB_TYPE_LINK)
- && (TclOSlstat(nativeEntry, &buf) == 0)
- && S_ISLNK(buf.st_mode)) {
- goto filetypeOK;
- }
+ if (types->type & TCL_GLOB_TYPE_LINK) {
+ if (TclOSlstat(nativeEntry, &buf) == 0) {
+ if (S_ISLNK(buf.st_mode)) {
+ goto filetypeOK;
+ }
+ }
+ }
#endif /* S_ISLNK */
- return 0;
+ return 0;
+ }
}
- }
- filetypeOK:
-
- /*
- * If we're on OSX, we also have to worry about matching the file creator
- * code (if specified). Do that now.
- */
-
+ filetypeOK: ;
#ifdef MAC_OSX_TCL
- if (types->macType != NULL || types->macCreator != NULL ||
- (types->perm & TCL_GLOB_PERM_HIDDEN)) {
- int matchResult;
+ if (types->macType != NULL || types->macCreator != NULL ||
+ (types->perm & TCL_GLOB_PERM_HIDDEN)) {
+ int matchResult;
- if (types->perm == 0 && types->type == 0) {
- /*
- * We haven't yet done a stat on the file.
- */
+ if (types->perm == 0 && types->type == 0) {
+ /*
+ * We haven't yet done a stat on the file.
+ */
- if (TclOSstat(nativeEntry, &buf) != 0) {
- return 0;
+ if (TclOSstat(nativeEntry, &buf) != 0) {
+ return 0;
+ }
}
- }
- matchResult = TclMacOSXMatchType(interp, nativeEntry, nativeName,
- &buf, types);
- if (matchResult != 1) {
- return matchResult;
+ matchResult = TclMacOSXMatchType(interp, nativeEntry, nativeName,
+ &buf, types);
+ if (matchResult != 1) {
+ return matchResult;
+ }
}
+#endif
}
-#else
- (void)interp;
-#endif /* MAC_OSX_TCL */
-
return 1;
}
@@ -591,23 +574,25 @@ NativeMatchType(
*----------------------------------------------------------------------
*/
-const char *
+char *
TclpGetUserHome(
- const char *name, /* User name for desired home directory. */
+ CONST char *name, /* User name for desired home directory. */
Tcl_DString *bufferPtr) /* Uninitialized or free DString filled with
* name of user's home directory. */
{
struct passwd *pwPtr;
Tcl_DString ds;
- const char *native = Tcl_UtfToExternalDString(NULL, name, TCL_INDEX_NONE, &ds);
+ CONST char *native;
+ native = Tcl_UtfToExternalDString(NULL, name, -1, &ds);
pwPtr = TclpGetPwNam(native); /* INTL: Native. */
Tcl_DStringFree(&ds);
if (pwPtr == NULL) {
return NULL;
}
- return Tcl_ExternalToUtfDString(NULL, pwPtr->pw_dir, TCL_INDEX_NONE, bufferPtr);
+ Tcl_ExternalToUtfDString(NULL, pwPtr->pw_dir, -1, bufferPtr);
+ return Tcl_DStringValue(bufferPtr);
}
/*
@@ -631,12 +616,12 @@ TclpObjAccess(
Tcl_Obj *pathPtr, /* Path of file to access */
int mode) /* Permission setting. */
{
- const char *path = (const char *)Tcl_FSGetNativePath(pathPtr);
-
+ CONST char *path = Tcl_FSGetNativePath(pathPtr);
if (path == NULL) {
return -1;
+ } else {
+ return access(path, mode);
}
- return access(path, mode);
}
/*
@@ -659,12 +644,12 @@ int
TclpObjChdir(
Tcl_Obj *pathPtr) /* Path to new working directory */
{
- const char *path = (const char *)Tcl_FSGetNativePath(pathPtr);
-
+ CONST char *path = Tcl_FSGetNativePath(pathPtr);
if (path == NULL) {
return -1;
+ } else {
+ return chdir(path);
}
- return chdir(path);
}
/*
@@ -688,7 +673,7 @@ TclpObjLstat(
Tcl_Obj *pathPtr, /* Path of file to stat */
Tcl_StatBuf *bufPtr) /* Filled with results of stat call. */
{
- return TclOSlstat((const char *)Tcl_FSGetNativePath(pathPtr), bufPtr);
+ return TclOSlstat(Tcl_FSGetNativePath(pathPtr), bufPtr);
}
/*
@@ -703,7 +688,7 @@ TclpObjLstat(
* is either the given clientData, if the working directory hasn't
* changed, or a new clientData (owned by our caller), giving the new
* native path, or NULL if the current directory could not be determined.
- * If NULL is returned, the caller can examine the standard Posix error
+ * If NULL is returned, the caller can examine the standard posix error
* codes to determine the cause of the problem.
*
* Side effects:
@@ -712,34 +697,31 @@ TclpObjLstat(
*----------------------------------------------------------------------
*/
-void *
+ClientData
TclpGetNativeCwd(
- void *clientData)
+ ClientData clientData)
{
char buffer[MAXPATHLEN+1];
#ifdef USEGETWD
- if (getwd(buffer) == NULL) { /* INTL: Native. */
- return NULL;
- }
+ if (getwd(buffer) == NULL) /* INTL: Native. */
#else
- if (getcwd(buffer, MAXPATHLEN+1) == NULL) { /* INTL: Native. */
+ if (getcwd(buffer, MAXPATHLEN+1) == NULL) /* INTL: Native. */
+#endif
+ {
return NULL;
}
-#endif /* USEGETWD */
-
- if ((clientData == NULL) || strcmp(buffer, (const char *) clientData)) {
- char *newCd = (char *)ckalloc(strlen(buffer) + 1);
+ if ((clientData != NULL) && strcmp(buffer, (CONST char*)clientData) == 0) {
+ /*
+ * No change to pwd.
+ */
+ return clientData;
+ } else {
+ char *newCd = (char *) ckalloc((unsigned) (strlen(buffer) + 1));
strcpy(newCd, buffer);
- return newCd;
+ return (ClientData) newCd;
}
-
- /*
- * No change to pwd.
- */
-
- return clientData;
}
/*
@@ -764,7 +746,7 @@ TclpGetNativeCwd(
*----------------------------------------------------------------------
*/
-const char *
+CONST char *
TclpGetCwd(
Tcl_Interp *interp, /* If non-NULL, used for error reporting. */
Tcl_DString *bufferPtr) /* Uninitialized or free DString filled with
@@ -776,16 +758,16 @@ TclpGetCwd(
if (getwd(buffer) == NULL) /* INTL: Native. */
#else
if (getcwd(buffer, MAXPATHLEN+1) == NULL) /* INTL: Native. */
-#endif /* USEGETWD */
+#endif
{
if (interp != NULL) {
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "error getting working directory name: %s",
- Tcl_PosixError(interp)));
+ Tcl_AppendResult(interp,
+ "error getting working directory name: ",
+ Tcl_PosixError(interp), NULL);
}
return NULL;
}
- return Tcl_ExternalToUtfDString(NULL, buffer, TCL_INDEX_NONE, bufferPtr);
+ return Tcl_ExternalToUtfDString(NULL, buffer, -1, bufferPtr);
}
/*
@@ -810,17 +792,17 @@ TclpGetCwd(
char *
TclpReadlink(
- const char *path, /* Path of file to readlink (UTF-8). */
+ CONST char *path, /* Path of file to readlink (UTF-8). */
Tcl_DString *linkPtr) /* Uninitialized or free DString filled with
* contents of link (UTF-8). */
{
#ifndef DJGPP
char link[MAXPATHLEN];
- Tcl_Size length;
- const char *native;
+ int length;
+ CONST char *native;
Tcl_DString ds;
- native = Tcl_UtfToExternalDString(NULL, path, TCL_INDEX_NONE, &ds);
+ native = Tcl_UtfToExternalDString(NULL, path, -1, &ds);
length = readlink(native, link, sizeof(link)); /* INTL: Native. */
Tcl_DStringFree(&ds);
@@ -832,7 +814,7 @@ TclpReadlink(
return Tcl_DStringValue(linkPtr);
#else
return NULL;
-#endif /* !DJGPP */
+#endif
}
/*
@@ -856,25 +838,25 @@ TclpObjStat(
Tcl_Obj *pathPtr, /* Path of file to stat */
Tcl_StatBuf *bufPtr) /* Filled with results of stat call. */
{
- const char *path = (const char *)Tcl_FSGetNativePath(pathPtr);
-
+ CONST char *path = Tcl_FSGetNativePath(pathPtr);
if (path == NULL) {
return -1;
+ } else {
+ return TclOSstat(path, bufPtr);
}
- return TclOSstat(path, bufPtr);
}
#ifdef S_IFLNK
-Tcl_Obj *
+Tcl_Obj*
TclpObjLink(
Tcl_Obj *pathPtr,
Tcl_Obj *toPtr,
int linkAction)
{
if (toPtr != NULL) {
- const char *src = (const char *)Tcl_FSGetNativePath(pathPtr);
- const char *target = NULL;
+ CONST char *src = Tcl_FSGetNativePath(pathPtr);
+ CONST char *target = NULL;
if (src == NULL) {
return NULL;
@@ -919,7 +901,7 @@ TclpObjLink(
Tcl_DecrRefCount(absPtr);
Tcl_DecrRefCount(dirPtr);
} else {
- target = (const char*)Tcl_FSGetNativePath(toPtr);
+ target = Tcl_FSGetNativePath(toPtr);
if (target == NULL) {
return NULL;
}
@@ -947,9 +929,9 @@ TclpObjLink(
*/
if (linkAction & TCL_CREATE_SYMBOLIC_LINK) {
+ int targetLen;
Tcl_DString ds;
Tcl_Obj *transPtr;
- Tcl_Size length;
/*
* Now we don't want to link to the absolute, normalized path.
@@ -961,8 +943,8 @@ TclpObjLink(
if (transPtr == NULL) {
return NULL;
}
- target = TclGetStringFromObj(transPtr, &length);
- target = Tcl_UtfToExternalDString(NULL, target, length, &ds);
+ target = Tcl_GetStringFromObj(transPtr, &targetLen);
+ target = Tcl_UtfToExternalDString(NULL, target, targetLen, &ds);
Tcl_DecrRefCount(transPtr);
if (symlink(target, src) != 0) {
@@ -982,7 +964,7 @@ TclpObjLink(
Tcl_Obj *linkPtr = NULL;
char link[MAXPATHLEN];
- Tcl_Size length;
+ int length;
Tcl_DString ds;
Tcl_Obj *transPtr;
@@ -992,14 +974,18 @@ TclpObjLink(
}
Tcl_DecrRefCount(transPtr);
- length = readlink((const char *)Tcl_FSGetNativePath(pathPtr), link, sizeof(link));
+ length = readlink(Tcl_FSGetNativePath(pathPtr), link, sizeof(link));
if (length < 0) {
return NULL;
}
Tcl_ExternalToUtfDString(NULL, link, length, &ds);
- linkPtr = Tcl_DStringToObj(&ds);
- Tcl_IncrRefCount(linkPtr);
+ linkPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds),
+ Tcl_DStringLength(&ds));
+ Tcl_DStringFree(&ds);
+ if (linkPtr != NULL) {
+ Tcl_IncrRefCount(linkPtr);
+ }
return linkPtr;
}
}
@@ -1026,7 +1012,7 @@ TclpObjLink(
Tcl_Obj *
TclpFilesystemPathType(
- TCL_UNUSED(Tcl_Obj *))
+ Tcl_Obj *pathPtr)
{
/*
* All native paths are of the same type.
@@ -1058,12 +1044,22 @@ TclpFilesystemPathType(
Tcl_Obj *
TclpNativeToNormalized(
- void *clientData)
+ ClientData clientData)
{
Tcl_DString ds;
+ Tcl_Obj *objPtr;
+ int len;
+
+ CONST char *copy;
+ Tcl_ExternalToUtfDString(NULL, (CONST char*)clientData, -1, &ds);
- Tcl_ExternalToUtfDString(NULL, (const char *) clientData, TCL_INDEX_NONE, &ds);
- return Tcl_DStringToObj(&ds);
+ copy = Tcl_DStringValue(&ds);
+ len = Tcl_DStringLength(&ds);
+
+ objPtr = Tcl_NewStringObj(copy,len);
+ Tcl_DStringFree(&ds);
+
+ return objPtr;
}
/*
@@ -1082,15 +1078,15 @@ TclpNativeToNormalized(
*---------------------------------------------------------------------------
*/
-void *
+ClientData
TclNativeCreateNativeRep(
Tcl_Obj *pathPtr)
{
char *nativePathPtr;
- const char *str;
Tcl_DString ds;
Tcl_Obj *validPathPtr;
- Tcl_Size len;
+ int len;
+ char *str;
if (TclFSCwdIsNative()) {
/*
@@ -1115,7 +1111,7 @@ TclNativeCreateNativeRep(
Tcl_IncrRefCount(validPathPtr);
}
- str = TclGetStringFromObj(validPathPtr, &len);
+ str = Tcl_GetStringFromObj(validPathPtr, &len);
Tcl_UtfToExternalDString(NULL, str, len, &ds);
len = Tcl_DStringLength(&ds) + sizeof(char);
if (strlen(Tcl_DStringValue(&ds)) < len - sizeof(char)) {
@@ -1125,11 +1121,11 @@ TclNativeCreateNativeRep(
return NULL;
}
Tcl_DecrRefCount(validPathPtr);
- nativePathPtr = (char *)ckalloc(len);
- memcpy(nativePathPtr, Tcl_DStringValue(&ds), len);
+ nativePathPtr = ckalloc((unsigned) len);
+ memcpy((void*)nativePathPtr, (void*)Tcl_DStringValue(&ds), (size_t) len);
Tcl_DStringFree(&ds);
- return nativePathPtr;
+ return (ClientData)nativePathPtr;
}
/*
@@ -1149,9 +1145,9 @@ TclNativeCreateNativeRep(
*---------------------------------------------------------------------------
*/
-void *
+ClientData
TclNativeDupInternalRep(
- void *clientData)
+ ClientData clientData)
{
char *copy;
size_t len;
@@ -1164,11 +1160,11 @@ TclNativeDupInternalRep(
* ASCII representation when running on Unix.
*/
- len = (strlen((const char*) clientData) + 1) * sizeof(char);
+ len = sizeof(char) + (strlen((CONST char*) clientData) * sizeof(char));
- copy = (char *)ckalloc(len);
- memcpy(copy, clientData, len);
- return copy;
+ copy = (char *) ckalloc(len);
+ memcpy((void *) copy, (void *) clientData, len);
+ return (ClientData)copy;
}
/*
@@ -1192,43 +1188,13 @@ TclpUtime(
Tcl_Obj *pathPtr, /* File to modify */
struct utimbuf *tval) /* New modification date structure */
{
- return utime((const char *)Tcl_FSGetNativePath(pathPtr), tval);
+ return utime(Tcl_FSGetNativePath(pathPtr), tval);
}
-
#ifdef __CYGWIN__
-
-int
-TclOSfstat(
- int fd,
- void *cygstat)
-{
- struct stat buf;
- Tcl_StatBuf *statBuf = (Tcl_StatBuf *)cygstat;
- int result = fstat(fd, &buf);
-
- statBuf->st_mode = buf.st_mode;
- statBuf->st_ino = buf.st_ino;
- statBuf->st_dev = buf.st_dev;
- statBuf->st_rdev = buf.st_rdev;
- statBuf->st_nlink = buf.st_nlink;
- statBuf->st_uid = buf.st_uid;
- statBuf->st_gid = buf.st_gid;
- statBuf->st_size = buf.st_size;
- statBuf->st_atime = buf.st_atime;
- statBuf->st_mtime = buf.st_mtime;
- statBuf->st_ctime = buf.st_ctime;
- return result;
-}
-
-int
-TclOSstat(
- const char *name,
- void *cygstat)
-{
+int TclOSstat(const char *name, void *cygstat) {
struct stat buf;
- Tcl_StatBuf *statBuf = (Tcl_StatBuf *)cygstat;
+ Tcl_StatBuf *statBuf = cygstat;
int result = stat(name, &buf);
-
statBuf->st_mode = buf.st_mode;
statBuf->st_ino = buf.st_ino;
statBuf->st_dev = buf.st_dev;
@@ -1242,16 +1208,10 @@ TclOSstat(
statBuf->st_ctime = buf.st_ctime;
return result;
}
-
-int
-TclOSlstat(
- const char *name,
- void *cygstat)
-{
+int TclOSlstat(const char *name, void *cygstat) {
struct stat buf;
- Tcl_StatBuf *statBuf = (Tcl_StatBuf *)cygstat;
+ Tcl_StatBuf *statBuf = cygstat;
int result = lstat(name, &buf);
-
statBuf->st_mode = buf.st_mode;
statBuf->st_ino = buf.st_ino;
statBuf->st_dev = buf.st_dev;
@@ -1265,7 +1225,7 @@ TclOSlstat(
statBuf->st_ctime = buf.st_ctime;
return result;
}
-#endif /* CYGWIN */
+#endif
/*
* Local Variables:
generated by cgit v0.12 at 2025-12-21 16:41:47 (GMT)