summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--doc/binary.n2
-rw-r--r--generic/tclCmdIL.c36
-rw-r--r--generic/tclCmdMZ.c20
-rw-r--r--generic/tclInt.h26
-rw-r--r--generic/tclRegexp.c2
-rw-r--r--generic/tclScan.c4
-rw-r--r--generic/tclStringObj.c4
-rw-r--r--generic/tclZipfs.c106
-rw-r--r--generic/tclZlib.c12
-rw-r--r--tests/info.test2
-rw-r--r--tests/regexp.test2
-rw-r--r--tests/regexpComp.test2
-rw-r--r--tests/string.test8
-rw-r--r--tests/stringObj.test8
-rw-r--r--tests/tcltests.tcl2
-rw-r--r--tools/tcltk-man2html-utils.tcl24
16 files changed, 150 insertions, 110 deletions
diff --git a/doc/binary.n b/doc/binary.n
index 9ab694e..70f569b 100644
--- a/doc/binary.n
+++ b/doc/binary.n
@@ -82,6 +82,8 @@ RFC 2045 calls for base64 decoders to be non-strict.
.
The \fBhex\fR binary encoding converts each byte to a pair of hexadecimal
digits that represent the byte value as a hexadecimal integer.
+When encoding, lower characters are used.
+When decoding, upper and lower characters are accepted.
.RS
.PP
No options are supported during encoding. During decoding, the following
diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c
index b9fc84a..986dd49 100644
--- a/generic/tclCmdIL.c
+++ b/generic/tclCmdIL.c
@@ -2731,8 +2731,8 @@ Tcl_LremoveObjCmd(
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
- int i, idxc;
- int listLen, *idxv, prevIdx, first, num;
+ int i, idxc, listLen, prevIdx, first, num;
+ int *idxv;
Tcl_Obj *listObj;
/*
@@ -2960,7 +2960,8 @@ Tcl_LreplaceObjCmd(
Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_Obj *listPtr;
- int first, last, listLen, numToDelete, result;
+ int first, last;
+ int listLen, numToDelete, result;
if (objc < 4) {
Tcl_WrongNumArgs(interp, 1, objv,
@@ -2991,8 +2992,7 @@ Tcl_LreplaceObjCmd(
if (first == TCL_INDEX_NONE) {
first = 0;
- }
- if (first > listLen) {
+ } else if (first > listLen) {
first = listLen;
}
@@ -3140,9 +3140,10 @@ Tcl_LsearchObjCmd(
Tcl_Obj *const objv[]) /* Argument values. */
{
const char *bytes, *patternBytes;
- int i, match, index, result=TCL_OK, listc, length, elemLen, bisect;
+ int i, match, index, result=TCL_OK, listc, bisect;
+ int length, elemLen, start, groupSize, groupOffset, lower, upper;
int allocatedIndexVector = 0;
- int dataType, isIncreasing, lower, upper, start, groupSize, groupOffset;
+ int dataType, isIncreasing;
Tcl_WideInt patWide, objWide;
int allMatches, inlineReturn, negatedMatch, returnSubindices, noCase;
double patDouble, objDouble;
@@ -3514,7 +3515,7 @@ Tcl_LsearchObjCmd(
if (allMatches || inlineReturn) {
Tcl_ResetResult(interp);
} else {
- TclNewIntObj(itemPtr, TCL_INDEX_NONE);
+ TclNewIndexObj(itemPtr, TCL_INDEX_NONE);
Tcl_SetObjResult(interp, itemPtr);
}
goto done;
@@ -3645,7 +3646,7 @@ Tcl_LsearchObjCmd(
* our first match might not be the first occurrence.
* Consider: 0 0 0 1 1 1 2 2 2
*
- * To maintain consistancy with standard lsearch semantics, we
+ * To maintain consistency with standard lsearch semantics, we
* must find the leftmost occurrence of the pattern in the
* list. Thus we don't just stop searching here. This
* variation means that a search always makes log n
@@ -3719,8 +3720,7 @@ Tcl_LsearchObjCmd(
if (noCase) {
match = (TclUtfCasecmp(bytes, patternBytes) == 0);
} else {
- match = (memcmp(bytes, patternBytes,
- (size_t) length) == 0);
+ match = (memcmp(bytes, patternBytes, length) == 0);
}
}
break;
@@ -3804,10 +3804,10 @@ Tcl_LsearchObjCmd(
} else if (returnSubindices) {
int j;
- TclNewIntObj(itemPtr, i+groupOffset);
+ TclNewIndexObj(itemPtr, i+groupOffset);
for (j=0 ; j<sortInfo.indexc ; j++) {
Tcl_Obj *elObj;
- TclNewIntObj(elObj, TclIndexDecode(sortInfo.indexv[j], listc));
+ TclNewIndexObj(elObj, TclIndexDecode(sortInfo.indexv[j], listc));
Tcl_ListObjAppendElement(interp, itemPtr, elObj);
}
Tcl_ListObjAppendElement(interp, listPtr, itemPtr);
@@ -3827,16 +3827,16 @@ Tcl_LsearchObjCmd(
if (returnSubindices) {
int j;
- TclNewIntObj(itemPtr, index+groupOffset);
+ TclNewIndexObj(itemPtr, index+groupOffset);
for (j=0 ; j<sortInfo.indexc ; j++) {
Tcl_Obj *elObj;
- TclNewIntObj(elObj, TclIndexDecode(sortInfo.indexv[j], listc));
+ TclNewIndexObj(elObj, TclIndexDecode(sortInfo.indexv[j], listc));
Tcl_ListObjAppendElement(interp, itemPtr, elObj);
}
Tcl_SetObjResult(interp, itemPtr);
} else {
Tcl_Obj *elObj;
- TclNewIntObj(elObj, index);
+ TclNewIndexObj(elObj, index);
Tcl_SetObjResult(interp, elObj);
}
} else if (index < 0) {
@@ -4420,7 +4420,7 @@ Tcl_LsortObjCmd(
idx = elementPtr->payload.index;
for (j = 0; j < groupSize; j++) {
if (indices) {
- TclNewIntObj(objPtr, idx + j - groupOffset);
+ TclNewIndexObj(objPtr, idx + j - groupOffset);
newArray[i++] = objPtr;
Tcl_IncrRefCount(objPtr);
} else {
@@ -4432,7 +4432,7 @@ Tcl_LsortObjCmd(
}
} else if (indices) {
for (i=0; elementPtr != NULL ; elementPtr = elementPtr->nextPtr) {
- TclNewIntObj(objPtr, elementPtr->payload.index);
+ TclNewIndexObj(objPtr, elementPtr->payload.index);
newArray[i++] = objPtr;
Tcl_IncrRefCount(objPtr);
}
diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c
index f8f0004..bd689a6 100644
--- a/generic/tclCmdMZ.c
+++ b/generic/tclCmdMZ.c
@@ -385,12 +385,12 @@ Tcl_RegexpObjCmd(
end--;
}
} else {
- start = -1;
- end = -1;
+ start = TCL_INDEX_NONE;
+ end = TCL_INDEX_NONE;
}
- TclNewIntObj(objs[0], start);
- TclNewIntObj(objs[1], end);
+ TclNewIndexObj(objs[0], start);
+ TclNewIndexObj(objs[1], end);
newPtr = Tcl_NewListObj(2, objs);
} else {
@@ -1910,7 +1910,7 @@ StringIsCmd(
str_is_done:
if ((result == 0) && (failVarObj != NULL)) {
- TclNewIntObj(objPtr, failat);
+ TclNewIndexObj(objPtr, failat);
if (Tcl_ObjSetVar2(interp, failVarObj, NULL, objPtr, TCL_LEAVE_ERR_MSG) == NULL) {
return TCL_ERROR;
}
@@ -2543,7 +2543,7 @@ StringStartCmd(
cur += 1;
}
}
- TclNewIntObj(obj, cur);
+ TclNewIndexObj(obj, cur);
Tcl_SetObjResult(interp, obj);
return TCL_OK;
}
@@ -2604,7 +2604,7 @@ StringEndCmd(
} else {
cur = length;
}
- TclNewIntObj(obj, cur);
+ TclNewIndexObj(obj, cur);
Tcl_SetObjResult(interp, obj);
return TCL_OK;
}
@@ -3778,10 +3778,10 @@ TclNRSwitchObjCmd(
Tcl_Obj *rangeObjAry[2];
if (info.matches[j].end > 0) {
- TclNewIntObj(rangeObjAry[0], info.matches[j].start);
- TclNewIntObj(rangeObjAry[1], info.matches[j].end-1);
+ TclNewIndexObj(rangeObjAry[0], info.matches[j].start);
+ TclNewIndexObj(rangeObjAry[1], info.matches[j].end-1);
} else {
- TclNewIntObj(rangeObjAry[1], TCL_INDEX_NONE);
+ TclNewIndexObj(rangeObjAry[1], TCL_INDEX_NONE);
rangeObjAry[0] = rangeObjAry[1];
}
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 4e26bf3..ea83055 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -4326,7 +4326,7 @@ TclScaleTime(
/*
* Invalidate the string rep first so we can use the bytes value for our
* pointer chain, and signal an obj deletion (as opposed to shimmering) with
- * 'length == -1'.
+ * 'length == TCL_INDEX_NONE'.
* Use empty 'if ; else' to handle use in unbraced outer if/else conditions.
*/
@@ -4338,7 +4338,7 @@ TclScaleTime(
&& ((objPtr)->bytes != &tclEmptyString)) { \
ckfree((objPtr)->bytes); \
} \
- (objPtr)->length = -1; \
+ (objPtr)->length = TCL_INDEX_NONE; \
TclFreeObjStorage(objPtr); \
TclIncrObjsFreed(); \
} else { \
@@ -4360,7 +4360,7 @@ TclScaleTime(
*/
# define TclAllocObjStorageEx(interp, objPtr) \
- (objPtr) = (Tcl_Obj *) ckalloc(sizeof(Tcl_Obj))
+ (objPtr) = (Tcl_Obj *)ckalloc(sizeof(Tcl_Obj))
# define TclFreeObjStorageEx(interp, objPtr) \
ckfree(objPtr)
@@ -4510,7 +4510,7 @@ MODULE_SCOPE void TclDbInitNewObj(Tcl_Obj *objPtr, const char *file,
(objPtr)->bytes = &tclEmptyString; \
(objPtr)->length = 0; \
} else { \
- (objPtr)->bytes = (char *) ckalloc((len) + 1); \
+ (objPtr)->bytes = (char *)ckalloc((len) + 1); \
memcpy((objPtr)->bytes, (bytePtr) ? (bytePtr) : &tclEmptyString, (len)); \
(objPtr)->bytes[len] = '\0'; \
(objPtr)->length = (len); \
@@ -4902,6 +4902,9 @@ MODULE_SCOPE Tcl_LibraryInitProc Procbodytest_SafeInit;
TCL_DTRACE_OBJ_CREATE(objPtr); \
} while (0)
+#define TclNewIndexObj(objPtr, w) \
+ TclNewIntObj(objPtr, w)
+
#define TclNewDoubleObj(objPtr, d) \
do { \
TclIncrObjsAllocated(); \
@@ -4927,6 +4930,9 @@ MODULE_SCOPE Tcl_LibraryInitProc Procbodytest_SafeInit;
#define TclNewIntObj(objPtr, w) \
(objPtr) = Tcl_NewWideIntObj(w)
+#define TclNewIndexObj(objPtr, w) \
+ TclNewIntObj(objPtr, w)
+
#define TclNewDoubleObj(objPtr, d) \
(objPtr) = Tcl_NewDoubleObj(d)
@@ -4939,7 +4945,7 @@ MODULE_SCOPE Tcl_LibraryInitProc Procbodytest_SafeInit;
* sizeof(sLiteral "") will fail to compile otherwise.
*/
#define TclNewLiteralStringObj(objPtr, sLiteral) \
- TclNewStringObj((objPtr), (sLiteral), (int) (sizeof(sLiteral "") - 1))
+ TclNewStringObj((objPtr), (sLiteral), sizeof(sLiteral "") - 1)
/*
*----------------------------------------------------------------
@@ -4952,7 +4958,7 @@ MODULE_SCOPE Tcl_LibraryInitProc Procbodytest_SafeInit;
*/
#define TclDStringAppendLiteral(dsPtr, sLiteral) \
- Tcl_DStringAppend((dsPtr), (sLiteral), (int) (sizeof(sLiteral "") - 1))
+ Tcl_DStringAppend((dsPtr), (sLiteral), sizeof(sLiteral "") - 1)
#define TclDStringClear(dsPtr) \
Tcl_DStringSetLength((dsPtr), 0)
@@ -5093,12 +5099,12 @@ MODULE_SCOPE Tcl_LibraryInitProc Procbodytest_SafeInit;
TCL_CT_ASSERT((nbytes)<=sizeof(Tcl_Obj)); \
TclIncrObjsAllocated(); \
TclAllocObjStorageEx((interp), (_objPtr)); \
- *(void **)&memPtr = (void *) (_objPtr); \
+ *(void **)&(memPtr) = (void *) (_objPtr); \
} while (0)
#define TclSmallFreeEx(interp, memPtr) \
do { \
- TclFreeObjStorageEx((interp), (Tcl_Obj *) (memPtr)); \
+ TclFreeObjStorageEx((interp), (Tcl_Obj *)(memPtr)); \
TclIncrObjsFreed(); \
} while (0)
@@ -5108,12 +5114,12 @@ MODULE_SCOPE Tcl_LibraryInitProc Procbodytest_SafeInit;
Tcl_Obj *_objPtr; \
TCL_CT_ASSERT((nbytes)<=sizeof(Tcl_Obj)); \
TclNewObj(_objPtr); \
- *(void **)&memPtr = (void *) _objPtr; \
+ *(void **)&(memPtr) = (void *)_objPtr; \
} while (0)
#define TclSmallFreeEx(interp, memPtr) \
do { \
- Tcl_Obj *_objPtr = (Tcl_Obj *) memPtr; \
+ Tcl_Obj *_objPtr = (Tcl_Obj *)(memPtr); \
_objPtr->bytes = NULL; \
_objPtr->typePtr = NULL; \
_objPtr->refCount = 1; \
diff --git a/generic/tclRegexp.c b/generic/tclRegexp.c
index b7fbb81..8e588ac 100644
--- a/generic/tclRegexp.c
+++ b/generic/tclRegexp.c
@@ -677,7 +677,7 @@ TclRegAbout(
*/
TclNewObj(resultObj);
- TclNewIntObj(infoObj, regexpPtr->re.re_nsub);
+ TclNewIndexObj(infoObj, regexpPtr->re.re_nsub);
Tcl_ListObjAppendElement(NULL, resultObj, infoObj);
/*
diff --git a/generic/tclScan.c b/generic/tclScan.c
index 5568529..134f60d 100644
--- a/generic/tclScan.c
+++ b/generic/tclScan.c
@@ -34,7 +34,7 @@ typedef struct {
Tcl_UniChar end;
} Range;
-typedef struct CharSet {
+typedef struct {
int exclude; /* 1 if this is an exclusion set. */
int nchars;
Tcl_UniChar *chars;
@@ -1089,7 +1089,7 @@ Tcl_ScanObjCmd(
if (code == TCL_OK) {
if (underflow && (nconversions == 0)) {
if (numVars) {
- TclNewIntObj(objPtr, TCL_INDEX_NONE);
+ TclNewIndexObj(objPtr, TCL_INDEX_NONE);
} else {
if (objPtr) {
Tcl_SetListObj(objPtr, 0, NULL);
diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c
index 428f758..5b8f3a6 100644
--- a/generic/tclStringObj.c
+++ b/generic/tclStringObj.c
@@ -3688,7 +3688,7 @@ TclStringFirst(
}
}
firstEnd:
- TclNewIntObj(result, value);
+ TclNewIndexObj(result, value);
return result;
}
@@ -3775,7 +3775,7 @@ TclStringLast(
checkStr--;
}
lastEnd:
- TclNewIntObj(result, value);
+ TclNewIndexObj(result, value);
return result;
}
diff --git a/generic/tclZipfs.c b/generic/tclZipfs.c
index 98a2820..d9c6712 100644
--- a/generic/tclZipfs.c
+++ b/generic/tclZipfs.c
@@ -36,6 +36,39 @@
#include <dlfcn.h>
#endif
+/*
+ * Macros to report errors only if an interp is present.
+ */
+
+#define ZIPFS_ERROR(interp,errstr) \
+ do { \
+ if (interp) { \
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(errstr, -1)); \
+ } \
+ } while (0)
+#define ZIPFS_MEM_ERROR(interp) \
+ do { \
+ if (interp) { \
+ Tcl_SetObjResult(interp, Tcl_NewStringObj( \
+ "out of memory", -1)); \
+ Tcl_SetErrorCode(interp, "TCL", "MALLOC", NULL); \
+ } \
+ } while (0)
+#define ZIPFS_POSIX_ERROR(interp,errstr) \
+ do { \
+ if (interp) { \
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf( \
+ "%s: %s", errstr, Tcl_PosixError(interp))); \
+ } \
+ } while (0)
+#define ZIPFS_ERROR_CODE(interp,errcode) \
+ do { \
+ if (interp) { \
+ Tcl_SetErrorCode(interp, "TCL", "ZIPFS", errcode, NULL); \
+ } \
+ } while (0)
+
+
#ifdef HAVE_ZLIB
#include "zlib.h"
#include "crypt.h"
@@ -125,38 +158,6 @@
#define DEFAULT_WRITE_MAX_SIZE (2 * 1024 * 1024)
/*
- * Macros to report errors only if an interp is present.
- */
-
-#define ZIPFS_ERROR(interp,errstr) \
- do { \
- if (interp) { \
- Tcl_SetObjResult(interp, Tcl_NewStringObj(errstr, -1)); \
- } \
- } while (0)
-#define ZIPFS_MEM_ERROR(interp) \
- do { \
- if (interp) { \
- Tcl_SetObjResult(interp, Tcl_NewStringObj( \
- "out of memory", -1)); \
- Tcl_SetErrorCode(interp, "TCL", "MALLOC", NULL); \
- } \
- } while (0)
-#define ZIPFS_POSIX_ERROR(interp,errstr) \
- do { \
- if (interp) { \
- Tcl_SetObjResult(interp, Tcl_ObjPrintf( \
- "%s: %s", errstr, Tcl_PosixError(interp))); \
- } \
- } while (0)
-#define ZIPFS_ERROR_CODE(interp,errcode) \
- do { \
- if (interp) { \
- Tcl_SetErrorCode(interp, "TCL", "ZIPFS", errcode, NULL); \
- } \
- } while (0)
-
-/*
* Windows drive letters.
*/
@@ -5707,6 +5708,8 @@ TclZipfs_Init(
#endif /* HAVE_ZLIB */
}
+#ifdef HAVE_ZLIB
+
#if !defined(STATIC_BUILD)
static int
ZipfsAppHookFindTclInit(
@@ -5791,7 +5794,7 @@ ZipfsMountExitHandler(
}
}
-
+
/*
*-------------------------------------------------------------------------
*
@@ -5927,7 +5930,7 @@ TclZipfs_AppHook(
return version;
}
-#ifndef HAVE_ZLIB
+#else /* !HAVE_ZLIB */
/*
*-------------------------------------------------------------------------
@@ -5942,9 +5945,9 @@ TclZipfs_AppHook(
int
TclZipfs_Mount(
Tcl_Interp *interp, /* Current interpreter. */
- const char *mountPoint, /* Mount point path. */
- const char *zipname, /* Path to ZIP file to mount. */
- const char *passwd) /* Password for opening the ZIP, or NULL if
+ TCL_UNUSED(const char *), /* Mount point path. */
+ TCL_UNUSED(const char *), /* Path to ZIP file to mount. */
+ TCL_UNUSED(const char *)) /* Password for opening the ZIP, or NULL if
* the ZIP is unprotected. */
{
ZIPFS_ERROR(interp, "no zlib available");
@@ -5955,10 +5958,10 @@ TclZipfs_Mount(
int
TclZipfs_MountBuffer(
Tcl_Interp *interp, /* Current interpreter. NULLable. */
- const char *mountPoint, /* Mount point path. */
- unsigned char *data,
- size_t datalen,
- int copy)
+ TCL_UNUSED(const char *), /* Mount point path. */
+ TCL_UNUSED(unsigned char *),
+ TCL_UNUSED(size_t),
+ TCL_UNUSED(int))
{
ZIPFS_ERROR(interp, "no zlib available");
ZIPFS_ERROR_CODE(interp, "NO_ZLIB");
@@ -5968,12 +5971,31 @@ TclZipfs_MountBuffer(
int
TclZipfs_Unmount(
Tcl_Interp *interp, /* Current interpreter. */
- const char *mountPoint) /* Mount point path. */
+ TCL_UNUSED(const char *)) /* Mount point path. */
{
ZIPFS_ERROR(interp, "no zlib available");
ZIPFS_ERROR_CODE(interp, "NO_ZLIB");
return TCL_ERROR;
}
+
+const char *
+TclZipfs_AppHook(
+ TCL_UNUSED(int *), /*argcPtr*/
+#ifdef _WIN32
+ TCL_UNUSED(WCHAR ***)) /* argvPtr */
+#else /* !_WIN32 */
+ TCL_UNUSED(char ***)) /* Pointer to argv */
+#endif /* _WIN32 */
+{
+ return NULL;
+}
+
+Tcl_Obj *
+TclZipfs_TclLibrary(void)
+{
+ return NULL;
+}
+
#endif /* !HAVE_ZLIB */
/*
diff --git a/generic/tclZlib.c b/generic/tclZlib.c
index c9bc77f..daf2a91 100644
--- a/generic/tclZlib.c
+++ b/generic/tclZlib.c
@@ -4072,18 +4072,18 @@ Tcl_ZlibInflate(
unsigned int
Tcl_ZlibCRC32(
- unsigned int crc,
- const char *buf,
- int len)
+ TCL_UNUSED(unsigned int),
+ TCL_UNUSED(const unsigned char *),
+ TCL_UNUSED(int))
{
return 0;
}
unsigned int
Tcl_ZlibAdler32(
- unsigned int adler,
- const char *buf,
- int len)
+ TCL_UNUSED(unsigned int),
+ TCL_UNUSED(const unsigned char *),
+ TCL_UNUSED(int))
{
return 0;
}
diff --git a/tests/info.test b/tests/info.test
index 46f85e7..c17588f 100644
--- a/tests/info.test
+++ b/tests/info.test
@@ -101,7 +101,7 @@ test info-2.5 {info body option, returning bytecompiled bodies} -body {
# Fix for problem tested for in info-2.5 caused problems when
# procedure body had no string rep (i.e. was not yet bytecode)
# causing an empty string to be returned [Bug #545644]
-test info-2.6 {info body option, returning list bodies} nodep {
+test info-2.6 {info body option, returning list bodies} deprecated {
proc foo args [list subst bar]
list [string bytelength [info body foo]] \
[foo; string bytelength [info body foo]]
diff --git a/tests/regexp.test b/tests/regexp.test
index a44f2e3..f0f05a0 100644
--- a/tests/regexp.test
+++ b/tests/regexp.test
@@ -765,7 +765,7 @@ test regexp-19.2 {regsub null replacement} {
string equal $result $expected
} 1
-test regexp-20.1 {regsub shared object shimmering} -constraints nodep -body {
+test regexp-20.1 {regsub shared object shimmering} -constraints deprecated -body {
# Bug #461322
set a abcdefghijklmnopqurstuvwxyz
set b $a
diff --git a/tests/regexpComp.test b/tests/regexpComp.test
index e78c0df..a556b7a 100644
--- a/tests/regexpComp.test
+++ b/tests/regexpComp.test
@@ -793,7 +793,7 @@ test regexpComp-19.1 {regsub null replacement} {
}
} "\0a\0hel\0a\0lo\0a\0 14"
-test regexpComp-20.1 {regsub shared object shimmering} nodep {
+test regexpComp-20.1 {regsub shared object shimmering} deprecated {
evalInProc {
# Bug #461322
set a abcdefghijklmnopqurstuvwxyz
diff --git a/tests/string.test b/tests/string.test
index 6750a5c..7da50e9 100644
--- a/tests/string.test
+++ b/tests/string.test
@@ -1036,16 +1036,16 @@ test string-7.16.$noComp {string last, start index} {
run {string last Üa ÜadÜad end-1}
} 3
-test string-8.1.$noComp {string bytelength} nodep {
+test string-8.1.$noComp {string bytelength} deprecated {
list [catch {run {string bytelength}} msg] $msg
} {1 {wrong # args: should be "string bytelength string"}}
-test string-8.2.$noComp {string bytelength} nodep {
+test string-8.2.$noComp {string bytelength} deprecated {
list [catch {run {string bytelength a b}} msg] $msg
} {1 {wrong # args: should be "string bytelength string"}}
-test string-8.3.$noComp {string bytelength} nodep {
+test string-8.3.$noComp {string bytelength} deprecated {
run {string bytelength "\xC7"}
} 2
-test string-8.4.$noComp {string bytelength} nodep {
+test string-8.4.$noComp {string bytelength} deprecated {
run {string b ""}
} 0
diff --git a/tests/stringObj.test b/tests/stringObj.test
index 4402185..abe02b2 100644
--- a/tests/stringObj.test
+++ b/tests/stringObj.test
@@ -455,19 +455,19 @@ test stringObj-15.4 {Tcl_Append*ToObj: self appends} testobj {
teststringobj set 1 foo
teststringobj appendself 1 3
} foo
-test stringObj-15.5 {Tcl_Append*ToObj: self appends} {testobj tip389 nodep} {
+test stringObj-15.5 {Tcl_Append*ToObj: self appends} {testobj tip389 deprecated} {
teststringobj set 1 foo
teststringobj appendself2 1 0
} foofoo
-test stringObj-15.6 {Tcl_Append*ToObj: self appends} {testobj tip389 nodep} {
+test stringObj-15.6 {Tcl_Append*ToObj: self appends} {testobj tip389 deprecated} {
teststringobj set 1 foo
teststringobj appendself2 1 1
} foooo
-test stringObj-15.7 {Tcl_Append*ToObj: self appends} {testobj tip389 nodep} {
+test stringObj-15.7 {Tcl_Append*ToObj: self appends} {testobj tip389 deprecated} {
teststringobj set 1 foo
teststringobj appendself2 1 2
} fooo
-test stringObj-15.8 {Tcl_Append*ToObj: self appends} {testobj tip389 nodep} {
+test stringObj-15.8 {Tcl_Append*ToObj: self appends} {testobj tip389 deprecated} {
teststringobj set 1 foo
teststringobj appendself2 1 3
} foo
diff --git a/tests/tcltests.tcl b/tests/tcltests.tcl
index 61076f5..cc0d6a7 100644
--- a/tests/tcltests.tcl
+++ b/tests/tcltests.tcl
@@ -3,7 +3,7 @@
package require tcltest 2.5
namespace import ::tcltest::*
testConstraint exec [llength [info commands exec]]
-testConstraint nodep [expr {![tcl::build-info no-deprecate]}]
+testConstraint deprecated [expr {![tcl::build-info no-deprecate]}]
testConstraint debug [tcl::build-info debug]
testConstraint purify [tcl::build-info purify]
testConstraint debugpurify [
diff --git a/tools/tcltk-man2html-utils.tcl b/tools/tcltk-man2html-utils.tcl
index 98bbf86..78aa8ec 100644
--- a/tools/tcltk-man2html-utils.tcl
+++ b/tools/tcltk-man2html-utils.tcl
@@ -889,7 +889,9 @@ proc insert-cross-references {text} {
}
switch -exact -- $invert([lindex $offsets 1]) {
end-quote {
- append result [string range $text 0 [expr {$offset(quote)-1}]]
+ if {$offset(quote) > 0} {
+ append result [string range $text 0 [expr {$offset(quote)-1}]]
+ }
set body [string range $text [expr {$offset(quote)+2}] \
[expr {$offset(end-quote)-1}]]
set text [string range $text[set text ""] \
@@ -916,8 +918,10 @@ proc insert-cross-references {text} {
}
switch -exact -- $invert([lindex $offsets 1]) {
url - end-bold {
- append result \
- [string range $text 0 [expr {$offset(bold)-1}]]
+ if {$offset(bold) > 0} {
+ append result \
+ [string range $text 0 [expr {$offset(bold)-1}]]
+ }
set body [string range $text [expr {$offset(bold)+3}] \
[expr {$offset(end-bold)-1}]]
set text [string range $text[set text ""] \
@@ -939,8 +943,10 @@ proc insert-cross-references {text} {
}
}
c.tk - c.ttk - c.tcl - c.tdbc - c.itcl {
- append result [string range $text 0 \
- [expr {[lindex $offsets 0]-1}]]
+ if {[lindex $offsets 0] > 0} {
+ append result [string range $text 0 \
+ [expr {[lindex $offsets 0]-1}]]
+ }
regexp -indices -start [lindex $offsets 0] {\w+} $text range
set body [string range $text {*}$range]
set text [string range $text[set text ""] \
@@ -950,14 +956,18 @@ proc insert-cross-references {text} {
}
Tcl1 - Tcl2 {
set off [lindex $offsets 0]
- append result [string range $text 0 [expr {$off-1}]]
+ if {$off > 0} {
+ append result [string range $text 0 [expr {$off-1}]]
+ }
set text [string range $text[set text ""] [expr {$off+3}] end]
append result [cross-reference Tcl]
continue
}
url {
set off [lindex $offsets 0]
- append result [string range $text 0 [expr {$off-1}]]
+ if {$off > 0} {
+ append result [string range $text 0 [expr {$off-1}]]
+ }
regexp -indices -start $off {http://[\w/.-]+} $text range
set url [string range $text {*}$range]
append result "<a href=\"[string trimright $url .]\">$url</a>"
generated by cgit v0.12 at 2025-12-15 23:35:40 (GMT)