summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorjan.nijtmans <nijtmans@users.sourceforge.net>2018-02-22 21:17:14 (GMT)
committerjan.nijtmans <nijtmans@users.sourceforge.net>2018-02-22 21:17:14 (GMT)
commit07448025782175253319b1330ea0a1ab3cb0b5d0 (patch)
treea65b45bbea287fe45c91962dfd9e855ef5037f50
parentcb2f9cccfbc8007a93a1010bbabe4614939b94a2 (diff)
parentf5bf130f05e3dcf636ef831f017d5672c594660a (diff)
downloadtcl-07448025782175253319b1330ea0a1ab3cb0b5d0.zip
tcl-07448025782175253319b1330ea0a1ab3cb0b5d0.tar.gz
tcl-07448025782175253319b1330ea0a1ab3cb0b5d0.tar.bz2
merge trunk
-rw-r--r--doc/IntObj.32
-rw-r--r--doc/format.n31
-rw-r--r--generic/tcl.decls56
-rw-r--r--generic/tcl.h42
-rw-r--r--generic/tclAlloc.c10
-rw-r--r--generic/tclCkalloc.c28
-rw-r--r--generic/tclCmdMZ.c6
-rw-r--r--generic/tclCompExpr.c16
-rw-r--r--generic/tclDecls.h80
-rw-r--r--generic/tclDisassemble.c12
-rw-r--r--generic/tclExecute.c54
-rw-r--r--generic/tclGet.c2
-rw-r--r--generic/tclInt.h17
-rw-r--r--generic/tclObj.c431
-rw-r--r--generic/tclScan.c21
-rw-r--r--generic/tclStringObj.c98
-rw-r--r--generic/tclStubInit.c16
-rw-r--r--generic/tclTest.c6
-rw-r--r--generic/tclThreadTest.c4
-rw-r--r--generic/tclUtil.c2
-rw-r--r--generic/tclVar.c4
-rw-r--r--tests/chanio.test4
-rw-r--r--tests/expr.test9
-rw-r--r--tests/format.test34
-rw-r--r--tests/io.test4
-rw-r--r--tests/scan.test4
-rw-r--r--tests/unixFCmd.test14
-rwxr-xr-xunix/configure42
-rw-r--r--unix/tcl.m49
-rw-r--r--unix/tclConfig.h.in2
-rw-r--r--win/nmakehlp.c29
-rw-r--r--win/tclWinChan.c2
-rw-r--r--win/tclWinConsole.c2
-rw-r--r--win/tclWinInt.h6
-rw-r--r--win/tclWinPipe.c2
-rw-r--r--win/tclWinSerial.c2
36 files changed, 331 insertions, 772 deletions
diff --git a/doc/IntObj.3 b/doc/IntObj.3
index 2acb446..6d5ee69 100644
--- a/doc/IntObj.3
+++ b/doc/IntObj.3
@@ -97,7 +97,7 @@ are provided by the C language standard. The \fBTcl_WideInt\fR type is a
typedef defined to be whatever signed integral type covers at least the
64-bit integer range (-9223372036854775808 to 9223372036854775807). Depending
on the platform and the C compiler, the actual type might be
-\fBlong int\fR, \fBlong long int\fR, \fB__int64\fR, or something else.
+\fBlong long int\fR, \fB__int64\fR, or something else.
The \fBmp_int\fR type is a multiple-precision integer type defined
by the LibTomMath multiple-precision integer library.
.PP
diff --git a/doc/format.n b/doc/format.n
index 6f5f7bd..eb64491 100644
--- a/doc/format.n
+++ b/doc/format.n
@@ -83,14 +83,15 @@ Specifies that the number should be padded on the left with
zeroes instead of spaces.
.TP 10
\fB#\fR
-Requests an alternate output form. For \fBo\fR
-conversions it guarantees that the first digit is always \fB0\fR.
-For \fBx\fR or \fBX\fR conversions, \fB0x\fR or \fB0X\fR (respectively)
+Requests an alternate output form. For \fBo\fR conversions,
+\fB0o\fR will be added to the beginning of the result unless
+it is zero. For \fBx\fR or \fBX\fR conversions, \fB0x\fR
will be added to the beginning of the result unless it is zero.
For \fBb\fR conversions, \fB0b\fR
will be added to the beginning of the result unless it is zero.
-For \fBd\fR conversions, \fB0d\fR will be added to the beginning
-of the result unless it is zero.
+For \fBd\fR conversions, \fB0d\fR there is no effect unless
+the \fB0\fR specifier is used as well: In that case, \fB0d\fR
+will be added to the beginning.
For all floating-point conversions (\fBe\fR, \fBE\fR, \fBf\fR,
\fBg\fR, and \fBG\fR) it guarantees that the result always
has a decimal point.
@@ -132,7 +133,7 @@ it must be a numeric string.
.SS "OPTIONAL SIZE MODIFIER"
.PP
The fifth part of a conversion specifier is a size modifier,
-which must be \fBll\fR, \fBh\fR, or \fBl\fR.
+which must be \fBll\fR, \fBh\fR, \fBl\fR, or \fBL\fR.
If it is \fBll\fR it specifies that an integer value is taken
without truncation for conversion to a formatted substring.
If it is \fBh\fR it specifies that an integer value is
@@ -140,7 +141,9 @@ truncated to a 16-bit range before converting. This option is rarely useful.
If it is \fBl\fR it specifies that the integer value is
truncated to the same range as that produced by the \fBwide()\fR
function of the \fBexpr\fR command (at least a 64-bit range).
-If neither \fBh\fR nor \fBl\fR are present, the integer value is
+If it is \fBL\fR it specifies that an integer or double value is taken
+without truncation for conversion to a formatted substring.
+If neither \fBh\fR nor \fBl\fR nor \fBL\fR are present, the integer value is
truncated to the same range as that produced by the \fBint()\fR
function of the \fBexpr\fR command (at least a 32-bit range, but
determined by the value of the \fBwordSize\fR element of the
@@ -200,8 +203,19 @@ precision, then convert number as for \fB%e\fR or
Otherwise convert as for \fB%f\fR.
Trailing zeroes and a trailing decimal point are omitted.
.TP 10
+\fBa\fR or \fBA\fR
+Convert double to hexadecimal notation in the form
+\fI0x1.yyy\fBp\(+-\fIzz\fR, where the number of \fIy\fR's is
+determined by the precision (default: 13).
+If the \fBA\fR form is used then the hex characters
+are printed in uppercase.
+.TP 10
\fB%\fR
No conversion: just insert \fB%\fR.
+.TP 10
+\fBp\fR
+Shorthand form for \fB0x%zx\fR, so it outputs the integer in
+hexadecimal form with \fB0x\fR prefix.
.SH "DIFFERENCES FROM ANSI SPRINTF"
.PP
The behavior of the format command is the same as the
@@ -210,13 +224,12 @@ differences:
.IP [1]
Tcl guarantees that it will be working with UNICODE characters.
.IP [2]
-\fB%p\fR and \fB%n\fR specifiers are not supported.
+\fB%n\fR specifier is not supported.
.IP [3]
For \fB%c\fR conversions the argument must be an integer value,
which will then be converted to the corresponding character value.
.IP [4]
The size modifiers are ignored when formatting floating-point values.
-The \fBll\fR modifier has no \fBsprintf\fR counterpart.
The \fBb\fR specifier has no \fBsprintf\fR counterpart.
.SH EXAMPLES
.PP
diff --git a/generic/tcl.decls b/generic/tcl.decls
index d19e722..dcc80a8 100644
--- a/generic/tcl.decls
+++ b/generic/tcl.decls
@@ -104,9 +104,10 @@ declare 20 {
declare 21 {
int Tcl_DbIsShared(Tcl_Obj *objPtr, const char *file, int line)
}
-declare 22 {
- Tcl_Obj *Tcl_DbNewBooleanObj(int boolValue, const char *file, int line)
-}
+# Removed in 9.0 (changed to macro):
+#declare 22 {
+# Tcl_Obj *Tcl_DbNewBooleanObj(int boolValue, const char *file, int line)
+#}
declare 23 {
Tcl_Obj *Tcl_DbNewByteArrayObj(const unsigned char *bytes, int length,
const char *file, int line)
@@ -119,9 +120,10 @@ declare 25 {
Tcl_Obj *Tcl_DbNewListObj(int objc, Tcl_Obj *const *objv,
const char *file, int line)
}
-declare 26 {
- Tcl_Obj *Tcl_DbNewLongObj(long longValue, const char *file, int line)
-}
+# Removed in 9.0 (changed to macro):
+#declare 26 {
+# Tcl_Obj *Tcl_DbNewLongObj(long longValue, const char *file, int line)
+#}
declare 27 {
Tcl_Obj *Tcl_DbNewObj(const char *file, int line)
}
@@ -198,33 +200,37 @@ declare 48 {
int Tcl_ListObjReplace(Tcl_Interp *interp, Tcl_Obj *listPtr, int first,
int count, int objc, Tcl_Obj *const objv[])
}
-declare 49 {
- Tcl_Obj *Tcl_NewBooleanObj(int boolValue)
-}
+# Removed in 9.0 (changed to macro):
+#declare 49 {
+# Tcl_Obj *Tcl_NewBooleanObj(int boolValue)
+#}
declare 50 {
Tcl_Obj *Tcl_NewByteArrayObj(const unsigned char *bytes, int length)
}
declare 51 {
Tcl_Obj *Tcl_NewDoubleObj(double doubleValue)
}
-declare 52 {
- Tcl_Obj *Tcl_NewIntObj(int intValue)
-}
+# Removed in 9.0 (changed to macro):
+#declare 52 {
+# Tcl_Obj *Tcl_NewIntObj(int intValue)
+#}
declare 53 {
Tcl_Obj *Tcl_NewListObj(int objc, Tcl_Obj *const objv[])
}
-declare 54 {
- Tcl_Obj *Tcl_NewLongObj(long longValue)
-}
+# Removed in 9.0 (changed to macro):
+#declare 54 {
+# Tcl_Obj *Tcl_NewLongObj(long longValue)
+#}
declare 55 {
Tcl_Obj *Tcl_NewObj(void)
}
declare 56 {
Tcl_Obj *Tcl_NewStringObj(const char *bytes, int length)
}
-declare 57 {
- void Tcl_SetBooleanObj(Tcl_Obj *objPtr, int boolValue)
-}
+# Removed in 9.0 (changed to macro):
+#declare 57 {
+# void Tcl_SetBooleanObj(Tcl_Obj *objPtr, int boolValue)
+#}
declare 58 {
unsigned char *Tcl_SetByteArrayLength(Tcl_Obj *objPtr, size_t length)
}
@@ -235,15 +241,17 @@ declare 59 {
declare 60 {
void Tcl_SetDoubleObj(Tcl_Obj *objPtr, double doubleValue)
}
-declare 61 {
- void Tcl_SetIntObj(Tcl_Obj *objPtr, int intValue)
-}
+# Removed in 9.0 (changed to macro):
+#declare 61 {
+# void Tcl_SetIntObj(Tcl_Obj *objPtr, int intValue)
+#}
declare 62 {
void Tcl_SetListObj(Tcl_Obj *objPtr, int objc, Tcl_Obj *const objv[])
}
-declare 63 {
- void Tcl_SetLongObj(Tcl_Obj *objPtr, long longValue)
-}
+# Removed in 9.0 (changed to macro):
+#declare 63 {
+# void Tcl_SetLongObj(Tcl_Obj *objPtr, long longValue)
+#}
declare 64 {
void Tcl_SetObjLength(Tcl_Obj *objPtr, size_t length)
}
diff --git a/generic/tcl.h b/generic/tcl.h
index d4450e5..088ced6 100644
--- a/generic/tcl.h
+++ b/generic/tcl.h
@@ -278,44 +278,40 @@ typedef void *ClientData;
# if defined(_WIN32)
# define TCL_WIDE_INT_TYPE __int64
# define TCL_LL_MODIFIER "I64"
+# if defined(_WIN64)
+# define TCL_Z_MODIFIER "I"
+# endif
# elif defined(__GNUC__)
-# define TCL_WIDE_INT_TYPE long long
-# define TCL_LL_MODIFIER "ll"
+# define TCL_Z_MODIFIER "z"
# else /* ! _WIN32 && ! __GNUC__ */
/*
* Don't know what platform it is and configure hasn't discovered what is
* going on for us. Try to guess...
*/
# include <limits.h>
-# if (INT_MAX < LONG_MAX)
+# if defined(LLONG_MAX) && (LLONG_MAX == LONG_MAX)
# define TCL_WIDE_INT_IS_LONG 1
-# else
-# define TCL_WIDE_INT_TYPE long long
# endif
# endif /* _WIN32 */
#endif /* !TCL_WIDE_INT_TYPE & !TCL_WIDE_INT_IS_LONG */
-#ifdef TCL_WIDE_INT_IS_LONG
-# undef TCL_WIDE_INT_TYPE
-# define TCL_WIDE_INT_TYPE long
-#endif /* TCL_WIDE_INT_IS_LONG */
+
+#ifndef TCL_WIDE_INT_TYPE
+# define TCL_WIDE_INT_TYPE long long
+#endif /* !TCL_WIDE_INT_TYPE */
typedef TCL_WIDE_INT_TYPE Tcl_WideInt;
typedef unsigned TCL_WIDE_INT_TYPE Tcl_WideUInt;
-#ifdef TCL_WIDE_INT_IS_LONG
-# ifndef TCL_LL_MODIFIER
-# define TCL_LL_MODIFIER "l"
-# endif /* !TCL_LL_MODIFIER */
-#else /* TCL_WIDE_INT_IS_LONG */
-/*
- * The next short section of defines are only done when not running on Windows
- * or some other strange platform.
- */
-# ifndef TCL_LL_MODIFIER
-# define TCL_LL_MODIFIER "ll"
-# endif /* !TCL_LL_MODIFIER */
-#endif /* TCL_WIDE_INT_IS_LONG */
-
+#ifndef TCL_LL_MODIFIER
+# define TCL_LL_MODIFIER "ll"
+#endif /* !TCL_LL_MODIFIER */
+#ifndef TCL_Z_MODIFIER
+# if defined(__GNUC__) && !defined(_WIN32)
+# define TCL_Z_MODIFIER "z"
+# else
+# define TCL_Z_MODIFIER ""
+# endif
+#endif /* !TCL_Z_MODIFIER */
#define Tcl_WideAsLong(val) ((long)((Tcl_WideInt)(val)))
#define Tcl_LongAsWide(val) ((Tcl_WideInt)((long)(val)))
#define Tcl_WideAsDouble(val) ((double)((Tcl_WideInt)(val)))
diff --git a/generic/tclAlloc.c b/generic/tclAlloc.c
index 74448b4..a3cb35f 100644
--- a/generic/tclAlloc.c
+++ b/generic/tclAlloc.c
@@ -661,14 +661,14 @@ mstats(
fprintf(stderr, "\nused:\t");
for (i = 0; i < NBUCKETS; i++) {
- fprintf(stderr, " %" TCL_LL_MODIFIER "d", (Tcl_WideInt)numMallocs[i]);
+ fprintf(stderr, " %" TCL_Z_MODIFIER "u", numMallocs[i]);
totalUsed += numMallocs[i] * (1 << (i + 3));
}
- fprintf(stderr, "\n\tTotal small in use: %" TCL_LL_MODIFIER "d, total free: %" TCL_LL_MODIFIER "d\n",
- (Tcl_WideInt)totalUsed, (Tcl_WideInt)totalFree);
- fprintf(stderr, "\n\tNumber of big (>%d) blocks in use: %" TCL_LL_MODIFIER "d\n",
- MAXMALLOC, (Tcl_WideInt)numMallocs[NBUCKETS]);
+ fprintf(stderr, "\n\tTotal small in use: %" TCL_Z_MODIFIER "u, total free: %" TCL_Z_MODIFIER "u\n",
+ totalUsed, totalFree);
+ fprintf(stderr, "\n\tNumber of big (>%d) blocks in use: %" TCL_Z_MODIFIER "u\n",
+ MAXMALLOC, numMallocs[NBUCKETS]);
Tcl_MutexUnlock(allocMutexPtr);
}
diff --git a/generic/tclCkalloc.c b/generic/tclCkalloc.c
index 8bea75b..982afb4 100644
--- a/generic/tclCkalloc.c
+++ b/generic/tclCkalloc.c
@@ -185,15 +185,15 @@ TclDumpMemoryInfo(
"total mallocs %10u\n"
"total frees %10u\n"
"current packets allocated %10u\n"
- "current bytes allocated %10" TCL_LL_MODIFIER "u\n"
+ "current bytes allocated %10" TCL_Z_MODIFIER "u\n"
"maximum packets allocated %10u\n"
- "maximum bytes allocated %10" TCL_LL_MODIFIER "u\n",
+ "maximum bytes allocated %10" TCL_Z_MODIFIER "u\n",
total_mallocs,
total_frees,
current_malloc_packets,
- (Tcl_WideInt)current_bytes_malloced,
+ current_bytes_malloced,
maximum_malloc_packets,
- (Tcl_WideInt)maximum_bytes_malloced);
+ maximum_bytes_malloced);
if (flags == 0) {
fprintf((FILE *)clientData, "%s", buf);
} else {
@@ -252,7 +252,7 @@ ValidateMemory(
fprintf(stderr, "low guard failed at %p, %s %d\n",
memHeaderP->body, file, line);
fflush(stderr); /* In case name pointer is bad. */
- fprintf(stderr, "%" TCL_LL_MODIFIER "d bytes allocated at (%s %d)\n", (Tcl_WideInt) memHeaderP->length,
+ fprintf(stderr, "%" TCL_Z_MODIFIER "u bytes allocated at (%s %d)\n", memHeaderP->length,
memHeaderP->file, memHeaderP->line);
Tcl_Panic("Memory validation failure");
}
@@ -274,8 +274,8 @@ ValidateMemory(
fprintf(stderr, "high guard failed at %p, %s %d\n",
memHeaderP->body, file, line);
fflush(stderr); /* In case name pointer is bad. */
- fprintf(stderr, "%" TCL_LL_MODIFIER "d bytes allocated at (%s %d)\n",
- (Tcl_WideInt)memHeaderP->length, memHeaderP->file,
+ fprintf(stderr, "%" TCL_Z_MODIFIER "u bytes allocated at (%s %d)\n",
+ memHeaderP->length, memHeaderP->file,
memHeaderP->line);
Tcl_Panic("Memory validation failure");
}
@@ -357,9 +357,9 @@ Tcl_DumpActiveMemory(
Tcl_MutexLock(ckallocMutexPtr);
for (memScanP = allocHead; memScanP != NULL; memScanP = memScanP->flink) {
address = &memScanP->body[0];
- fprintf(fileP, "%p - %p %" TCL_LL_MODIFIER "d @ %s %d %s",
+ fprintf(fileP, "%p - %p %" TCL_Z_MODIFIER "u @ %s %d %s",
address, address + memScanP->length - 1,
- (Tcl_WideInt)memScanP->length, memScanP->file, memScanP->line,
+ memScanP->length, memScanP->file, memScanP->line,
(memScanP->tagPtr == NULL) ? "" : memScanP->tagPtr->string);
(void) fputc('\n', fileP);
}
@@ -609,8 +609,8 @@ Tcl_DbCkfree(
memp = (struct mem_header *) (((size_t) ptr) - BODY_OFFSET);
if (alloc_tracing) {
- fprintf(stderr, "ckfree %p %" TCL_LL_MODIFIER "d %s %d\n",
- memp->body, (Tcl_WideInt) memp->length, file, line);
+ fprintf(stderr, "ckfree %p %" TCL_Z_MODIFIER "u %s %d\n",
+ memp->body, memp->length, file, line);
}
if (validate_memory) {
@@ -804,12 +804,12 @@ MemoryCmd(
}
if (strcmp(argv[1],"info") == 0) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "%-25s %10u\n%-25s %10u\n%-25s %10u\n%-25s %10" TCL_LL_MODIFIER"d\n%-25s %10u\n%-25s %10" TCL_LL_MODIFIER "d\n",
+ "%-25s %10u\n%-25s %10u\n%-25s %10u\n%-25s %10" TCL_Z_MODIFIER"u\n%-25s %10u\n%-25s %10" TCL_Z_MODIFIER "u\n",
"total mallocs", total_mallocs, "total frees", total_frees,
"current packets allocated", current_malloc_packets,
- "current bytes allocated", (Tcl_WideInt)current_bytes_malloced,
+ "current bytes allocated", current_bytes_malloced,
"maximum packets allocated", maximum_malloc_packets,
- "maximum bytes allocated", (Tcl_WideInt)maximum_bytes_malloced));
+ "maximum bytes allocated", maximum_bytes_malloced));
return TCL_OK;
}
if (strcmp(argv[1], "init") == 0) {
diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c
index cc17c05..ffa3fb5 100644
--- a/generic/tclCmdMZ.c
+++ b/generic/tclCmdMZ.c
@@ -1572,10 +1572,8 @@ StringIsCmd(
string1 = TclGetStringFromObj(objPtr, &length1);
result = length1 == 0;
}
- } else if (((index == STR_IS_TRUE) &&
- objPtr->internalRep.longValue == 0)
- || ((index == STR_IS_FALSE) &&
- objPtr->internalRep.longValue != 0)) {
+ } else if ((objPtr->internalRep.wideValue != 0)
+ ? (index == STR_IS_FALSE) : (index == STR_IS_TRUE)) {
result = 0;
}
break;
diff --git a/generic/tclCompExpr.c b/generic/tclCompExpr.c
index b5802b0..7792857 100644
--- a/generic/tclCompExpr.c
+++ b/generic/tclCompExpr.c
@@ -702,12 +702,12 @@ ParseExpr(
switch (lexeme) {
case INVALID:
msg = Tcl_ObjPrintf("invalid character \"%.*s\"",
- scanned, start);
+ (int)scanned, start);
errCode = "BADCHAR";
goto error;
case INCOMPLETE:
msg = Tcl_ObjPrintf("incomplete operator \"%.*s\"",
- scanned, start);
+ (int)scanned, start);
errCode = "PARTOP";
goto error;
case BAREWORD:
@@ -736,16 +736,16 @@ ParseExpr(
} else {
Tcl_DecrRefCount(literal);
msg = Tcl_ObjPrintf("invalid bareword \"%.*s%s\"",
- (scanned < limit) ? scanned : limit - 3, start,
+ (scanned < limit) ? (int)scanned : limit - 3, start,
(scanned < limit) ? "" : "...");
post = Tcl_ObjPrintf(
"should be \"$%.*s%s\" or \"{%.*s%s}\"",
- (scanned < limit) ? scanned : limit - 3,
+ (scanned < limit) ? (int)scanned : limit - 3,
start, (scanned < limit) ? "" : "...",
- (scanned < limit) ? scanned : limit - 3,
+ (scanned < limit) ? (int)scanned : limit - 3,
start, (scanned < limit) ? "" : "...");
Tcl_AppendPrintfToObj(post, " or \"%.*s%s(...)\" or ...",
- (scanned < limit) ? scanned : limit - 3,
+ (scanned < limit) ? (int)scanned : limit - 3,
start, (scanned < limit) ? "" : "...");
errCode = "BAREWORD";
if (start[0] == '0') {
@@ -1409,10 +1409,10 @@ ParseExpr(
? (int) (start - parsePtr->string) : (int)limit - 3,
((start - limit) < parsePtr->string)
? parsePtr->string : start - limit + 3,
- (scanned < limit) ? scanned : limit - 3, start,
+ (scanned < limit) ? (int)scanned : limit - 3, start,
(scanned < limit) ? "" : "...", insertMark ? mark : "",
(start + scanned + limit > parsePtr->end)
- ? (int) (parsePtr->end - start) - scanned : limit-3,
+ ? (int) (parsePtr->end - start) - (int)scanned : limit-3,
start + scanned,
(start + scanned + limit > parsePtr->end) ? "" : "...");
diff --git a/generic/tclDecls.h b/generic/tclDecls.h
index 1fd4f3a..48d2e06 100644
--- a/generic/tclDecls.h
+++ b/generic/tclDecls.h
@@ -118,9 +118,7 @@ EXTERN void Tcl_DbIncrRefCount(Tcl_Obj *objPtr, const char *file,
/* 21 */
EXTERN int Tcl_DbIsShared(Tcl_Obj *objPtr, const char *file,
int line);
-/* 22 */
-EXTERN Tcl_Obj * Tcl_DbNewBooleanObj(int boolValue, const char *file,
- int line);
+/* Slot 22 is reserved */
/* 23 */
EXTERN Tcl_Obj * Tcl_DbNewByteArrayObj(const unsigned char *bytes,
int length, const char *file, int line);
@@ -130,9 +128,7 @@ EXTERN Tcl_Obj * Tcl_DbNewDoubleObj(double doubleValue,
/* 25 */
EXTERN Tcl_Obj * Tcl_DbNewListObj(int objc, Tcl_Obj *const *objv,
const char *file, int line);
-/* 26 */
-EXTERN Tcl_Obj * Tcl_DbNewLongObj(long longValue, const char *file,
- int line);
+/* Slot 26 is reserved */
/* 27 */
EXTERN Tcl_Obj * Tcl_DbNewObj(const char *file, int line);
/* 28 */
@@ -197,25 +193,21 @@ EXTERN int Tcl_ListObjLength(Tcl_Interp *interp,
EXTERN int Tcl_ListObjReplace(Tcl_Interp *interp,
Tcl_Obj *listPtr, int first, int count,
int objc, Tcl_Obj *const objv[]);
-/* 49 */
-EXTERN Tcl_Obj * Tcl_NewBooleanObj(int boolValue);
+/* Slot 49 is reserved */
/* 50 */
EXTERN Tcl_Obj * Tcl_NewByteArrayObj(const unsigned char *bytes,
int length);
/* 51 */
EXTERN Tcl_Obj * Tcl_NewDoubleObj(double doubleValue);
-/* 52 */
-EXTERN Tcl_Obj * Tcl_NewIntObj(int intValue);
+/* Slot 52 is reserved */
/* 53 */
EXTERN Tcl_Obj * Tcl_NewListObj(int objc, Tcl_Obj *const objv[]);
-/* 54 */
-EXTERN Tcl_Obj * Tcl_NewLongObj(long longValue);
+/* Slot 54 is reserved */
/* 55 */
EXTERN Tcl_Obj * Tcl_NewObj(void);
/* 56 */
EXTERN Tcl_Obj * Tcl_NewStringObj(const char *bytes, int length);
-/* 57 */
-EXTERN void Tcl_SetBooleanObj(Tcl_Obj *objPtr, int boolValue);
+/* Slot 57 is reserved */
/* 58 */
EXTERN unsigned char * Tcl_SetByteArrayLength(Tcl_Obj *objPtr,
size_t length);
@@ -224,13 +216,11 @@ EXTERN void Tcl_SetByteArrayObj(Tcl_Obj *objPtr,
const unsigned char *bytes, size_t length);
/* 60 */
EXTERN void Tcl_SetDoubleObj(Tcl_Obj *objPtr, double doubleValue);
-/* 61 */
-EXTERN void Tcl_SetIntObj(Tcl_Obj *objPtr, int intValue);
+/* Slot 61 is reserved */
/* 62 */
EXTERN void Tcl_SetListObj(Tcl_Obj *objPtr, int objc,
Tcl_Obj *const objv[]);
-/* 63 */
-EXTERN void Tcl_SetLongObj(Tcl_Obj *objPtr, long longValue);
+/* Slot 63 is reserved */
/* 64 */
EXTERN void Tcl_SetObjLength(Tcl_Obj *objPtr, size_t length);
/* 65 */
@@ -1826,11 +1816,11 @@ typedef struct TclStubs {
void (*tcl_DbDecrRefCount) (Tcl_Obj *objPtr, const char *file, int line); /* 19 */
void (*tcl_DbIncrRefCount) (Tcl_Obj *objPtr, const char *file, int line); /* 20 */
int (*tcl_DbIsShared) (Tcl_Obj *objPtr, const char *file, int line); /* 21 */
- Tcl_Obj * (*tcl_DbNewBooleanObj) (int boolValue, const char *file, int line); /* 22 */
+ void (*reserved22)(void);
Tcl_Obj * (*tcl_DbNewByteArrayObj) (const unsigned char *bytes, int length, const char *file, int line); /* 23 */
Tcl_Obj * (*tcl_DbNewDoubleObj) (double doubleValue, const char *file, int line); /* 24 */
Tcl_Obj * (*tcl_DbNewListObj) (int objc, Tcl_Obj *const *objv, const char *file, int line); /* 25 */
- Tcl_Obj * (*tcl_DbNewLongObj) (long longValue, const char *file, int line); /* 26 */
+ void (*reserved26)(void);
Tcl_Obj * (*tcl_DbNewObj) (const char *file, int line); /* 27 */
Tcl_Obj * (*tcl_DbNewStringObj) (const char *bytes, size_t length, const char *file, int line); /* 28 */
Tcl_Obj * (*tcl_DuplicateObj) (Tcl_Obj *objPtr); /* 29 */
@@ -1853,21 +1843,21 @@ typedef struct TclStubs {
int (*tcl_ListObjIndex) (Tcl_Interp *interp, Tcl_Obj *listPtr, int index, Tcl_Obj **objPtrPtr); /* 46 */
int (*tcl_ListObjLength) (Tcl_Interp *interp, Tcl_Obj *listPtr, int *lengthPtr); /* 47 */
int (*tcl_ListObjReplace) (Tcl_Interp *interp, Tcl_Obj *listPtr, int first, int count, int objc, Tcl_Obj *const objv[]); /* 48 */
- Tcl_Obj * (*tcl_NewBooleanObj) (int boolValue); /* 49 */
+ void (*reserved49)(void);
Tcl_Obj * (*tcl_NewByteArrayObj) (const unsigned char *bytes, int length); /* 50 */
Tcl_Obj * (*tcl_NewDoubleObj) (double doubleValue); /* 51 */
- Tcl_Obj * (*tcl_NewIntObj) (int intValue); /* 52 */
+ void (*reserved52)(void);
Tcl_Obj * (*tcl_NewListObj) (int objc, Tcl_Obj *const objv[]); /* 53 */
- Tcl_Obj * (*tcl_NewLongObj) (long longValue); /* 54 */
+ void (*reserved54)(void);
Tcl_Obj * (*tcl_NewObj) (void); /* 55 */
Tcl_Obj * (*tcl_NewStringObj) (const char *bytes, int length); /* 56 */
- void (*tcl_SetBooleanObj) (Tcl_Obj *objPtr, int boolValue); /* 57 */
+ void (*reserved57)(void);
unsigned char * (*tcl_SetByteArrayLength) (Tcl_Obj *objPtr, size_t length); /* 58 */
void (*tcl_SetByteArrayObj) (Tcl_Obj *objPtr, const unsigned char *bytes, size_t length); /* 59 */
void (*tcl_SetDoubleObj) (Tcl_Obj *objPtr, double doubleValue); /* 60 */
- void (*tcl_SetIntObj) (Tcl_Obj *objPtr, int intValue); /* 61 */
+ void (*reserved61)(void);
void (*tcl_SetListObj) (Tcl_Obj *objPtr, int objc, Tcl_Obj *const objv[]); /* 62 */
- void (*tcl_SetLongObj) (Tcl_Obj *objPtr, long longValue); /* 63 */
+ void (*reserved63)(void);
void (*tcl_SetObjLength) (Tcl_Obj *objPtr, size_t length); /* 64 */
void (*tcl_SetStringObj) (Tcl_Obj *objPtr, const char *bytes, size_t length); /* 65 */
void (*tcl_AddErrorInfo) (Tcl_Interp *interp, const char *message); /* 66 */
@@ -2514,16 +2504,14 @@ extern const TclStubs *tclStubsPtr;
(tclStubsPtr->tcl_DbIncrRefCount) /* 20 */
#define Tcl_DbIsShared \
(tclStubsPtr->tcl_DbIsShared) /* 21 */
-#define Tcl_DbNewBooleanObj \
- (tclStubsPtr->tcl_DbNewBooleanObj) /* 22 */
+/* Slot 22 is reserved */
#define Tcl_DbNewByteArrayObj \
(tclStubsPtr->tcl_DbNewByteArrayObj) /* 23 */
#define Tcl_DbNewDoubleObj \
(tclStubsPtr->tcl_DbNewDoubleObj) /* 24 */
#define Tcl_DbNewListObj \
(tclStubsPtr->tcl_DbNewListObj) /* 25 */
-#define Tcl_DbNewLongObj \
- (tclStubsPtr->tcl_DbNewLongObj) /* 26 */
+/* Slot 26 is reserved */
#define Tcl_DbNewObj \
(tclStubsPtr->tcl_DbNewObj) /* 27 */
#define Tcl_DbNewStringObj \
@@ -2568,36 +2556,30 @@ extern const TclStubs *tclStubsPtr;
(tclStubsPtr->tcl_ListObjLength) /* 47 */
#define Tcl_ListObjReplace \
(tclStubsPtr->tcl_ListObjReplace) /* 48 */
-#define Tcl_NewBooleanObj \
- (tclStubsPtr->tcl_NewBooleanObj) /* 49 */
+/* Slot 49 is reserved */
#define Tcl_NewByteArrayObj \
(tclStubsPtr->tcl_NewByteArrayObj) /* 50 */
#define Tcl_NewDoubleObj \
(tclStubsPtr->tcl_NewDoubleObj) /* 51 */
-#define Tcl_NewIntObj \
- (tclStubsPtr->tcl_NewIntObj) /* 52 */
+/* Slot 52 is reserved */
#define Tcl_NewListObj \
(tclStubsPtr->tcl_NewListObj) /* 53 */
-#define Tcl_NewLongObj \
- (tclStubsPtr->tcl_NewLongObj) /* 54 */
+/* Slot 54 is reserved */
#define Tcl_NewObj \
(tclStubsPtr->tcl_NewObj) /* 55 */
#define Tcl_NewStringObj \
(tclStubsPtr->tcl_NewStringObj) /* 56 */
-#define Tcl_SetBooleanObj \
- (tclStubsPtr->tcl_SetBooleanObj) /* 57 */
+/* Slot 57 is reserved */
#define Tcl_SetByteArrayLength \
(tclStubsPtr->tcl_SetByteArrayLength) /* 58 */
#define Tcl_SetByteArrayObj \
(tclStubsPtr->tcl_SetByteArrayObj) /* 59 */
#define Tcl_SetDoubleObj \
(tclStubsPtr->tcl_SetDoubleObj) /* 60 */
-#define Tcl_SetIntObj \
- (tclStubsPtr->tcl_SetIntObj) /* 61 */
+/* Slot 61 is reserved */
#define Tcl_SetListObj \
(tclStubsPtr->tcl_SetListObj) /* 62 */
-#define Tcl_SetLongObj \
- (tclStubsPtr->tcl_SetLongObj) /* 63 */
+/* Slot 63 is reserved */
#define Tcl_SetObjLength \
(tclStubsPtr->tcl_SetObjLength) /* 64 */
#define Tcl_SetStringObj \
@@ -3767,15 +3749,12 @@ extern const TclStubs *tclStubsPtr;
#define Tcl_GetIndexFromObj(interp, objPtr, tablePtr, msg, flags, indexPtr) \
Tcl_GetIndexFromObjStruct(interp, objPtr, tablePtr, \
sizeof(char *), msg, flags, indexPtr)
-#undef Tcl_NewBooleanObj
#define Tcl_NewBooleanObj(boolValue) \
- Tcl_NewLongObj((boolValue)!=0)
-#undef Tcl_DbNewBooleanObj
+ Tcl_NewWideIntObj((boolValue)!=0)
#define Tcl_DbNewBooleanObj(boolValue, file, line) \
- Tcl_DbNewLongObj((boolValue)!=0, file, line)
-#undef Tcl_SetBooleanObj
+ Tcl_DbNewWideIntObj((boolValue)!=0, file, line)
#define Tcl_SetBooleanObj(objPtr, boolValue) \
- Tcl_SetLongObj(objPtr, (boolValue)!=0)
+ Tcl_SetWideIntObj(objPtr, (boolValue)!=0)
#undef Tcl_SetVar
#define Tcl_SetVar(interp, varName, newValue, flags) \
Tcl_SetVar2(interp, varName, NULL, newValue, flags)
@@ -3903,15 +3882,10 @@ extern const TclStubs *tclStubsPtr;
(Tcl_AttemptDbCkrealloc((x), (y), __FILE__, __LINE__))
#endif /* !TCL_MEM_DEBUG */
-#undef Tcl_NewLongObj
#define Tcl_NewLongObj(value) Tcl_NewWideIntObj((long)(value))
-#undef Tcl_NewIntObj
#define Tcl_NewIntObj(value) Tcl_NewWideIntObj((int)(value))
-#undef Tcl_DbNewLongObj
#define Tcl_DbNewLongObj(value, file, line) Tcl_DbNewWideIntObj((long)(value), file, line)
-#undef Tcl_SetIntObj
#define Tcl_SetIntObj(objPtr, value) Tcl_SetWideIntObj(objPtr, (int)(value))
-#undef Tcl_SetLongObj
#define Tcl_SetLongObj(objPtr, value) Tcl_SetWideIntObj(objPtr, (long)(value))
/*
diff --git a/generic/tclDisassemble.c b/generic/tclDisassemble.c
index 7181164..874d0d7 100644
--- a/generic/tclDisassemble.c
+++ b/generic/tclDisassemble.c
@@ -817,17 +817,17 @@ static void
UpdateStringOfInstName(
Tcl_Obj *objPtr)
{
- int inst = objPtr->internalRep.wideValue;
- char *s, buf[20];
- int len;
+ size_t len, inst = (size_t)objPtr->internalRep.wideValue;
+ char *s, buf[TCL_INTEGER_SPACE + 5];
- if ((inst < 0) || (inst > LAST_INST_OPCODE)) {
- sprintf(buf, "inst_%d", inst);
+ if (inst > LAST_INST_OPCODE) {
+ sprintf(buf, "inst_%" TCL_Z_MODIFIER "d", inst);
s = buf;
} else {
- s = (char *) tclInstructionTable[objPtr->internalRep.wideValue].name;
+ s = (char *) tclInstructionTable[inst].name;
}
len = strlen(s);
+ /* assert (len < UINT_MAX) */
objPtr->bytes = ckalloc(len + 1);
memcpy(objPtr->bytes, s, len + 1);
objPtr->length = len;
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 606ff1f..f1ce001 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -456,21 +456,6 @@ VarHashCreateVar(
TclGetNumberFromObj((interp), (objPtr), (ptrPtr), (tPtr)))
/*
- * Macro used in this file to save a function call for common uses of
- * Tcl_GetBooleanFromObj(). The ANSI C "prototype" is:
- *
- * MODULE_SCOPE int TclGetBooleanFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
- * int *boolPtr);
- */
-
-#define TclGetBooleanFromObj(interp, objPtr, boolPtr) \
- (((objPtr)->typePtr == &tclIntType) \
- ? (*(boolPtr) = ((objPtr)->internalRep.wideValue!=0), TCL_OK) \
- : ((objPtr)->typePtr == &tclBooleanType) \
- ? (*(boolPtr) = ((objPtr)->internalRep.longValue!=0), TCL_OK) \
- : Tcl_GetBooleanFromObj((interp), (objPtr), (boolPtr)))
-
-/*
* Macro used to make the check for type overflow more mnemonic. This works by
* comparing sign bits; the rest of the word is irrelevant. The ANSI C
* "prototype" (where inttype_t is any integer type) is:
@@ -6343,7 +6328,8 @@ TEBCresume(
Var *iterVarPtr, *listVarPtr;
Tcl_Obj *oldValuePtr, *listPtr, **elements;
ForeachVarList *varListPtr;
- int numLists, iterNum, listTmpIndex, listLen, numVars;
+ int numLists, listTmpIndex, listLen, numVars;
+ size_t iterNum;
int varIndex, valIndex, continueLoop, j, iterTmpIndex;
long i;
@@ -6397,7 +6383,7 @@ TEBCresume(
iterVarPtr = LOCAL(infoPtr->loopCtTemp);
valuePtr = iterVarPtr->value.objPtr;
- iterNum = valuePtr->internalRep.wideValue + 1;
+ iterNum = (size_t)valuePtr->internalRep.wideValue + 1;
TclSetIntObj(valuePtr, iterNum);
/*
@@ -6418,7 +6404,7 @@ TEBCresume(
i, O2S(listPtr), O2S(Tcl_GetObjResult(interp))));
goto gotError;
}
- if (listLen > iterNum * numVars) {
+ if ((size_t)listLen > iterNum * numVars) {
continueLoop = 1;
}
listTmpIndex++;
@@ -6484,7 +6470,7 @@ TEBCresume(
listTmpIndex++;
}
}
- TRACE_APPEND(("%d lists, iter %d, %s loop\n",
+ TRACE_APPEND(("%d lists, iter %" TCL_Z_MODIFIER "d, %s loop\n",
numLists, iterNum, (continueLoop? "continue" : "exit")));
/*
@@ -6505,8 +6491,9 @@ TEBCresume(
ForeachInfo *infoPtr;
Tcl_Obj *listPtr, **elements, *tmpPtr;
ForeachVarList *varListPtr;
- int numLists, iterMax, listLen, numVars;
- int iterTmp, iterNum, listTmpDepth;
+ int numLists, listLen, numVars;
+ int listTmpDepth;
+ size_t iterNum, iterMax, iterTmp;
int varIndex, valIndex, j;
long i;
@@ -6557,8 +6544,8 @@ TEBCresume(
*/
TclNewObj(tmpPtr);
- tmpPtr->internalRep.twoPtrValue.ptr1 = INT2PTR(0);
- tmpPtr->internalRep.twoPtrValue.ptr2 = INT2PTR(iterMax);
+ tmpPtr->internalRep.twoPtrValue.ptr1 = NULL;
+ tmpPtr->internalRep.twoPtrValue.ptr2 = (void *)iterMax;
PUSH_OBJECT(tmpPtr); /* iterCounts object */
/*
@@ -6590,8 +6577,8 @@ TEBCresume(
TRACE(("=> "));
tmpPtr = OBJ_AT_DEPTH(1);
- iterNum = PTR2INT(tmpPtr->internalRep.twoPtrValue.ptr1);
- iterMax = PTR2INT(tmpPtr->internalRep.twoPtrValue.ptr2);
+ iterNum = (size_t)tmpPtr->internalRep.twoPtrValue.ptr1;
+ iterMax = (size_t)tmpPtr->internalRep.twoPtrValue.ptr2;
/*
* If some list still has a remaining list element iterate one more
@@ -6603,7 +6590,7 @@ TEBCresume(
* Set the variables and jump back to run the body
*/
- tmpPtr->internalRep.twoPtrValue.ptr1 = INT2PTR(iterNum + 1);
+ tmpPtr->internalRep.twoPtrValue.ptr1 =(void *)(iterNum + 1);
listTmpDepth = numLists + 1;
@@ -7883,6 +7870,14 @@ ExecuteExtendedBinaryMathOp(
}
if (type1 == TCL_NUMBER_WIDE) {
w1 = *((const Tcl_WideInt *)ptr1);
+
+ if (w1 == 0) {
+ /*
+ * 0 % (non-zero) always yields remainder of 0.
+ */
+
+ return constants[0];
+ }
if (type2 != TCL_NUMBER_BIG) {
Tcl_WideInt wQuotient, wRemainder;
Tcl_GetWideIntFromObj(NULL, value2Ptr, &w2);
@@ -8982,10 +8977,9 @@ PrintByteCodeInfo(
Proc *procPtr = codePtr->procPtr;
Interp *iPtr = (Interp *) *codePtr->interpHandle;
- fprintf(stdout, "\nExecuting ByteCode 0x%p, refCt %" TCL_LL_MODIFIER "u, epoch %" TCL_LL_MODIFIER "u, interp 0x%p (epoch %" TCL_LL_MODIFIER "u)\n",
- codePtr, (Tcl_WideInt)codePtr->refCount, (Tcl_WideInt)codePtr->compileEpoch, iPtr,
- (Tcl_WideInt)iPtr->compileEpoch);
-
+ fprintf(stdout, "\nExecuting ByteCode 0x%p, refCt %" TCL_Z_MODIFIER "u, epoch %" TCL_Z_MODIFIER "u, interp 0x%p (epoch %" TCL_Z_MODIFIER "u)\n",
+ codePtr, (size_t)codePtr->refCount, codePtr->compileEpoch, iPtr,
+ iPtr->compileEpoch);
fprintf(stdout, " Source: ");
TclPrintSource(stdout, codePtr->source, 60);
diff --git a/generic/tclGet.c b/generic/tclGet.c
index 727db0a..4811c42 100644
--- a/generic/tclGet.c
+++ b/generic/tclGet.c
@@ -142,7 +142,7 @@ Tcl_GetBoolean(
Tcl_Panic("invalid sharing of Tcl_Obj on C stack");
}
if (code == TCL_OK) {
- *boolPtr = obj.internalRep.wideValue;
+ *boolPtr = obj.internalRep.wideValue != 0;
}
return code;
}
diff --git a/generic/tclInt.h b/generic/tclInt.h
index d2bf8ab..8e84d31 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -2386,13 +2386,20 @@ typedef struct List {
#define TCL_EACH_COLLECT 1 /* Collect iteration result like [lmap] */
/*
- * Macros providing a faster path to integers: Tcl_GetLongFromObj,
- * Tcl_GetIntFromObj and TclGetIntForIndex.
+ * Macros providing a faster path to booleans and integers:
+ * Tcl_GetBooleanFromObj, Tcl_GetLongFromObj, Tcl_GetIntFromObj
+ * and TclGetIntForIndex.
*
* WARNING: these macros eval their args more than once.
*/
-#if (LONG_MAX == LLONG_MAX)
+#define TclGetBooleanFromObj(interp, objPtr, boolPtr) \
+ (((objPtr)->typePtr == &tclIntType \
+ || (objPtr)->typePtr == &tclBooleanType) \
+ ? (*(boolPtr) = ((objPtr)->internalRep.wideValue!=0), TCL_OK) \
+ : Tcl_GetBooleanFromObj((interp), (objPtr), (boolPtr)))
+
+#ifdef TCL_WIDE_INT_IS_LONG
#define TclGetLongFromObj(interp, objPtr, longPtr) \
(((objPtr)->typePtr == &tclIntType) \
? ((*(longPtr) = (objPtr)->internalRep.wideValue), TCL_OK) \
@@ -2410,13 +2417,13 @@ typedef struct List {
(((objPtr)->typePtr == &tclIntType \
&& (objPtr)->internalRep.wideValue >= -(Tcl_WideInt)(UINT_MAX) \
&& (objPtr)->internalRep.wideValue <= (Tcl_WideInt)(UINT_MAX)) \
- ? ((*(intPtr) = (objPtr)->internalRep.wideValue), TCL_OK) \
+ ? ((*(intPtr) = (int)(objPtr)->internalRep.wideValue), TCL_OK) \
: Tcl_GetIntFromObj((interp), (objPtr), (intPtr)))
#define TclGetIntForIndexM(interp, objPtr, endValue, idxPtr) \
(((objPtr)->typePtr == &tclIntType \
&& (objPtr)->internalRep.wideValue >= INT_MIN \
&& (objPtr)->internalRep.wideValue <= INT_MAX) \
- ? ((*(idxPtr) = (objPtr)->internalRep.wideValue), TCL_OK) \
+ ? ((*(idxPtr) = (int)(objPtr)->internalRep.wideValue), TCL_OK) \
: TclGetIntForIndex((interp), (objPtr), (endValue), (idxPtr)))
/*
diff --git a/generic/tclObj.c b/generic/tclObj.c
index 0edf6cc..7a25c59 100644
--- a/generic/tclObj.c
+++ b/generic/tclObj.c
@@ -210,9 +210,6 @@ static int SetDoubleFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
static int SetIntFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
static void UpdateStringOfDouble(Tcl_Obj *objPtr);
static void UpdateStringOfInt(Tcl_Obj *objPtr);
-#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 && !defined(TCL_WIDE_INT_IS_LONG)
-static void UpdateStringOfOldInt(Tcl_Obj *objPtr);
-#endif
static void FreeBignum(Tcl_Obj *objPtr);
static void DupBignum(Tcl_Obj *objPtr, Tcl_Obj *copyPtr);
static void UpdateStringOfBignum(Tcl_Obj *objPtr);
@@ -256,25 +253,12 @@ const Tcl_ObjType tclDoubleType = {
SetDoubleFromAny /* setFromAnyProc */
};
const Tcl_ObjType tclIntType = {
-#if defined(TCL_NO_DEPRECATED) || TCL_MAJOR_VERSION > 8 || defined(TCL_WIDE_INT_IS_LONG)
"int", /* name */
-#else
- "wideInt", /* name, keeping maximum compatibility with Tcl 8.6 on 32-bit platforms*/
-#endif
NULL, /* freeIntRepProc */
NULL, /* dupIntRepProc */
UpdateStringOfInt, /* updateStringProc */
SetIntFromAny /* setFromAnyProc */
};
-#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 && !defined(TCL_WIDE_INT_IS_LONG)
-static const Tcl_ObjType oldIntType = {
- "int", /* name */
- NULL, /* freeIntRepProc */
- NULL, /* dupIntRepProc */
- UpdateStringOfOldInt, /* updateStringProc */
- SetIntFromAny /* setFromAnyProc */
-};
-#endif
const Tcl_ObjType tclBignumType = {
"bignum", /* name */
FreeBignum, /* freeIntRepProc */
@@ -1637,7 +1621,7 @@ Tcl_GetString(
objPtr->typePtr->name);
}
objPtr->typePtr->updateStringProc(objPtr);
- if (objPtr->bytes == NULL || objPtr->length < 0
+ if (objPtr->bytes == NULL || objPtr->length == (size_t)-1
|| objPtr->bytes[objPtr->length] != '\0') {
Tcl_Panic("UpdateStringProc for type '%s' "
"failed to create a valid string rep", objPtr->typePtr->name);
@@ -1713,146 +1697,6 @@ Tcl_InvalidateStringRep(
/*
*----------------------------------------------------------------------
*
- * Tcl_NewBooleanObj --
- *
- * This function is normally called when not debugging: i.e., when
- * TCL_MEM_DEBUG is not defined. It creates a new Tcl_Obj and
- * initializes it from the argument boolean value. A nonzero "boolValue"
- * is coerced to 1.
- *
- * When TCL_MEM_DEBUG is defined, this function just returns the result
- * of calling the debugging version Tcl_DbNewLongObj.
- *
- * Results:
- * The newly created object is returned. This object will have an invalid
- * string representation. The returned object has ref count 0.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-#undef Tcl_NewBooleanObj
-#ifdef TCL_MEM_DEBUG
-
-Tcl_Obj *
-Tcl_NewBooleanObj(
- register int boolValue) /* Boolean used to initialize new object. */
-{
- return Tcl_DbNewLongObj(boolValue!=0, "unknown", 0);
-}
-
-#else /* if not TCL_MEM_DEBUG */
-
-Tcl_Obj *
-Tcl_NewBooleanObj(
- register int boolValue) /* Boolean used to initialize new object. */
-{
- register Tcl_Obj *objPtr;
-
- TclNewIntObj(objPtr, boolValue!=0);
- return objPtr;
-}
-#endif /* TCL_MEM_DEBUG */
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_DbNewBooleanObj --
- *
- * This function is normally called when debugging: i.e., when
- * TCL_MEM_DEBUG is defined. It creates new boolean objects. It is the
- * same as the Tcl_NewBooleanObj function above except that it calls
- * Tcl_DbCkalloc directly with the file name and line number from its
- * caller. This simplifies debugging since then the [memory active]
- * command will report the correct file name and line number when
- * reporting objects that haven't been freed.
- *
- * When TCL_MEM_DEBUG is not defined, this function just returns the
- * result of calling Tcl_NewBooleanObj.
- *
- * Results:
- * The newly created object is returned. This object will have an invalid
- * string representation. The returned object has ref count 0.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-#ifndef TCL_NO_DEPRECATED
-#undef Tcl_DbNewBooleanObj
-#ifdef TCL_MEM_DEBUG
-
-Tcl_Obj *
-Tcl_DbNewBooleanObj(
- register int boolValue, /* Boolean used to initialize new object. */
- const char *file, /* The name of the source file calling this
- * function; used for debugging. */
- int line) /* Line number in the source file; used for
- * debugging. */
-{
- register Tcl_Obj *objPtr;
-
- TclDbNewObj(objPtr, file, line);
- objPtr->bytes = NULL;
-
- objPtr->internalRep.wideValue = (boolValue != 0);
- objPtr->typePtr = &tclIntType;
- return objPtr;
-}
-
-#else /* if not TCL_MEM_DEBUG */
-
-Tcl_Obj *
-Tcl_DbNewBooleanObj(
- register int boolValue, /* Boolean used to initialize new object. */
- const char *file, /* The name of the source file calling this
- * function; used for debugging. */
- int line) /* Line number in the source file; used for
- * debugging. */
-{
- return Tcl_NewBooleanObj(boolValue);
-}
-#endif /* TCL_MEM_DEBUG */
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_SetBooleanObj --
- *
- * Modify an object to be a boolean object and to have the specified
- * boolean value. A nonzero "boolValue" is coerced to 1.
- *
- * Results:
- * None.
- *
- * Side effects:
- * The object's old string rep, if any, is freed. Also, any old internal
- * rep is freed.
- *
- *----------------------------------------------------------------------
- */
-
-#undef Tcl_SetBooleanObj
-void
-Tcl_SetBooleanObj(
- register Tcl_Obj *objPtr, /* Object whose internal rep to init. */
- register int boolValue) /* Boolean used to set object's value. */
-{
- if (Tcl_IsShared(objPtr)) {
- Tcl_Panic("%s called with shared object", "Tcl_SetBooleanObj");
- }
-
- TclSetIntObj(objPtr, boolValue!=0);
-}
-#endif /* TCL_NO_DEPRECATED */
-
-/*
- *----------------------------------------------------------------------
- *
* Tcl_GetBooleanFromObj --
*
* Attempt to return a boolean from the Tcl object "objPtr". This
@@ -1876,14 +1720,10 @@ Tcl_GetBooleanFromObj(
register int *boolPtr) /* Place to store resulting boolean. */
{
do {
- if (objPtr->typePtr == &tclIntType) {
+ if (objPtr->typePtr == &tclIntType || objPtr->typePtr == &tclBooleanType) {
*boolPtr = (objPtr->internalRep.wideValue != 0);
return TCL_OK;
}
- if (objPtr->typePtr == &tclBooleanType) {
- *boolPtr = (int) objPtr->internalRep.longValue;
- return TCL_OK;
- }
if (objPtr->typePtr == &tclDoubleType) {
/*
* Caution: Don't be tempted to check directly for the "double"
@@ -1925,7 +1765,7 @@ Tcl_GetBooleanFromObj(
*
* Side effects:
* If no error occurs, an integer 1 or 0 is stored as "objPtr"s internal
- * representation and the type of "objPtr" is set to boolean.
+ * representation and the type of "objPtr" is set to boolean or int.
*
*----------------------------------------------------------------------
*/
@@ -1943,8 +1783,7 @@ TclSetBooleanFromAny(
if (objPtr->bytes == NULL) {
if (objPtr->typePtr == &tclIntType) {
- switch (objPtr->internalRep.wideValue) {
- case 0L: case 1L:
+ if ((Tcl_WideUInt)objPtr->internalRep.wideValue < 2) {
return TCL_OK;
}
goto badBoolean;
@@ -2084,7 +1923,7 @@ ParseBoolean(
goodBoolean:
TclFreeIntRep(objPtr);
- objPtr->internalRep.longValue = newBool;
+ objPtr->internalRep.wideValue = newBool;
objPtr->typePtr = &tclBooleanType;
return TCL_OK;
@@ -2352,90 +2191,6 @@ UpdateStringOfDouble(
/*
*----------------------------------------------------------------------
*
- * Tcl_NewIntObj --
- *
- * If a client is compiled with TCL_MEM_DEBUG defined, calls to
- * Tcl_NewIntObj to create a new integer object end up calling the
- * debugging function Tcl_DbNewLongObj instead.
- *
- * Otherwise, if the client is compiled without TCL_MEM_DEBUG defined,
- * calls to Tcl_NewIntObj result in a call to one of the two
- * Tcl_NewIntObj implementations below. We provide two implementations so
- * that the Tcl core can be compiled to do memory debugging of the core
- * even if a client does not request it for itself.
- *
- * Integer and long integer objects share the same "integer" type
- * implementation. We store all integers as longs and Tcl_GetIntFromObj
- * checks whether the current value of the long can be represented by an
- * int.
- *
- * Results:
- * The newly created object is returned. This object will have an invalid
- * string representation. The returned object has ref count 0.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-#undef Tcl_NewIntObj
-#ifdef TCL_MEM_DEBUG
-
-Tcl_Obj *
-Tcl_NewIntObj(
- register int intValue) /* Int used to initialize the new object. */
-{
- return Tcl_DbNewLongObj((long)intValue, "unknown", 0);
-}
-
-#else /* if not TCL_MEM_DEBUG */
-
-Tcl_Obj *
-Tcl_NewIntObj(
- register int intValue) /* Int used to initialize the new object. */
-{
- register Tcl_Obj *objPtr;
-
- TclNewIntObj(objPtr, intValue);
- return objPtr;
-}
-#endif /* if TCL_MEM_DEBUG */
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_SetIntObj --
- *
- * Modify an object to be an integer and to have the specified integer
- * value.
- *
- * Results:
- * None.
- *
- * Side effects:
- * The object's old string rep, if any, is freed. Also, any old internal
- * rep is freed.
- *
- *----------------------------------------------------------------------
- */
-
-#undef Tcl_SetIntObj
-void
-Tcl_SetIntObj(
- register Tcl_Obj *objPtr, /* Object whose internal rep to init. */
- register int intValue) /* Integer used to set object's value. */
-{
- if (Tcl_IsShared(objPtr)) {
- Tcl_Panic("%s called with shared object", "Tcl_SetIntObj");
- }
-
- TclSetIntObj(objPtr, intValue);
-}
-
-/*
- *----------------------------------------------------------------------
- *
* Tcl_GetIntFromObj --
*
* Retrieve the integer value of 'objPtr'.
@@ -2547,178 +2302,6 @@ UpdateStringOfInt(
memcpy(objPtr->bytes, buffer, (unsigned) len + 1);
objPtr->length = len;
}
-
-#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 && !defined(TCL_WIDE_INT_IS_LONG)
-static void
-UpdateStringOfOldInt(
- register Tcl_Obj *objPtr) /* Int object whose string rep to update. */
-{
- char buffer[TCL_INTEGER_SPACE];
- register int len;
-
- len = TclFormatInt(buffer, objPtr->internalRep.longValue);
-
- objPtr->bytes = ckalloc(len + 1);
- memcpy(objPtr->bytes, buffer, (unsigned) len + 1);
- objPtr->length = len;
-}
-#endif
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_NewLongObj --
- *
- * If a client is compiled with TCL_MEM_DEBUG defined, calls to
- * Tcl_NewLongObj to create a new long integer object end up calling the
- * debugging function Tcl_DbNewLongObj instead.
- *
- * Otherwise, if the client is compiled without TCL_MEM_DEBUG defined,
- * calls to Tcl_NewLongObj result in a call to one of the two
- * Tcl_NewLongObj implementations below. We provide two implementations
- * so that the Tcl core can be compiled to do memory debugging of the
- * core even if a client does not request it for itself.
- *
- * Integer and long integer objects share the same "integer" type
- * implementation. We store all integers as longs and Tcl_GetIntFromObj
- * checks whether the current value of the long can be represented by an
- * int.
- *
- * Results:
- * The newly created object is returned. This object will have an invalid
- * string representation. The returned object has ref count 0.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-#undef Tcl_NewLongObj
-#ifdef TCL_MEM_DEBUG
-
-Tcl_Obj *
-Tcl_NewLongObj(
- register long longValue) /* Long integer used to initialize the
- * new object. */
-{
- return Tcl_DbNewLongObj(longValue, "unknown", 0);
-}
-
-#else /* if not TCL_MEM_DEBUG */
-
-Tcl_Obj *
-Tcl_NewLongObj(
- register long longValue) /* Long integer used to initialize the
- * new object. */
-{
- register Tcl_Obj *objPtr;
-
- TclNewIntObj(objPtr, longValue);
- return objPtr;
-}
-#endif /* if TCL_MEM_DEBUG */
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_DbNewLongObj --
- *
- * If a client is compiled with TCL_MEM_DEBUG defined, calls to
- * Tcl_NewIntObj and Tcl_NewLongObj to create new integer or long integer
- * objects end up calling the debugging function Tcl_DbNewLongObj
- * instead. We provide two implementations of Tcl_DbNewLongObj so that
- * whether the Tcl core is compiled to do memory debugging of the core is
- * independent of whether a client requests debugging for itself.
- *
- * When the core is compiled with TCL_MEM_DEBUG defined, Tcl_DbNewLongObj
- * calls Tcl_DbCkalloc directly with the file name and line number from
- * its caller. This simplifies debugging since then the [memory active]
- * command will report the caller's file name and line number when
- * reporting objects that haven't been freed.
- *
- * Otherwise, when the core is compiled without TCL_MEM_DEBUG defined,
- * this function just returns the result of calling Tcl_NewLongObj.
- *
- * Results:
- * The newly created long integer object is returned. This object will
- * have an invalid string representation. The returned object has ref
- * count 0.
- *
- * Side effects:
- * Allocates memory.
- *
- *----------------------------------------------------------------------
- */
-
-#undef Tcl_DbNewLongObj
-#ifdef TCL_MEM_DEBUG
-
-Tcl_Obj *
-Tcl_DbNewLongObj(
- register long longValue, /* Long integer used to initialize the new
- * object. */
- const char *file, /* The name of the source file calling this
- * function; used for debugging. */
- int line) /* Line number in the source file; used for
- * debugging. */
-{
- register Tcl_Obj *objPtr;
-
- TclDbNewObj(objPtr, file, line);
- objPtr->bytes = NULL;
-
- objPtr->internalRep.wideValue = longValue;
- objPtr->typePtr = &tclIntType;
- return objPtr;
-}
-
-#else /* if not TCL_MEM_DEBUG */
-
-Tcl_Obj *
-Tcl_DbNewLongObj(
- register long longValue, /* Long integer used to initialize the new
- * object. */
- const char *file, /* The name of the source file calling this
- * function; used for debugging. */
- int line) /* Line number in the source file; used for
- * debugging. */
-{
- return Tcl_NewLongObj(longValue);
-}
-#endif /* TCL_MEM_DEBUG */
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_SetLongObj --
- *
- * Modify an object to be an integer object and to have the specified
- * long integer value.
- *
- * Results:
- * None.
- *
- * Side effects:
- * The object's old string rep, if any, is freed. Also, any old internal
- * rep is freed.
- *
- *----------------------------------------------------------------------
- */
-
-#undef Tcl_SetLongObj
-void
-Tcl_SetLongObj(
- register Tcl_Obj *objPtr, /* Object whose internal rep to init. */
- register long longValue) /* Long integer used to initialize the
- * object's value. */
-{
- if (Tcl_IsShared(objPtr)) {
- Tcl_Panic("%s called with shared object", "Tcl_SetLongObj");
- }
-
- TclSetIntObj(objPtr, longValue);
-}
/*
*----------------------------------------------------------------------
@@ -2748,7 +2331,7 @@ Tcl_GetLongFromObj(
register long *longPtr) /* Place to store resulting long. */
{
do {
-#if (LONG_MAX == LLONG_MAX)
+#ifdef TCL_WIDE_INT_IS_LONG
if (objPtr->typePtr == &tclIntType) {
*longPtr = objPtr->internalRep.wideValue;
return TCL_OK;
@@ -2811,7 +2394,7 @@ Tcl_GetLongFromObj(
return TCL_OK;
}
}
-#if (LONG_MAX != LLONG_MAX)
+#ifndef TCL_WIDE_INT_IS_LONG
tooLarge:
#endif
if (interp != NULL) {
diff --git a/generic/tclScan.c b/generic/tclScan.c
index 0cd23d8..65ceb66 100644
--- a/generic/tclScan.c
+++ b/generic/tclScan.c
@@ -10,6 +10,7 @@
*/
#include "tclInt.h"
+#include "tommath.h"
/*
* Flag values used by Tcl_ScanObjCmd.
@@ -415,14 +416,7 @@ ValidateFormat(
case 'x':
case 'X':
case 'b':
- break;
case 'u':
- if (flags & SCAN_BIG) {
- Tcl_SetObjResult(interp, Tcl_NewStringObj(
- "unsigned bignum scans are invalid", -1));
- Tcl_SetErrorCode(interp, "TCL", "FORMAT", "BADUNSIGNED",NULL);
- goto error;
- }
break;
/*
* Bracket terms need special checking
@@ -944,7 +938,18 @@ Tcl_ScanObjCmd(
} else {
TclSetIntObj(objPtr, wideValue);
}
- } else if (!(flags & SCAN_BIG)) {
+ } else if (flags & SCAN_BIG) {
+ if (flags & SCAN_UNSIGNED) {
+ mp_int big;
+ if ((Tcl_GetBignumFromObj(interp, objPtr, &big) != TCL_OK)
+ || (mp_cmp_d(&big, 0) == MP_LT)) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "unsigned bignum scans are invalid", -1));
+ Tcl_SetErrorCode(interp, "TCL", "FORMAT", "BADUNSIGNED",NULL);
+ return TCL_ERROR;
+ }
+ }
+ } else {
if (TclGetLongFromObj(NULL, objPtr, &value) != TCL_OK) {
if (TclGetString(objPtr)[0] == '-') {
value = LONG_MIN;
diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c
index 52b6283..8ea14d2 100644
--- a/generic/tclStringObj.c
+++ b/generic/tclStringObj.c
@@ -1851,20 +1851,10 @@ Tcl_AppendFormatToObj(
format += step;
step = TclUtfToUniChar(format, &ch);
}
- } else if ((ch == 't') || (ch == 'z')) {
+ } else if ((ch == 't') || (ch == 'z') || (ch == 'q') || (ch == 'j') || (ch == 'L')) {
format += step;
step = TclUtfToUniChar(format, &ch);
-#ifndef TCL_WIDE_INT_IS_LONG
- if (sizeof(size_t) > sizeof(int)) {
- useWide = 1;
- }
-#endif
- } else if ((ch == 'q') ||(ch == 'j')) {
- format += step;
- step = TclUtfToUniChar(format, &ch);
-#ifndef TCL_WIDE_INT_IS_LONG
- useWide = 1;
-#endif
+ useBig = 1;
}
format += step;
@@ -1910,11 +1900,6 @@ Tcl_AppendFormatToObj(
}
case 'u':
- if (useBig) {
- msg = "unsigned bignum format is invalid";
- errCode = "BADUNSIGNED";
- goto errorMsg;
- }
case 'd':
case 'o':
case 'p':
@@ -1934,13 +1919,25 @@ Tcl_AppendFormatToObj(
}
#endif
if (useBig) {
+ int cmpResult;
if (Tcl_GetBignumFromObj(interp, segment, &big) != TCL_OK) {
goto error;
}
- isNegative = (mp_cmp_d(&big, 0) == MP_LT);
+ cmpResult = mp_cmp_d(&big, 0);
+ isNegative = (cmpResult == MP_LT);
+ if (cmpResult == MP_EQ) gotHash = 0;
+ if (ch == 'u') {
+ if (isNegative) {
+ msg = "unsigned bignum format is invalid";
+ errCode = "BADUNSIGNED";
+ goto errorMsg;
+ } else {
+ ch = 'd';
+ }
+ }
#ifndef TCL_WIDE_INT_IS_LONG
} else if (useWide) {
- if (Tcl_GetWideIntFromObj(NULL, segment, &w) != TCL_OK) {
+ if (TclGetWideIntFromObj(NULL, segment, &w) != TCL_OK) {
Tcl_Obj *objPtr;
if (Tcl_GetBignumFromObj(interp,segment,&big) != TCL_OK) {
@@ -1949,13 +1946,14 @@ Tcl_AppendFormatToObj(
mp_mod_2d(&big, (int) CHAR_BIT*sizeof(Tcl_WideInt), &big);
objPtr = Tcl_NewBignumObj(&big);
Tcl_IncrRefCount(objPtr);
- Tcl_GetWideIntFromObj(NULL, objPtr, &w);
+ TclGetWideIntFromObj(NULL, objPtr, &w);
Tcl_DecrRefCount(objPtr);
}
isNegative = (w < (Tcl_WideInt) 0);
+ if (w == (Tcl_WideInt) 0) gotHash = 0;
#endif
} else if (TclGetLongFromObj(NULL, segment, &l) != TCL_OK) {
- if (Tcl_GetWideIntFromObj(NULL, segment, &w) != TCL_OK) {
+ if (TclGetWideIntFromObj(NULL, segment, &w) != TCL_OK) {
Tcl_Obj *objPtr;
if (Tcl_GetBignumFromObj(interp,segment,&big) != TCL_OK) {
@@ -1972,14 +1970,18 @@ Tcl_AppendFormatToObj(
if (useShort) {
s = (short) l;
isNegative = (s < (short) 0);
+ if (s == (short) 0) gotHash = 0;
} else {
isNegative = (l < (long) 0);
+ if (l == (long) 0) gotHash = 0;
}
} else if (useShort) {
s = (short) l;
isNegative = (s < (short) 0);
+ if (s == (short) 0) gotHash = 0;
} else {
isNegative = (l < (long) 0);
+ if (l == (long) 0) gotHash = 0;
}
segment = Tcl_NewObj();
@@ -1996,16 +1998,12 @@ Tcl_AppendFormatToObj(
if (gotHash || (ch == 'p')) {
switch (ch) {
case 'o':
- Tcl_AppendToObj(segment, "0", 1);
- segmentLimit -= 1;
- precision--;
- break;
- case 'X':
- Tcl_AppendToObj(segment, "0X", 2);
+ Tcl_AppendToObj(segment, "0o", 2);
segmentLimit -= 2;
break;
case 'p':
case 'x':
+ case 'X':
Tcl_AppendToObj(segment, "0x", 2);
segmentLimit -= 2;
break;
@@ -2013,10 +2011,6 @@ Tcl_AppendFormatToObj(
Tcl_AppendToObj(segment, "0b", 2);
segmentLimit -= 2;
break;
- case 'd':
- Tcl_AppendToObj(segment, "0d", 2);
- segmentLimit -= 2;
- break;
}
}
@@ -2154,7 +2148,7 @@ Tcl_AppendFormatToObj(
* Need to be sure zero becomes "0", not "".
*/
- if ((numDigits == 0) && !((ch == 'o') && gotHash)) {
+ if (numDigits == 0) {
numDigits = 1;
}
pure = Tcl_NewObj();
@@ -2221,6 +2215,8 @@ Tcl_AppendFormatToObj(
break;
}
+ case 'a':
+ case 'A':
case 'e':
case 'E':
case 'f':
@@ -2289,6 +2285,12 @@ Tcl_AppendFormatToObj(
errCode = "OVERFLOW";
goto errorMsg;
}
+ if (ch == 'A') {
+ char *p = TclGetString(segment) + 1;
+ *p = 'x';
+ p = strchr(p, 'P');
+ if (p) *p = 'p';
+ }
break;
}
default:
@@ -2494,15 +2496,26 @@ AppendPrintfToObjVA(
Tcl_ListObjAppendElement(NULL, list, Tcl_NewWideIntObj(
va_arg(argList, Tcl_WideInt)));
break;
+ case 3:
+ Tcl_ListObjAppendElement(NULL, list, Tcl_NewBignumObj(
+ va_arg(argList, mp_int *)));
+ break;
}
break;
+ case 'a':
+ case 'A':
case 'e':
case 'E':
case 'f':
case 'g':
case 'G':
+ if (size > 0) {
Tcl_ListObjAppendElement(NULL, list, Tcl_NewDoubleObj(
- va_arg(argList, double)));
+ (double)va_arg(argList, long double)));
+ } else {
+ Tcl_ListObjAppendElement(NULL, list, Tcl_NewDoubleObj(
+ va_arg(argList, double)));
+ }
seekingConversion = 0;
break;
case '*':
@@ -2522,7 +2535,6 @@ AppendPrintfToObjVA(
gotPrecision = 1;
p++;
break;
- /* TODO: support for bignum arguments */
case 'l':
++size;
p++;
@@ -2550,6 +2562,10 @@ AppendPrintfToObjVA(
}
p++;
break;
+ case 'L':
+ size = 3;
+ p++;
+ break;
case 'h':
size = -1;
default:
@@ -2754,8 +2770,8 @@ TclStringRepeat(
if (interp) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"string size overflow: unable to alloc %"
- TCL_LL_MODIFIER "d bytes",
- (Tcl_WideUInt)STRING_SIZE(count*length)));
+ TCL_Z_MODIFIER "u bytes",
+ STRING_SIZE(count*length)));
Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
}
return NULL;
@@ -3057,8 +3073,8 @@ TclStringCat(
if (interp) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"concatenation failed: unable to alloc %"
- TCL_LL_MODIFIER "d bytes",
- (Tcl_WideUInt)STRING_SIZE(length)));
+ TCL_Z_MODIFIER "u bytes",
+ STRING_SIZE(length)));
Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
}
return NULL;
@@ -3074,8 +3090,8 @@ TclStringCat(
if (interp) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"concatenation failed: unable to alloc %"
- TCL_LL_MODIFIER "d bytes",
- (Tcl_WideUInt)STRING_SIZE(length)));
+ TCL_Z_MODIFIER "u bytes",
+ STRING_SIZE(length)));
Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
}
return NULL;
@@ -3729,7 +3745,7 @@ ExtendStringRepWithUnicode(
goto copyBytes;
}
- for (i = 0; i < numChars && size >= 0; i++) {
+ for (i = 0; i < numChars; i++) {
size += TclUtfCount(unicode[i]);
}
diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c
index b3094f1..f018cf4 100644
--- a/generic/tclStubInit.c
+++ b/generic/tclStubInit.c
@@ -791,11 +791,11 @@ const TclStubs tclStubs = {
Tcl_DbDecrRefCount, /* 19 */
Tcl_DbIncrRefCount, /* 20 */
Tcl_DbIsShared, /* 21 */
- Tcl_DbNewBooleanObj, /* 22 */
+ 0, /* 22 */
Tcl_DbNewByteArrayObj, /* 23 */
Tcl_DbNewDoubleObj, /* 24 */
Tcl_DbNewListObj, /* 25 */
- Tcl_DbNewLongObj, /* 26 */
+ 0, /* 26 */
Tcl_DbNewObj, /* 27 */
Tcl_DbNewStringObj, /* 28 */
Tcl_DuplicateObj, /* 29 */
@@ -818,21 +818,21 @@ const TclStubs tclStubs = {
Tcl_ListObjIndex, /* 46 */
Tcl_ListObjLength, /* 47 */
Tcl_ListObjReplace, /* 48 */
- Tcl_NewBooleanObj, /* 49 */
+ 0, /* 49 */
Tcl_NewByteArrayObj, /* 50 */
Tcl_NewDoubleObj, /* 51 */
- Tcl_NewIntObj, /* 52 */
+ 0, /* 52 */
Tcl_NewListObj, /* 53 */
- Tcl_NewLongObj, /* 54 */
+ 0, /* 54 */
Tcl_NewObj, /* 55 */
Tcl_NewStringObj, /* 56 */
- Tcl_SetBooleanObj, /* 57 */
+ 0, /* 57 */
Tcl_SetByteArrayLength, /* 58 */
Tcl_SetByteArrayObj, /* 59 */
Tcl_SetDoubleObj, /* 60 */
- Tcl_SetIntObj, /* 61 */
+ 0, /* 61 */
Tcl_SetListObj, /* 62 */
- Tcl_SetLongObj, /* 63 */
+ 0, /* 63 */
Tcl_SetObjLength, /* 64 */
Tcl_SetStringObj, /* 65 */
Tcl_AddErrorInfo, /* 66 */
diff --git a/generic/tclTest.c b/generic/tclTest.c
index ad975c0..1293a57 100644
--- a/generic/tclTest.c
+++ b/generic/tclTest.c
@@ -5204,7 +5204,7 @@ TestmainthreadCmd(
const char **argv) /* Argument strings. */
{
if (argc == 1) {
- Tcl_Obj *idObj = Tcl_NewLongObj((long)(size_t)Tcl_GetCurrentThread());
+ Tcl_Obj *idObj = Tcl_NewWideIntObj((Tcl_WideInt)(size_t)Tcl_GetCurrentThread());
Tcl_SetObjResult(interp, idObj);
return TCL_OK;
@@ -5601,8 +5601,8 @@ TestChannelCmd(
return TCL_ERROR;
}
- TclFormatInt(buf, (size_t) Tcl_GetChannelThread(chan));
- Tcl_AppendResult(interp, buf, NULL);
+ Tcl_SetObjResult(interp, Tcl_NewWideIntObj(
+ (Tcl_WideInt) (size_t) Tcl_GetChannelThread(chan)));
return TCL_OK;
}
diff --git a/generic/tclThreadTest.c b/generic/tclThreadTest.c
index 9c5fecb..a008799 100644
--- a/generic/tclThreadTest.c
+++ b/generic/tclThreadTest.c
@@ -248,7 +248,7 @@ ThreadObjCmd(
switch ((enum options)option) {
case THREAD_CANCEL: {
- long id;
+ Tcl_WideInt id;
const char *result;
int flags, arg;
@@ -264,7 +264,7 @@ ThreadObjCmd(
arg++;
}
}
- if (Tcl_GetLongFromObj(interp, objv[arg], &id) != TCL_OK) {
+ if (Tcl_GetWideIntFromObj(interp, objv[arg], &id) != TCL_OK) {
return TCL_ERROR;
}
arg++;
diff --git a/generic/tclUtil.c b/generic/tclUtil.c
index 1a71667..a7afa0d 100644
--- a/generic/tclUtil.c
+++ b/generic/tclUtil.c
@@ -3331,7 +3331,7 @@ TclGetIntForIndex(
* be converted to one, use it.
*/
- *indexPtr = endValue + objPtr->internalRep.wideValue;
+ *indexPtr = endValue + (int)objPtr->internalRep.wideValue;
return TCL_OK;
}
diff --git a/generic/tclVar.c b/generic/tclVar.c
index 79d505b..20f2e2d 100644
--- a/generic/tclVar.c
+++ b/generic/tclVar.c
@@ -280,7 +280,7 @@ CleanupVar(
{
if (TclIsVarUndefined(varPtr) && TclIsVarInHash(varPtr)
&& !TclIsVarTraced(varPtr)
- && (VarHashRefCount(varPtr) == !TclIsVarDeadHash(varPtr))) {
+ && (VarHashRefCount(varPtr) == (unsigned)!TclIsVarDeadHash(varPtr))) {
if (VarHashRefCount(varPtr) == 0) {
ckfree(varPtr);
} else {
@@ -289,7 +289,7 @@ CleanupVar(
}
if (arrayPtr != NULL && TclIsVarUndefined(arrayPtr) &&
TclIsVarInHash(arrayPtr) && !TclIsVarTraced(arrayPtr) &&
- (VarHashRefCount(arrayPtr) == !TclIsVarDeadHash(arrayPtr))) {
+ (VarHashRefCount(arrayPtr) == (unsigned)!TclIsVarDeadHash(arrayPtr))) {
if (VarHashRefCount(arrayPtr) == 0) {
ckfree(arrayPtr);
} else {
diff --git a/tests/chanio.test b/tests/chanio.test
index 92f1c03..97e7e70 100644
--- a/tests/chanio.test
+++ b/tests/chanio.test
@@ -5345,7 +5345,7 @@ test chan-io-40.2 {POSIX open access modes: CREAT} -setup {
lappend x [chan gets $f]
} -cleanup {
chan close $f
-} -result {0600 {line 1}}
+} -result {0o600 {line 1}}
test chan-io-40.3 {POSIX open access modes: CREAT} -setup {
file delete $path(test3)
} -constraints {unix umask} -body {
@@ -5353,7 +5353,7 @@ test chan-io-40.3 {POSIX open access modes: CREAT} -setup {
chan close [open $path(test3) {WRONLY CREAT}]
file stat $path(test3) stats
format "%#o" [expr $stats(mode)&0o777]
-} -result [format %#4o [expr {0o666 & ~ $umaskValue}]]
+} -result [format %#5o [expr {0o666 & ~ $umaskValue}]]
test chan-io-40.4 {POSIX open access modes: CREAT} -setup {
file delete $path(test3)
} -body {
diff --git a/tests/expr.test b/tests/expr.test
index 12a0a2e..695469b 100644
--- a/tests/expr.test
+++ b/tests/expr.test
@@ -5799,6 +5799,15 @@ test expr-32.5 {Bug 1585704} {
test expr-32.6 {Bug 1585704} {
expr -(1<<32)%(1<<63)
} [expr (1<<63)-(1<<32)]
+test expr-32.7 {bignum regression} {
+ expr {0%(1<<63)}
+} 0
+test expr-32.8 {bignum regression} {
+ expr {0%-(1<<63)}
+} 0
+test expr-32.9 {bignum regression} {
+ expr {0%-(1+(1<<63))}
+} 0
test expr-33.1 {parse largest long value} longIs32bit {
set max_long_str 2147483647
diff --git a/tests/format.test b/tests/format.test
index 094b7b3..d380b05 100644
--- a/tests/format.test
+++ b/tests/format.test
@@ -28,7 +28,7 @@ test format-1.1 {integer formatting} {
} { 34 16923 -12 -1}
test format-1.2 {integer formatting} {
format "%4d %4d %4d %4d %d %#x %#X" 6 34 16923 -12 -1 14 12
-} { 6 34 16923 -12 -1 0xe 0XC}
+} { 6 34 16923 -12 -1 0xe 0xC}
test format-1.3 {integer formatting} longIs32bit {
format "%4u %4u %4u %4u %d %#o" 6 34 16923 -12 -1 0
} { 6 34 16923 4294967284 -1 0}
@@ -54,40 +54,40 @@ test format-1.7.1 {integer formatting} longIs64bit {
} { 6 22 421b fffffffffffffff4}
test format-1.8 {integer formatting} longIs32bit {
format "%#x %#x %#X %#X %#x" 0 6 34 16923 -12 -1
-} {0x0 0x6 0X22 0X421B 0xfffffff4}
+} {0 0x6 0x22 0x421B 0xfffffff4}
test format-1.8.1 {integer formatting} longIs64bit {
format "%#x %#x %#X %#X %#x" 0 6 34 16923 -12 -1
-} {0x0 0x6 0X22 0X421B 0xfffffffffffffff4}
+} {0 0x6 0x22 0x421B 0xfffffffffffffff4}
test format-1.9 {integer formatting} longIs32bit {
format "%#5x %#20x %#20x %#20x %#20x" 0 6 34 16923 -12 -1
-} { 0x0 0x6 0x22 0x421b 0xfffffff4}
+} { 0 0x6 0x22 0x421b 0xfffffff4}
test format-1.9.1 {integer formatting} longIs64bit {
format "%#5x %#20x %#20x %#20x %#20x" 0 6 34 16923 -12 -1
-} { 0x0 0x6 0x22 0x421b 0xfffffffffffffff4}
+} { 0 0x6 0x22 0x421b 0xfffffffffffffff4}
test format-1.10 {integer formatting} longIs32bit {
format "%-#5x %-#20x %-#20x %-#20x %-#20x" 0 6 34 16923 -12 -1
-} {0x0 0x6 0x22 0x421b 0xfffffff4 }
+} {0 0x6 0x22 0x421b 0xfffffff4 }
test format-1.10.1 {integer formatting} longIs64bit {
format "%-#5x %-#20x %-#20x %-#20x %-#20x" 0 6 34 16923 -12 -1
-} {0x0 0x6 0x22 0x421b 0xfffffffffffffff4 }
+} {0 0x6 0x22 0x421b 0xfffffffffffffff4 }
test format-1.11 {integer formatting} longIs32bit {
format "%-#5o %-#20o %#-20o %#-20o %#-20o" 0 6 34 16923 -12 -1
-} {0 06 042 041033 037777777764 }
+} {0 0o6 0o42 0o41033 0o37777777764 }
test format-1.11.1 {integer formatting} longIs64bit {
format "%-#5o %-#20o %#-20o %#-20o %#-20o" 0 6 34 16923 -12 -1
-} {0 06 042 041033 01777777777777777777764}
+} {0 0o6 0o42 0o41033 0o1777777777777777777764}
test format-1.12 {integer formatting} {
format "%b %#b %#b %llb" 5 0 5 [expr {2**100}]
-} {101 0b0 0b101 10000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000}
+} {101 0 0b101 10000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000}
test format-1.13 {integer formatting} {
- format "%#d %#d %#d %#d %#d" 0 6 34 16923 -12 -1
-} {0d0 0d6 0d34 0d16923 -0d12}
+ format "%#0d %#0d %#0d %#0d %#0d" 0 6 34 16923 -12 -1
+} {0 6 34 16923 -12}
test format-1.14 {integer formatting} {
- format "%#5d %#20d %#20d %#20d %#20d" 0 6 34 16923 -12 -1
-} { 0d0 0d6 0d34 0d16923 -0d12}
+ format "%#05d %#020d %#020d %#020d %#020d" 0 6 34 16923 -12 -1
+} {00000 00000000000000000006 00000000000000000034 00000000000000016923 -0000000000000000012}
test format-1.15 {integer formatting} {
- format "%-#5d %-#20d %-#20d %-#20d %-#20d" 0 6 34 16923 -12 -1
-} {0d0 0d6 0d34 0d16923 -0d12 }
+ format "%-#05d %-#020d %-#020d %-#020d %-#020d" 0 6 34 16923 -12 -1
+} {00000 00000000000000000006 00000000000000000034 00000000000000016923 -0000000000000000012}
test format-2.1 {string formatting} {
@@ -561,7 +561,7 @@ test format-17.4 {testing %l with non-integer} {
} 1.000000
test format-17.5 {testing %llu with positive bignum} -body {
format %llu 0xabcdef0123456789abcdef
-} -returnCodes 1 -result {unsigned bignum format is invalid}
+} -result 207698809136909011942886895
test format-17.6 {testing %llu with negative number} -body {
format %llu -1
} -returnCodes 1 -result {unsigned bignum format is invalid}
diff --git a/tests/io.test b/tests/io.test
index f73f49a..20bb565 100644
--- a/tests/io.test
+++ b/tests/io.test
@@ -5638,7 +5638,7 @@ test io-40.2 {POSIX open access modes: CREAT} {unix} {
file delete $path(test3)
set f [open $path(test3) {WRONLY CREAT} 0o600]
file stat $path(test3) stats
- set x [format "0o%o" [expr $stats(mode)&0o777]]
+ set x [format "%#o" [expr $stats(mode)&0o777]]
puts $f "line 1"
close $f
set f [open $path(test3) r]
@@ -5653,7 +5653,7 @@ test io-40.3 {POSIX open access modes: CREAT} {unix umask} {
close $f
file stat $path(test3) stats
format "%#o" [expr $stats(mode)&0o777]
-} [format %#4o [expr {0o666 & ~ $umaskValue}]]
+} [format %#5o [expr {0o666 & ~ $umaskValue}]]
test io-40.4 {POSIX open access modes: CREAT} {
file delete $path(test3)
set f [open $path(test3) w]
diff --git a/tests/scan.test b/tests/scan.test
index 98c581b..1f32b9f 100644
--- a/tests/scan.test
+++ b/tests/scan.test
@@ -557,8 +557,8 @@ test scan-5.19 {bigint scanning invalid} -setup {
set a {};
} -body {
list [scan "207698809136909011942886895" \
- %llu a] $a
-} -returnCodes 1 -result {unsigned bignum scans are invalid}
+ %llu a] $a
+} -result {1 207698809136909011942886895}
test scan-6.1 {floating-point scanning} -setup {
set a {}; set b {}; set c {}; set d {}
diff --git a/tests/unixFCmd.test b/tests/unixFCmd.test
index 183c145..08eb664 100644
--- a/tests/unixFCmd.test
+++ b/tests/unixFCmd.test
@@ -221,12 +221,12 @@ test unixFCmd-2.5 {TclpCopyFile: copy attributes} -setup {
cleanup
} -constraints {unix notRoot} -body {
close [open tf1 a]
- file attributes tf1 -permissions 0472
+ file attributes tf1 -permissions 0o472
file copy tf1 tf2
file attributes tf2 -permissions
} -cleanup {
cleanup
-} -result 00472 ;# i.e. perms field of [exec ls -l tf2] is -r--rwx-w-
+} -result 0o472 ;# i.e. perms field of [exec ls -l tf2] is -r--rwx-w-
test unixFCmd-3.1 {CopyFile not done} {emptyTest unix notRoot} {
} {}
@@ -375,11 +375,11 @@ proc permcheck {testnum permList expected} {
set result
} $expected
}
-permcheck unixFCmd-17.5 rwxrwxrwx 00777
-permcheck unixFCmd-17.6 r--r---w- 00442
-permcheck unixFCmd-17.7 {0 u+rwx,g+r u-w o+rwx} {00000 00740 00540 00547}
-permcheck unixFCmd-17.11 --x--x--x 00111
-permcheck unixFCmd-17.12 {0 a+rwx} {00000 00777}
+permcheck unixFCmd-17.5 rwxrwxrwx 0o777
+permcheck unixFCmd-17.6 r--r---w- 0o442
+permcheck unixFCmd-17.7 {0 u+rwx,g+r u-w o+rwx} {00000 0o740 0o540 0o547}
+permcheck unixFCmd-17.11 --x--x--x 0o111
+permcheck unixFCmd-17.12 {0 a+rwx} {00000 0o777}
file delete -force -- foo.test
test unixFCmd-18.1 {Unix pwd} -constraints {unix notRoot nonPortable} -setup {
diff --git a/unix/configure b/unix/configure
index 3b16b6f..cffb454 100755
--- a/unix/configure
+++ b/unix/configure
@@ -4260,8 +4260,6 @@ $as_echo "#define TCL_CFGVAL_ENCODING \"iso8859-1\"" >>confdefs.h
#--------------------------------------------------------------------
# On a few very rare systems, all of the libm.a stuff is
# already in libc.a. Set compiler flags accordingly.
- # Also, Linux requires the "ieee" library for math to work
- # right (and it must appear before "-lm").
#--------------------------------------------------------------------
ac_fn_c_check_func "$LINENO" "sin" "ac_cv_func_sin"
@@ -4271,40 +4269,6 @@ else
MATH_LIBS="-lm"
fi
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for main in -lieee" >&5
-$as_echo_n "checking for main in -lieee... " >&6; }
-if ${ac_cv_lib_ieee_main+:} false; then :
- $as_echo_n "(cached) " >&6
-else
- ac_check_lib_save_LIBS=$LIBS
-LIBS="-lieee $LIBS"
-cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-
-
-int
-main ()
-{
-return main ();
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_link "$LINENO"; then :
- ac_cv_lib_ieee_main=yes
-else
- ac_cv_lib_ieee_main=no
-fi
-rm -f core conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
-LIBS=$ac_check_lib_save_LIBS
-fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_ieee_main" >&5
-$as_echo "$ac_cv_lib_ieee_main" >&6; }
-if test "x$ac_cv_lib_ieee_main" = xyes; then :
- MATH_LIBS="-lieee $MATH_LIBS"
-fi
-
#--------------------------------------------------------------------
# Interactive UNIX requires -linet instead of -lsocket, plus it
@@ -6908,7 +6872,7 @@ else
tcl_type_64bit="long long"
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
- # See if we should use long anyway Note that we substitute in the
+ # See if we could use long anyway Note that we substitute in the
# type that is our current guess for a 64-bit type inside this check
# program, so it should be modified only carefully...
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
@@ -6934,8 +6898,8 @@ fi
$as_echo "#define TCL_WIDE_INT_IS_LONG 1" >>confdefs.h
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: using long" >&5
-$as_echo "using long" >&6; }
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
+$as_echo "yes" >&6; }
else
cat >>confdefs.h <<_ACEOF
diff --git a/unix/tcl.m4 b/unix/tcl.m4
index fa7601e..a6abef1 100644
--- a/unix/tcl.m4
+++ b/unix/tcl.m4
@@ -2370,12 +2370,9 @@ AC_DEFUN([SC_TCL_LINK_LIBS], [
#--------------------------------------------------------------------
# On a few very rare systems, all of the libm.a stuff is
# already in libc.a. Set compiler flags accordingly.
- # Also, Linux requires the "ieee" library for math to work
- # right (and it must appear before "-lm").
#--------------------------------------------------------------------
AC_CHECK_FUNC(sin, MATH_LIBS="", MATH_LIBS="-lm")
- AC_CHECK_LIB(ieee, main, [MATH_LIBS="-lieee $MATH_LIBS"])
#--------------------------------------------------------------------
# Interactive UNIX requires -linet instead of -lsocket, plus it
@@ -2492,15 +2489,15 @@ AC_DEFUN([SC_TCL_64BIT_FLAGS], [
# See if the compiler knows natively about __int64
AC_TRY_COMPILE(,[__int64 value = (__int64) 0;],
tcl_type_64bit=__int64, tcl_type_64bit="long long")
- # See if we should use long anyway Note that we substitute in the
+ # See if we could use long anyway Note that we substitute in the
# type that is our current guess for a 64-bit type inside this check
# program, so it should be modified only carefully...
AC_TRY_COMPILE(,[switch (0) {
case 1: case (sizeof(]${tcl_type_64bit}[)==sizeof(long)): ;
}],tcl_cv_type_64bit=${tcl_type_64bit})])
if test "${tcl_cv_type_64bit}" = none ; then
- AC_DEFINE(TCL_WIDE_INT_IS_LONG, 1, [Are wide integers to be implemented with C 'long's?])
- AC_MSG_RESULT([using long])
+ AC_DEFINE(TCL_WIDE_INT_IS_LONG, 1, [Do 'long' and 'long long' have the same size (64-bit)?])
+ AC_MSG_RESULT([yes])
else
AC_DEFINE_UNQUOTED(TCL_WIDE_INT_TYPE,${tcl_cv_type_64bit},
[What type should be used to define wide integers?])
diff --git a/unix/tclConfig.h.in b/unix/tclConfig.h.in
index 4902083..c284cba 100644
--- a/unix/tclConfig.h.in
+++ b/unix/tclConfig.h.in
@@ -394,7 +394,7 @@
/* Does this platform have wide high-resolution clicks? */
#undef TCL_WIDE_CLICKS
-/* Are wide integers to be implemented with C 'long's? */
+/* Do Tcl_WideInt, 'long' and 'long long' all have the same size (64-bit) ? */
#undef TCL_WIDE_INT_IS_LONG
/* What type should be used to define wide integers? */
diff --git a/win/nmakehlp.c b/win/nmakehlp.c
index 025bb99..b759020 100644
--- a/win/nmakehlp.c
+++ b/win/nmakehlp.c
@@ -14,13 +14,8 @@
#define _CRT_SECURE_NO_DEPRECATE
#include <windows.h>
-#define NO_SHLWAPI_GDI
-#define NO_SHLWAPI_STREAM
-#define NO_SHLWAPI_REG
-#include <shlwapi.h>
#pragma comment (lib, "user32.lib")
#pragma comment (lib, "kernel32.lib")
-#pragma comment (lib, "shlwapi.lib")
#include <stdio.h>
#include <math.h>
@@ -74,7 +69,7 @@ main(
char msg[300];
DWORD dwWritten;
int chars;
- char *s;
+ const char *s;
/*
* Make sure children (cl.exe and link.exe) are kept quiet.
@@ -688,6 +683,17 @@ SubstituteFile(
return 0;
}
+BOOL FileExists(LPCTSTR szPath)
+{
+#ifndef INVALID_FILE_ATTRIBUTES
+ #define INVALID_FILE_ATTRIBUTES ((DWORD)-1)
+#endif
+ DWORD pathAttr = GetFileAttributes(szPath);
+ return (pathAttr != INVALID_FILE_ATTRIBUTES &&
+ !(pathAttr & FILE_ATTRIBUTE_DIRECTORY));
+}
+
+
/*
* QualifyPath --
*
@@ -701,13 +707,8 @@ QualifyPath(
const char *szPath)
{
char szCwd[MAX_PATH + 1];
- char szTmp[MAX_PATH + 1];
- char *p;
- GetCurrentDirectory(MAX_PATH, szCwd);
- while ((p = strchr(szPath, '/')) && *p)
- *p = '\\';
- PathCombine(szTmp, szCwd, szPath);
- PathCanonicalize(szCwd, szTmp);
+
+ GetFullPathName(szPath, sizeof(szCwd)-1, szCwd, NULL);
printf("%s\n", szCwd);
return 0;
}
@@ -765,7 +766,7 @@ static int LocateDependencyHelper(const char *dir, const char *keypath)
strncpy(path+dirlen+1, finfo.cFileName, sublen);
path[dirlen+1+sublen] = '\\';
strncpy(path+dirlen+1+sublen+1, keypath, keylen+1);
- if (PathFileExists(path)) {
+ if (FileExists(path)) {
/* Found a match, print to stdout */
path[dirlen+1+sublen] = '\0';
QualifyPath(path);
diff --git a/win/tclWinChan.c b/win/tclWinChan.c
index 2898db0..8ffb31f 100644
--- a/win/tclWinChan.c
+++ b/win/tclWinChan.c
@@ -1379,7 +1379,7 @@ TclWinOpenFileChannel(
infoPtr->flags = appendMode;
infoPtr->handle = handle;
infoPtr->dirty = 0;
- sprintf(channelName, "file%" TCL_I_MODIFIER "x", (size_t) infoPtr);
+ sprintf(channelName, "file%" TCL_Z_MODIFIER "x", (size_t) infoPtr);
infoPtr->channel = Tcl_CreateChannel(&fileChannelType, channelName,
infoPtr, permissions);
diff --git a/win/tclWinConsole.c b/win/tclWinConsole.c
index d148872..92643cf 100644
--- a/win/tclWinConsole.c
+++ b/win/tclWinConsole.c
@@ -1320,7 +1320,7 @@ TclWinOpenConsoleChannel(
* for instance).
*/
- sprintf(channelName, "file%" TCL_I_MODIFIER "x", (size_t) infoPtr);
+ sprintf(channelName, "file%" TCL_Z_MODIFIER "x", (size_t) infoPtr);
infoPtr->channel = Tcl_CreateChannel(&consoleChannelType, channelName,
infoPtr, permissions);
diff --git a/win/tclWinInt.h b/win/tclWinInt.h
index 65eb400..6bdaa67 100644
--- a/win/tclWinInt.h
+++ b/win/tclWinInt.h
@@ -40,12 +40,6 @@ typedef struct TclWinProcs {
MODULE_SCOPE TclWinProcs tclWinProcs;
-#ifdef _WIN64
-# define TCL_I_MODIFIER "I"
-#else
-# define TCL_I_MODIFIER ""
-#endif
-
/*
* Declarations of functions that are not accessible by way of the
* stubs table.
diff --git a/win/tclWinPipe.c b/win/tclWinPipe.c
index 55e4d73..d1b0596 100644
--- a/win/tclWinPipe.c
+++ b/win/tclWinPipe.c
@@ -1606,7 +1606,7 @@ TclpCreateCommandChannel(
* unique, in case channels share handles (stdin/stdout).
*/
- sprintf(channelName, "file%" TCL_I_MODIFIER "x", (size_t) infoPtr);
+ sprintf(channelName, "file%" TCL_Z_MODIFIER "x", (size_t) infoPtr);
infoPtr->channel = Tcl_CreateChannel(&pipeChannelType, channelName,
infoPtr, infoPtr->validMask);
diff --git a/win/tclWinSerial.c b/win/tclWinSerial.c
index acfeecb..d77a609 100644
--- a/win/tclWinSerial.c
+++ b/win/tclWinSerial.c
@@ -1442,7 +1442,7 @@ TclWinOpenSerialChannel(
* are shared between multiple channels (stdin/stdout).
*/
- sprintf(channelName, "file%" TCL_I_MODIFIER "x", (size_t) infoPtr);
+ sprintf(channelName, "file%" TCL_Z_MODIFIER "x", (size_t) infoPtr);
infoPtr->channel = Tcl_CreateChannel(&serialChannelType, channelName,
infoPtr, permissions);