summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--generic/tclExecute.c16
-rw-r--r--generic/tclFileName.c51
-rw-r--r--tests/fileName.test72
-rw-r--r--unix/tclLoadDyld.c12
-rw-r--r--win/tclWinPort.h6
5 files changed, 80 insertions, 77 deletions
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 7a8bf39..be0d932 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -2093,7 +2093,7 @@ TclExecuteByteCode(
PUSH_OBJECT(codePtr->objArrayPtr[TclGetUInt1AtPtr(pc+1)]);
TRACE_WITH_OBJ(("%u => ", TclGetInt1AtPtr(pc+1)), OBJ_AT_TOS);
pc += 2;
-#if !TCL_COMPILE_DEBUG
+#if !defined(TCL_COMPILE_DEBUG)
/*
* Runtime peephole optimisation: check if we are pushing again.
*/
@@ -2124,7 +2124,7 @@ TclExecuteByteCode(
*/
pc++;
-#if !TCL_COMPILE_DEBUG
+#if !defined(TCL_COMPILE_DEBUG)
if (*pc == INST_START_CMD) {
TCL_DTRACE_INST_NEXT();
goto instStartCmdPeephole;
@@ -2134,7 +2134,7 @@ TclExecuteByteCode(
}
case INST_START_CMD:
-#if !TCL_COMPILE_DEBUG
+#if !defined(TCL_COMPILE_DEBUG)
instStartCmdPeephole:
#endif
/*
@@ -2265,7 +2265,7 @@ TclExecuteByteCode(
/* TODO: convert panic to error ? */
Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
}
-#if !TCL_COMPILE_DEBUG
+#if !defined(TCL_COMPILE_DEBUG)
if (bytes != tclEmptyStringRep && !Tcl_IsShared(objResultPtr)) {
TclFreeIntRep(objResultPtr);
objResultPtr->typePtr = NULL;
@@ -2280,7 +2280,7 @@ TclExecuteByteCode(
objResultPtr->bytes = p;
objResultPtr->length = length + appendLen;
currPtr = &OBJ_AT_DEPTH(opnd - 1);
-#if !TCL_COMPILE_DEBUG
+#if !defined(TCL_COMPILE_DEBUG)
}
#endif
@@ -7233,7 +7233,7 @@ TclExecuteByteCode(
Tcl_Obj *valuePtr;
const char *bytes;
int length;
-#if TCL_COMPILE_DEBUG
+#ifdef TCL_COMPILE_DEBUG
int opnd;
#endif
@@ -7244,7 +7244,7 @@ TclExecuteByteCode(
*/
processExceptionReturn:
-#if TCL_COMPILE_DEBUG
+#ifdef TCL_COMPILE_DEBUG
switch (*pc) {
case INST_INVOKE_STK1:
opnd = TclGetUInt1AtPtr(pc+1);
@@ -7302,7 +7302,7 @@ TclExecuteByteCode(
rangePtr->codeOffset, rangePtr->continueOffset));
NEXT_INST_F(0, 0, 0);
}
-#if TCL_COMPILE_DEBUG
+#ifdef TCL_COMPILE_DEBUG
} else if (traceInstructions) {
if ((result != TCL_ERROR) && (result != TCL_RETURN)) {
Tcl_Obj *objPtr = Tcl_GetObjResult(interp);
diff --git a/generic/tclFileName.c b/generic/tclFileName.c
index be1fdfa..b3879f7 100644
--- a/generic/tclFileName.c
+++ b/generic/tclFileName.c
@@ -578,7 +578,7 @@ Tcl_SplitPath(
* plus the argv pointers and the terminating NULL pointer.
*/
- *argvPtr = (const char **) ckalloc((unsigned)
+ *argvPtr = (const char **) ckalloc(
((((*argcPtr) + 1) * sizeof(char *)) + size));
/*
@@ -590,7 +590,7 @@ Tcl_SplitPath(
for (i = 0; i < *argcPtr; i++) {
Tcl_ListObjIndex(NULL, resultPtr, i, &eltPtr);
str = Tcl_GetStringFromObj(eltPtr, &len);
- memcpy(p, str, (size_t) len+1);
+ memcpy(p, str, len + 1);
p += len+1;
}
@@ -636,12 +636,13 @@ SplitUnixPath(
{
int length;
const char *origPath = path, *elementStart;
- Tcl_Obj *result = Tcl_NewObj();
+ Tcl_Obj *result;
/*
* Deal with the root directory as a special case.
*/
+ TclNewObj(result);
if (*path == '/') {
Tcl_Obj *rootElt;
++path;
@@ -727,9 +728,10 @@ SplitWinPath(
const char *p, *elementStart;
Tcl_PathType type = TCL_PATH_ABSOLUTE;
Tcl_DString buf;
- Tcl_Obj *result = Tcl_NewObj();
+ Tcl_Obj *result;
Tcl_DStringInit(&buf);
+ TclNewObj(result);
p = ExtractWinRoot(path, &buf, 0, &type);
/*
@@ -974,7 +976,7 @@ Tcl_JoinPath(
Tcl_DString *resultPtr) /* Pointer to previously initialized DString */
{
int i, len;
- Tcl_Obj *listObj = Tcl_NewObj();
+ Tcl_Obj *listObj;
Tcl_Obj *resultObj;
const char *resultStr;
@@ -982,6 +984,7 @@ Tcl_JoinPath(
* Build the list of paths.
*/
+ TclNewObj(listObj);
for (i = 0; i < argc; i++) {
Tcl_ListObjAppendElement(NULL, listObj,
Tcl_NewStringObj(argv[i], -1));
@@ -1069,7 +1072,7 @@ Tcl_TranslateFileName(
*/
if (tclPlatform == TCL_PLATFORM_WINDOWS) {
- register char *p;
+ char *p;
for (p = Tcl_DStringValue(bufferPtr); *p != '\0'; p++) {
if (*p == '/') {
*p = '\\';
@@ -1212,7 +1215,6 @@ DoTildeSubst(
*----------------------------------------------------------------------
*/
- /* ARGSUSED */
int
Tcl_GlobObjCmd(
ClientData dummy, /* Not used. */
@@ -1230,12 +1232,13 @@ Tcl_GlobObjCmd(
"-directory", "-join", "-nocomplain", "-path", "-tails",
"-types", "--", NULL
};
- enum options {
+ enum globOptionsEnum {
GLOB_DIR, GLOB_JOIN, GLOB_NOCOMPLAIN, GLOB_PATH, GLOB_TAILS,
GLOB_TYPE, GLOB_LAST
};
enum pathDirOptions {PATH_NONE = -1 , PATH_GENERAL = 0, PATH_DIR = 1};
Tcl_GlobTypeData *globTypes = NULL;
+ (void)dummy;
globFlags = 0;
join = 0;
@@ -1263,7 +1266,7 @@ Tcl_GlobObjCmd(
}
}
- switch (index) {
+ switch ((enum globOptionsEnum) index) {
case GLOB_NOCOMPLAIN: /* -nocomplain */
globFlags |= TCL_GLOBMODE_NO_COMPLAIN;
break;
@@ -1275,7 +1278,10 @@ Tcl_GlobObjCmd(
}
if (dir != PATH_NONE) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
- "\"-directory\" cannot be used with \"-path\"", -1));
+ dir == PATH_DIR
+ ? "\"-directory\" may only be used once"
+ : "\"-directory\" cannot be used with \"-path\"",
+ -1));
return TCL_ERROR;
}
dir = PATH_DIR;
@@ -1297,7 +1303,10 @@ Tcl_GlobObjCmd(
}
if (dir != PATH_NONE) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
- "\"-path\" cannot be used with \"-directory\"", -1));
+ dir == PATH_GENERAL
+ ? "\"-path\" may only be used once"
+ : "\"-path\" cannot be used with \"-dictionary\"",
+ -1));
return TCL_ERROR;
}
dir = PATH_GENERAL;
@@ -1334,7 +1343,7 @@ Tcl_GlobObjCmd(
return TCL_ERROR;
}
- separators = NULL; /* lint. */
+ separators = NULL;
switch (tclPlatform) {
case TCL_PLATFORM_UNIX:
separators = "/";
@@ -1439,7 +1448,7 @@ Tcl_GlobObjCmd(
if (length <= 0) {
goto skipTypes;
}
- globTypes = (Tcl_GlobTypeData*)
+ globTypes = (Tcl_GlobTypeData *)
TclStackAlloc(interp,sizeof(Tcl_GlobTypeData));
globTypes->type = 0;
globTypes->perm = 0;
@@ -1666,9 +1675,8 @@ Tcl_GlobObjCmd(
*
* TclGlob --
*
- * This procedure prepares arguments for the DoGlob call. It sets the
- * separator string based on the platform, performs * tilde substitution,
- * and calls DoGlob.
+ * Sets the separator string based on the platform, performs tilde
+ * substitution, and calls DoGlob.
*
* The interpreter's result, on entry to this function, must be a valid
* Tcl list (e.g. it could be empty), since we will lappend any new
@@ -1691,7 +1699,6 @@ Tcl_GlobObjCmd(
*----------------------------------------------------------------------
*/
- /* ARGSUSED */
int
TclGlob(
Tcl_Interp *interp, /* Interpreter for returning error message or
@@ -1710,7 +1717,7 @@ TclGlob(
int result;
Tcl_Obj *filenamesObj, *savedResultObj;
- separators = NULL; /* lint. */
+ separators = NULL;
switch (tclPlatform) {
case TCL_PLATFORM_UNIX:
separators = "/";
@@ -1891,7 +1898,7 @@ TclGlob(
}
/*
- * To process a [glob] invokation, this function may be called multiple
+ * To process a [glob] invocation, this function may be called multiple
* times. Each time, the previously discovered filenames are in the
* interpreter result. We stash that away here so the result is free for
* error messsages.
@@ -2045,7 +2052,7 @@ TclGlob(
* SkipToChar --
*
* This function traverses a glob pattern looking for the next unquoted
- * occurance of the specified character at the same braces nesting level.
+ * occurrence of the specified character at the same braces nesting level.
*
* Results:
* Updates stringPtr to point to the matching character, or to the end of
@@ -2064,7 +2071,7 @@ SkipToChar(
int match) /* Character to find. */
{
int quoted, level;
- register char *p;
+ char *p;
quoted = 0;
level = 0;
@@ -2507,7 +2514,7 @@ DoGlob(
Tcl_StatBuf *
Tcl_AllocStatBuf(void)
{
- return (Tcl_StatBuf *) ckalloc(sizeof(Tcl_StatBuf));
+ return (Tcl_StatBuf *)ckalloc(sizeof(Tcl_StatBuf));
}
/*
diff --git a/tests/fileName.test b/tests/fileName.test
index 3747fc9..aecca46 100644
--- a/tests/fileName.test
+++ b/tests/fileName.test
@@ -25,6 +25,7 @@ if {[testConstraint win]} {
testConstraint linkDirectory 0
}
testConstraint symbolicLinkFile 0
+ testConstraint sharedCdrive [expr {![catch {cd //[info hostname]/c}]}]
}
global env
@@ -210,11 +211,9 @@ test filename-4.18 {Tcl_SplitPath: unix} {testsetplatform} {
testsetplatform unix
file split foo/bar~/baz
} {foo bar~ baz}
-
if {[testConstraint testsetplatform]} {
testsetplatform $platform
}
-
test filename-4.19 {Tcl_SplitPath} {
set oldDir [pwd]
set res [catch {
@@ -438,7 +437,6 @@ test filename-7.19 {[Bug f34cf83dd0]} {
file join foo //bar
} /bar
-
test filename-9.1 {Tcl_JoinPath: win} {testsetplatform} {
testsetplatform win
file join a b
@@ -515,25 +513,25 @@ test filename-9.19 {Tcl_JoinPath: win} {testsetplatform} {
testsetplatform win
set res {}
lappend res \
- [file join {C:\foo\bar}] \
- [file join C:/blah {C:\foo\bar}] \
- [file join C:/blah C:/blah {C:\foo\bar}]
+ [file join {C:\foo\bar}] \
+ [file join C:/blah {C:\foo\bar}] \
+ [file join C:/blah C:/blah {C:\foo\bar}]
} {C:/foo/bar C:/foo/bar C:/foo/bar}
test filename-9.19.1 {Tcl_JoinPath: win} {testsetplatform} {
testsetplatform win
set res {}
lappend res \
- [file join {foo\bar}] \
- [file join C:/blah {foo\bar}] \
- [file join C:/blah C:/blah {foo\bar}]
+ [file join {foo\bar}] \
+ [file join C:/blah {foo\bar}] \
+ [file join C:/blah C:/blah {foo\bar}]
} {foo/bar C:/blah/foo/bar C:/blah/foo/bar}
test filename-9.19.2 {Tcl_JoinPath: win} {testsetplatform win} {
testsetplatform win
set res {}
lappend res \
- [file join {foo\bar}] \
- [file join [pwd] {foo\bar}] \
- [file join [pwd] [pwd] {foo\bar}]
+ [file join {foo\bar}] \
+ [file join [pwd] {foo\bar}] \
+ [file join [pwd] [pwd] {foo\bar}]
set nres {}
foreach elt $res {
lappend nres [string map [list [pwd] pwd] $elt]
@@ -544,26 +542,26 @@ test filename-9.20 {Tcl_JoinPath: unix} {testsetplatform} {
testsetplatform unix
set res {}
lappend res \
- [file join {/foo/bar}] \
- [file join /x {/foo/bar}] \
- [file join /x /x {/foo/bar}]
+ [file join {/foo/bar}] \
+ [file join /x {/foo/bar}] \
+ [file join /x /x {/foo/bar}]
} {/foo/bar /foo/bar /foo/bar}
test filename-9.23 {Tcl_JoinPath: win} {testsetplatform} {
testsetplatform win
set res {}
lappend res \
- [file join {foo\bar}] \
- [file join C:/blah {foo\bar}] \
- [file join C:/blah C:/blah {foo\bar}]
+ [file join {foo\bar}] \
+ [file join C:/blah {foo\bar}] \
+ [file join C:/blah C:/blah {foo\bar}]
string map [list C:/blah ""] $res
} {foo/bar /foo/bar /foo/bar}
test filename-9.24 {Tcl_JoinPath: unix} {testsetplatform} {
testsetplatform unix
set res {}
lappend res \
- [file join {foo/bar}] \
- [file join /x {foo/bar}] \
- [file join /x /x {foo/bar}]
+ [file join {foo/bar}] \
+ [file join /x {foo/bar}] \
+ [file join /x /x {foo/bar}]
string map [list /x ""] $res
} {foo/bar /foo/bar /foo/bar}
@@ -1110,6 +1108,12 @@ test filename-11.48 {Tcl_GlobCmd} {
test filename-11.49 {Tcl_GlobCmd} {
list [catch {glob -types abcde -path foo -join * *} msg] $msg
} {1 {bad argument to "-types": abcde}}
+test filename-11.50 {Tcl_GlobCmd} -returnCodes error -body {
+ glob -path hello -path salut *
+} -result {"-path" may only be used once}
+test filename-11.51 {Tcl_GlobCmd} -returnCodes error -body {
+ glob -dir hello -dir salut *
+} -result {"-directory" may only be used once}
file rename $horribleglobname globTest
file delete -force $tildeglobname
@@ -1493,13 +1497,7 @@ test filename-16.10 {windows specific globbing} {win} {
test filename-16.11 {windows specific globbing} {win} {
lsort [glob -nocomplain c:\\\\globTest\\\\*.bat]
} {c:/globTest/x1.BAT c:/globTest/y1.Bat c:/globTest/z1.bat}
-
# some tests require a shared C drive
-
-if {[testConstraint win]} {
- testConstraint sharedCdrive [expr {![catch {cd //[info hostname]/c}]}]
-}
-
test filename-16.12 {windows specific globbing} {win sharedCdrive} {
cd //[info hostname]/c
glob //[info hostname]/c/*Test
@@ -1540,8 +1538,8 @@ if {[testConstraint win]} {
test filename-17.1 {windows specific special files} {testsetplatform} {
testsetplatform win
list [file pathtype com1] [file pathtype con] [file pathtype lpt3] \
- [file pathtype prn] [file pathtype nul] [file pathtype aux] \
- [file pathtype foo]
+ [file pathtype prn] [file pathtype nul] [file pathtype aux] \
+ [file pathtype foo]
} {absolute absolute absolute absolute absolute absolute relative}
if {[testConstraint testsetplatform]} {
testsetplatform $platform
@@ -1613,7 +1611,6 @@ test fileName-20.4 {Bug 1750300} -setup {
removeFile TAGS $d
removeDirectory foo
} -result 0
-
test fileName-20.5 {Bug 2837800} -setup {
set dd [makeDirectory isolate]
set d [makeDirectory ./~foo $dd]
@@ -1628,7 +1625,6 @@ test fileName-20.5 {Bug 2837800} -setup {
removeDirectory ./~foo $dd
removeDirectory isolate
} -result ~foo/test
-
test fileName-20.6 {Bug 2837800} -setup {
# Recall that we have $env(HOME) set so that references
# to ~ point to [temporaryDirectory]
@@ -1645,7 +1641,6 @@ test fileName-20.6 {Bug 2837800} -setup {
removeDirectory isolate
removeFile test ~
} -result {}
-
test fileName-20.7 {Bug 2806250} -setup {
set savewd [pwd]
cd [temporaryDirectory]
@@ -1658,7 +1653,6 @@ test fileName-20.7 {Bug 2806250} -setup {
removeDirectory isolate
cd $savewd
} -result 1
-
test fileName-20.8 {Bug 2806250} -setup {
set savewd [pwd]
cd [temporaryDirectory]
@@ -1671,8 +1665,7 @@ test fileName-20.8 {Bug 2806250} -setup {
removeDirectory isolate
cd $savewd
} -result ./~test
-
-test fileName-20.9 {} -setup {
+test fileName-20.9 {globbing for special chars} -setup {
makeFile {} test ~
set d [makeDirectory isolate]
set savewd [pwd]
@@ -1684,8 +1677,7 @@ test fileName-20.9 {} -setup {
removeDirectory isolate
removeFile test ~
} -result ~/test
-
-test fileName-20.10 {} -setup {
+test fileName-20.10 {globbing for special chars} -setup {
set s [makeDirectory sub ~]
makeFile {} fileName-20.10 $s
set d [makeDirectory isolate]
@@ -1699,7 +1691,7 @@ test fileName-20.10 {} -setup {
removeFile fileName-20.10 $s
removeDirectory sub ~
} -result ~/sub/fileName-20.10
-
+
# cleanup
catch {file delete -force C:/globTest}
cd [temporaryDirectory]
@@ -1713,3 +1705,7 @@ if {[testConstraint testsetplatform]} {
catch {unset oldhome temp result globPreResult}
::tcltest::cleanupTests
return
+
+# Local Variables:
+# mode: tcl
+# End:
diff --git a/unix/tclLoadDyld.c b/unix/tclLoadDyld.c
index 0a36215..c71727d 100644
--- a/unix/tclLoadDyld.c
+++ b/unix/tclLoadDyld.c
@@ -633,14 +633,14 @@ TclpLoadMemory(
uint32_t ms = 0;
#ifndef __LP64__
const struct mach_header *mh = NULL;
- #define mh_size sizeof(struct mach_header)
- #define mh_magic MH_MAGIC
- #define arch_abi 0
+# define mh_size sizeof(struct mach_header)
+# define mh_magic MH_MAGIC
+# define arch_abi 0
#else
const struct mach_header_64 *mh = NULL;
- #define mh_size sizeof(struct mach_header_64)
- #define mh_magic MH_MAGIC_64
- #define arch_abi CPU_ARCH_ABI64
+# define mh_size sizeof(struct mach_header_64)
+# define mh_magic MH_MAGIC_64
+# define arch_abi CPU_ARCH_ABI64
#endif
if ((size_t) codeSize >= sizeof(struct fat_header)
diff --git a/win/tclWinPort.h b/win/tclWinPort.h
index 056c7c8..d3dbb1b 100644
--- a/win/tclWinPort.h
+++ b/win/tclWinPort.h
@@ -211,7 +211,7 @@ typedef DWORD_PTR * PDWORD_PTR;
* defined in header files above.
*/
-#if TCL_UNION_WAIT
+#ifdef TCL_UNION_WAIT
# define WAIT_STATUS_TYPE union wait
#else
# define WAIT_STATUS_TYPE int
@@ -339,10 +339,10 @@ typedef DWORD_PTR * PDWORD_PTR;
* Define pid_t and uid_t if they're not already defined.
*/
-#if ! TCL_PID_T
+#if !defined(TCL_PID_T)
# define pid_t int
#endif /* !TCL_PID_T */
-#if ! TCL_UID_T
+#if !defined(TCL_UID_T)
# define uid_t int
#endif /* !TCL_UID_T */
generated by cgit v0.12 at 2025-08-09 05:46:25 (GMT)