From f55b154644dc0762d4241a5f83539702d70e62ce Mon Sep 17 00:00:00 2001 From: dkf Date: Fri, 14 Dec 2018 13:12:17 +0000 Subject: Why are we using rvm? Why? --- .travis.yml | 1 - generic/tclCmdMZ.c | 273 ++++++++++++++++++++++++++++------------------------- 2 files changed, 145 insertions(+), 129 deletions(-) diff --git a/.travis.yml b/.travis.yml index 947e858..e186e26 100644 --- a/.travis.yml +++ b/.travis.yml @@ -128,7 +128,6 @@ matrix: - NO_DIRECT_TEST=1 before_install: - - if [[ "$TRAVIS_OS_NAME" == "osx" ]]; then rvm get stable; fi - export ERROR_ON_FAILURES=1 - cd ${BUILD_DIR} install: diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c index 01c0a2d..602bd40 100644 --- a/generic/tclCmdMZ.c +++ b/generic/tclCmdMZ.c @@ -2687,13 +2687,32 @@ StringCmpCmd( return TCL_OK; } +/* + *---------------------------------------------------------------------- + * + * TclStringCmp -- + * + * This is the core of Tcl's string comparison. It only handles byte + * arrays, UNICODE strings and UTF-8 strings correctly. + * + * Results: + * -1 if value1Ptr is less than value2Ptr, 0 if they are equal, or 1 if + * value1Ptr is greater. + * + * Side effects: + * May cause string representations of objects to be allocated. + * + *---------------------------------------------------------------------- + */ + int TclStringCmp( Tcl_Obj *value1Ptr, Tcl_Obj *value2Ptr, int checkEq, /* comparison is only for equality */ int nocase, /* comparison is not case sensitive */ - int reqlength) /* requested length */ + int reqlength) /* requested length; -1 to compare whole + * strings */ { char *s1, *s2; int empty, length, match, s1len, s2len; @@ -2701,153 +2720,151 @@ TclStringCmp( if ((reqlength == 0) || (value1Ptr == value2Ptr)) { /* - * Always match at 0 chars of if it is the same obj. + * Always match at 0 chars or if it is the same obj. */ - match = 0; - } else { - if (!nocase && TclIsPureByteArray(value1Ptr) - && TclIsPureByteArray(value2Ptr)) { - /* - * Use binary versions of comparisons since that won't cause undue - * type conversions and it is much faster. Only do this if we're - * case-sensitive (which is all that really makes sense with byte - * arrays anyway, and we have no memcasecmp() for some reason... :^) - */ + return 0; + } - s1 = (char *) Tcl_GetByteArrayFromObj(value1Ptr, &s1len); - s2 = (char *) Tcl_GetByteArrayFromObj(value2Ptr, &s2len); - memCmpFn = memcmp; - } else if ((value1Ptr->typePtr == &tclStringType) - && (value2Ptr->typePtr == &tclStringType)) { - /* - * Do a unicode-specific comparison if both of the args are of - * String type. If the char length == byte length, we can do a - * memcmp. In benchmark testing this proved the most efficient - * check between the unicode and string comparison operations. - */ + if (!nocase && TclIsPureByteArray(value1Ptr) + && TclIsPureByteArray(value2Ptr)) { + /* + * Use binary versions of comparisons since that won't cause undue + * type conversions and it is much faster. Only do this if we're + * case-sensitive (which is all that really makes sense with byte + * arrays anyway, and we have no memcasecmp() for some reason... :^) + */ - if (nocase) { - s1 = (char *) Tcl_GetUnicodeFromObj(value1Ptr, &s1len); - s2 = (char *) Tcl_GetUnicodeFromObj(value2Ptr, &s2len); - memCmpFn = (memCmpFn_t)Tcl_UniCharNcasecmp; + s1 = (char *) Tcl_GetByteArrayFromObj(value1Ptr, &s1len); + s2 = (char *) Tcl_GetByteArrayFromObj(value2Ptr, &s2len); + memCmpFn = memcmp; + } else if ((value1Ptr->typePtr == &tclStringType) + && (value2Ptr->typePtr == &tclStringType)) { + /* + * Do a unicode-specific comparison if both of the args are of String + * type. If the char length == byte length, we can do a memcmp. In + * benchmark testing this proved the most efficient check between the + * unicode and string comparison operations. + */ + + if (nocase) { + s1 = (char *) Tcl_GetUnicodeFromObj(value1Ptr, &s1len); + s2 = (char *) Tcl_GetUnicodeFromObj(value2Ptr, &s2len); + memCmpFn = (memCmpFn_t)Tcl_UniCharNcasecmp; + } else { + s1len = Tcl_GetCharLength(value1Ptr); + s2len = Tcl_GetCharLength(value2Ptr); + if ((s1len == value1Ptr->length) + && (value1Ptr->bytes != NULL) + && (s2len == value2Ptr->length) + && (value2Ptr->bytes != NULL)) { + s1 = value1Ptr->bytes; + s2 = value2Ptr->bytes; + memCmpFn = memcmp; } else { - s1len = Tcl_GetCharLength(value1Ptr); - s2len = Tcl_GetCharLength(value2Ptr); - if ((s1len == value1Ptr->length) - && (value1Ptr->bytes != NULL) - && (s2len == value2Ptr->length) - && (value2Ptr->bytes != NULL)) { - s1 = value1Ptr->bytes; - s2 = value2Ptr->bytes; - memCmpFn = memcmp; - } else { - s1 = (char *) Tcl_GetUnicode(value1Ptr); - s2 = (char *) Tcl_GetUnicode(value2Ptr); - if ( + s1 = (char *) Tcl_GetUnicode(value1Ptr); + s2 = (char *) Tcl_GetUnicode(value2Ptr); + if ( #ifdef WORDS_BIGENDIAN - 1 + 1 #else - checkEq + checkEq #endif /* WORDS_BIGENDIAN */ - ) { - memCmpFn = memcmp; - s1len *= sizeof(Tcl_UniChar); - s2len *= sizeof(Tcl_UniChar); - } else { - memCmpFn = (memCmpFn_t) Tcl_UniCharNcmp; - } + ) { + memCmpFn = memcmp; + s1len *= sizeof(Tcl_UniChar); + s2len *= sizeof(Tcl_UniChar); + } else { + memCmpFn = (memCmpFn_t) Tcl_UniCharNcmp; } } - } else { - empty = TclCheckEmptyString(value1Ptr); - if (empty > 0) { - switch (TclCheckEmptyString(value2Ptr)) { - case -1: - s1 = ""; - s1len = 0; - s2 = TclGetStringFromObj(value2Ptr, &s2len); - break; - case 0: - match = -1; - goto matchdone; - case 1: - default: /* avoid warn: `s2` may be used uninitialized */ - match = 0; - goto matchdone; - } - } else if (TclCheckEmptyString(value2Ptr) > 0) { - switch (empty) { - case -1: - s2 = ""; - s2len = 0; - s1 = TclGetStringFromObj(value1Ptr, &s1len); - break; - case 0: - match = 1; - goto matchdone; - case 1: - default: /* avoid warn: `s1` may be used uninitialized */ - match = 0; - goto matchdone; - } - } else { - s1 = TclGetStringFromObj(value1Ptr, &s1len); + } + } else { + /* + * Get the string representations, being careful in case we have + * special empty string objects about. + */ + + empty = TclCheckEmptyString(value1Ptr); + if (empty > 0) { + switch (TclCheckEmptyString(value2Ptr)) { + case -1: + s1 = ""; + s1len = 0; s2 = TclGetStringFromObj(value2Ptr, &s2len); + break; + case 0: + return -1; + default: /* avoid warn: `s2` may be used uninitialized */ + return 0; } - if (!nocase && checkEq) { - /* - * When we have equal-length we can check only for - * (in)equality. We can use memcmp in all (n)eq cases because - * we don't need to worry about lexical LE/BE variance. - */ - memCmpFn = memcmp; - } else { - /* - * As a catch-all we will work with UTF-8. We cannot use - * memcmp() as that is unsafe with any string containing NUL - * (\xC0\x80 in Tcl's utf rep). We can use the more efficient - * TclpUtfNcmp2 if we are case-sensitive and no specific - * length was requested. - */ - - if ((reqlength < 0) && !nocase) { - memCmpFn = (memCmpFn_t) TclpUtfNcmp2; - } else { - s1len = Tcl_NumUtfChars(s1, s1len); - s2len = Tcl_NumUtfChars(s2, s2len); - memCmpFn = (memCmpFn_t) (nocase ? Tcl_UtfNcasecmp : Tcl_UtfNcmp); - } + } else if (TclCheckEmptyString(value2Ptr) > 0) { + switch (empty) { + case -1: + s2 = ""; + s2len = 0; + s1 = TclGetStringFromObj(value1Ptr, &s1len); + break; + case 0: + return 1; + default: /* avoid warn: `s1` may be used uninitialized */ + return 0; } + } else { + s1 = TclGetStringFromObj(value1Ptr, &s1len); + s2 = TclGetStringFromObj(value2Ptr, &s2len); } - length = (s1len < s2len) ? s1len : s2len; - if (reqlength > 0 && reqlength < length) { - length = reqlength; - } else if (reqlength < 0) { + if (!nocase && checkEq) { /* - * The requested length is negative, so we ignore it by setting it - * to length + 1 so we correct the match var. + * When we have equal-length we can check only for (in)equality. + * We can use memcmp() in all (n)eq cases because we don't need to + * worry about lexical LE/BE variance. */ - - reqlength = length + 1; - } - - if (checkEq && (s1len != s2len)) { - match = 1; /* This will be reversed below. */ - } else { + memCmpFn = memcmp; + } else { /* - * The comparison function should compare up to the minimum - * byte length only. + * As a catch-all we will work with UTF-8. We cannot use memcmp() + * as that is unsafe with any string containing NUL (\xC0\x80 in + * Tcl's utf rep). We can use the more efficient TclpUtfNcmp2 if + * we are case-sensitive and no specific length was requested. */ - match = memCmpFn(s1, s2, (size_t) length); - } - if ((match == 0) && (reqlength > length)) { - match = s1len - s2len; + + if ((reqlength < 0) && !nocase) { + memCmpFn = (memCmpFn_t) TclpUtfNcmp2; + } else { + s1len = Tcl_NumUtfChars(s1, s1len); + s2len = Tcl_NumUtfChars(s2, s2len); + memCmpFn = (memCmpFn_t) + (nocase ? Tcl_UtfNcasecmp : Tcl_UtfNcmp); + } } - match = (match > 0) ? 1 : (match < 0) ? -1 : 0; } - matchdone: - return match; + + length = (s1len < s2len) ? s1len : s2len; + if (reqlength > 0 && reqlength < length) { + length = reqlength; + } else if (reqlength < 0) { + /* + * The requested length is negative, so we ignore it by setting it to + * length + 1 so we correct the match var. + */ + + reqlength = length + 1; + } + + if (checkEq && (s1len != s2len)) { + match = 1; /* This will be reversed below. */ + } else { + /* + * The comparison function should compare up to the minimum byte + * length only. + */ + match = memCmpFn(s1, s2, (size_t) length); + } + if ((match == 0) && (reqlength > length)) { + match = s1len - s2len; + } + return (match > 0) ? 1 : (match < 0) ? -1 : 0; } int TclStringCmpOpts( -- cgit v0.12 From 4b795b56c88522adffddbfc839aae6beacdb809e Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 18 Dec 2018 19:49:09 +0000 Subject: No need for latest "rvm" any more in osx builds (now even gives an error) Remove unused/empty header-file --- .travis.yml | 1 - macosx/Tcl.xcode/project.pbxproj | 2 -- macosx/Tcl.xcodeproj/project.pbxproj | 2 -- win/tcl.dsp | 4 ---- win/tclWinThrd.h | 19 ------------------- 5 files changed, 28 deletions(-) delete mode 100644 win/tclWinThrd.h diff --git a/.travis.yml b/.travis.yml index 2ff31c0..46300b7 100644 --- a/.travis.yml +++ b/.travis.yml @@ -128,7 +128,6 @@ matrix: - NO_DIRECT_TEST=1 before_install: - - if [[ "$TRAVIS_OS_NAME" == "osx" ]]; then rvm get stable; fi - export ERROR_ON_FAILURES=1 - cd ${BUILD_DIR} install: diff --git a/macosx/Tcl.xcode/project.pbxproj b/macosx/Tcl.xcode/project.pbxproj index 83056c3..908c022 100644 --- a/macosx/Tcl.xcode/project.pbxproj +++ b/macosx/Tcl.xcode/project.pbxproj @@ -892,7 +892,6 @@ F96D449608F272BA004A47F5 /* tclWinSock.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclWinSock.c; sourceTree = ""; }; F96D449708F272BA004A47F5 /* tclWinTest.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclWinTest.c; sourceTree = ""; }; F96D449808F272BA004A47F5 /* tclWinThrd.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclWinThrd.c; sourceTree = ""; }; - F96D449908F272BA004A47F5 /* tclWinThrd.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tclWinThrd.h; sourceTree = ""; }; F96D449A08F272BA004A47F5 /* tclWinTime.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclWinTime.c; sourceTree = ""; }; F97AE7F10B65C1E900310EA2 /* Tcl-Common.xcconfig */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text.xcconfig; path = "Tcl-Common.xcconfig"; sourceTree = ""; }; F97AE82B0B65C69B00310EA2 /* Tcl-Release.xcconfig */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text.xcconfig; path = "Tcl-Release.xcconfig"; sourceTree = ""; }; @@ -1821,7 +1820,6 @@ F96D449608F272BA004A47F5 /* tclWinSock.c */, F96D449708F272BA004A47F5 /* tclWinTest.c */, F96D449808F272BA004A47F5 /* tclWinThrd.c */, - F96D449908F272BA004A47F5 /* tclWinThrd.h */, F96D449A08F272BA004A47F5 /* tclWinTime.c */, ); path = win; diff --git a/macosx/Tcl.xcodeproj/project.pbxproj b/macosx/Tcl.xcodeproj/project.pbxproj index 7b39b54..0cd2308 100644 --- a/macosx/Tcl.xcodeproj/project.pbxproj +++ b/macosx/Tcl.xcodeproj/project.pbxproj @@ -893,7 +893,6 @@ F96D449608F272BA004A47F5 /* tclWinSock.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclWinSock.c; sourceTree = ""; }; F96D449708F272BA004A47F5 /* tclWinTest.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclWinTest.c; sourceTree = ""; }; F96D449808F272BA004A47F5 /* tclWinThrd.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclWinThrd.c; sourceTree = ""; }; - F96D449908F272BA004A47F5 /* tclWinThrd.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tclWinThrd.h; sourceTree = ""; }; F96D449A08F272BA004A47F5 /* tclWinTime.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclWinTime.c; sourceTree = ""; }; F97AE7F10B65C1E900310EA2 /* Tcl-Common.xcconfig */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text.xcconfig; path = "Tcl-Common.xcconfig"; sourceTree = ""; }; F97AE82B0B65C69B00310EA2 /* Tcl-Release.xcconfig */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text.xcconfig; path = "Tcl-Release.xcconfig"; sourceTree = ""; }; @@ -1824,7 +1823,6 @@ F96D449608F272BA004A47F5 /* tclWinSock.c */, F96D449708F272BA004A47F5 /* tclWinTest.c */, F96D449808F272BA004A47F5 /* tclWinThrd.c */, - F96D449908F272BA004A47F5 /* tclWinThrd.h */, F96D449A08F272BA004A47F5 /* tclWinTime.c */, ); path = win; diff --git a/win/tcl.dsp b/win/tcl.dsp index 68920ad..2e5ad14 100644 --- a/win/tcl.dsp +++ b/win/tcl.dsp @@ -1556,10 +1556,6 @@ SOURCE=.\tclWinThrd.c # End Source File # Begin Source File -SOURCE=.\tclWinThrd.h -# End Source File -# Begin Source File - SOURCE=.\tclWinTime.c # End Source File # End Group diff --git a/win/tclWinThrd.h b/win/tclWinThrd.h deleted file mode 100644 index 41bc7aa..0000000 --- a/win/tclWinThrd.h +++ /dev/null @@ -1,19 +0,0 @@ -/* - * tclWinThrd.h -- - * - * This header file defines things for thread support. - * - * Copyright (c) 1998 Sun Microsystems, Inc. - * - * See the file "license.terms" for information on usage and redistribution - * of this file, and for a DISCLAIMER OF ALL WARRANTIES. - */ - -#ifndef _TCLWINTHRD -#define _TCLWINTHRD - -#ifdef TCL_THREADS - -#endif /* TCL_THREADS */ - -#endif /* _TCLWINTHRD */ -- cgit v0.12 From b143bb3fdde4bf18cf2ba4f8d7167108cd3b827c Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 18 Dec 2018 20:01:12 +0000 Subject: Internal minor optimization of TIP #502 implementation. No difference in any outcome. --- generic/tclCmdIL.c | 17 ++++++++--------- generic/tclCompCmdsSZ.c | 12 ++++++------ 2 files changed, 14 insertions(+), 15 deletions(-) diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c index dd11bac..03867b2 100644 --- a/generic/tclCmdIL.c +++ b/generic/tclCmdIL.c @@ -2606,7 +2606,7 @@ Tcl_LpopObjCmd( * First, extract the element to be returned. * TclLindexFlat adds a ref count which is handled. */ - + if (objc == 2) { elemPtr = elemPtrs[listLen - 1]; Tcl_IncrRefCount(elemPtr); @@ -2639,7 +2639,7 @@ Tcl_LpopObjCmd( return TCL_ERROR; } } - + listPtr = Tcl_ObjSetVar2(interp, objv[1], NULL, listPtr, TCL_LEAVE_ERR_MSG); if (listPtr == NULL) { return TCL_ERROR; @@ -3240,11 +3240,10 @@ Tcl_LsearchObjCmd( for (j=0 ; j= TCL_INDEX_START)) { + if ((first == TCL_INDEX_START) && (last >= TCL_INDEX_START)) { /* empty prefix */ tokenPtr = TokenAfter(tokenPtr); CompileWord(envPtr, tokenPtr, interp, 4); @@ -1156,10 +1156,10 @@ TclCompileStringReplaceCmd( * are harmless when they are replaced by another empty string. */ - if ((first == TCL_INDEX_BEFORE) || (first == TCL_INDEX_START)) { + if (first == TCL_INDEX_START) { /* empty prefix - build suffix only */ - if ((last == TCL_INDEX_END) || (last == TCL_INDEX_AFTER)) { + if (last == TCL_INDEX_END) { /* empty suffix too => empty result */ OP( POP); /* Pop original */ PUSH ( ""); @@ -1168,7 +1168,7 @@ TclCompileStringReplaceCmd( OP44( STR_RANGE_IMM, last + 1, TCL_INDEX_END); return TCL_OK; } else { - if ((last == TCL_INDEX_END) || (last == TCL_INDEX_AFTER)) { + if (last == TCL_INDEX_END) { /* empty suffix - build prefix only */ OP44( STR_RANGE_IMM, 0, first-1); return TCL_OK; -- cgit v0.12