Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
Comment: | Eliminate dependency in test-suite on Unicode functions. Merge tip-548. Fix build with -DTCL_NO_DEPRECATED |
---|---|
Downloads: | Tarball | ZIP archive |
Timelines: | family | ancestors | descendants | both | utf-max |
Files: | files | file ages | folders |
SHA3-256: |
67ec088a1ce83a1d3b3b82fafc3be184 |
User & Date: | jan.nijtmans 2019-08-13 21:00:28.603 |
Context
2019-09-25
| ||
13:42 | Merge 8.7 check-in: be233f3e67 user: jan.nijtmans tags: utf-max | |
2019-08-13
| ||
21:00 | Eliminate dependency in test-suite on Unicode functions. Merge tip-548. Fix build with -DTCL_NO_DEPR... check-in: 67ec088a1c user: jan.nijtmans tags: utf-max | |
20:10 | Merge 8.7 check-in: 7b84ac200f user: jan.nijtmans tags: tip-548 | |
2019-08-12
| ||
20:49 | default TCL_UTF_MAX should still be 3 check-in: e48340686a user: jan.nijtmans tags: utf-max | |
Changes
Changes to generic/tclCmdMZ.c.
︙ | ︙ | |||
602 603 604 605 606 607 608 | int (*strCmpFn)(const Tcl_UniChar*,const Tcl_UniChar*,unsigned long); Tcl_UniChar *p; numMatches = 0; nocase = (cflags & TCL_REG_NOCASE); strCmpFn = nocase ? Tcl_UniCharNcasecmp : Tcl_UniCharNcmp; | | | | | | | | | 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 | int (*strCmpFn)(const Tcl_UniChar*,const Tcl_UniChar*,unsigned long); Tcl_UniChar *p; numMatches = 0; nocase = (cflags & TCL_REG_NOCASE); strCmpFn = nocase ? Tcl_UniCharNcasecmp : Tcl_UniCharNcmp; wsrc = Tcl_GetUnicodeFromObj(objv[0], &slen); wstring = Tcl_GetUnicodeFromObj(objv[1], &wlen); wsubspec = Tcl_GetUnicodeFromObj(objv[2], &wsublen); wend = wstring + wlen - (slen ? slen - 1 : 0); result = TCL_OK; if (slen == 0) { /* * regsub behavior for "" matches between each character. 'string * map' skips the "" case. */ if (wstring < wend) { resultPtr = Tcl_NewUnicodeObj(wstring, 0); Tcl_IncrRefCount(resultPtr); for (; wstring < wend; wstring++) { Tcl_AppendUnicodeToObj(resultPtr, wsubspec, wsublen); Tcl_AppendUnicodeToObj(resultPtr, wstring, 1); numMatches++; } wlen = 0; } } else { wsrclc = Tcl_UniCharToLower(*wsrc); for (p = wfirstChar = wstring; wstring < wend; wstring++) { if ((*wstring == *wsrc || (nocase && Tcl_UniCharToLower(*wstring)==wsrclc)) && (slen==1 || (strCmpFn(wstring, wsrc, (unsigned long) slen) == 0))) { if (numMatches == 0) { resultPtr = Tcl_NewUnicodeObj(wstring, 0); Tcl_IncrRefCount(resultPtr); } if (p != wstring) { Tcl_AppendUnicodeToObj(resultPtr, p, wstring - p); p = wstring + slen; } else { p += slen; } wstring = p - 1; Tcl_AppendUnicodeToObj(resultPtr, wsubspec, wsublen); numMatches++; } } if (numMatches) { wlen = wfirstChar + wlen - p; wstring = p; } |
︙ | ︙ | |||
695 696 697 698 699 700 701 | */ if (objv[1] == objv[0]) { objPtr = Tcl_DuplicateObj(objv[1]); } else { objPtr = objv[1]; } | | | | 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 | */ if (objv[1] == objv[0]) { objPtr = Tcl_DuplicateObj(objv[1]); } else { objPtr = objv[1]; } wstring = Tcl_GetUnicodeFromObj(objPtr, &wlen); if (objv[2] == objv[0]) { subPtr = Tcl_DuplicateObj(objv[2]); } else { subPtr = objv[2]; } if (!command) { wsubspec = Tcl_GetUnicodeFromObj(subPtr, &wsublen); } result = TCL_OK; /* * The following loop is to handle multiple matches within the same source * string; each iteration handles one match and its corresponding |
︙ | ︙ | |||
746 747 748 749 750 751 752 | Tcl_IncrRefCount(resultPtr); if (offset > 0) { /* * Copy the initial portion of the string in if an offset was * specified. */ | | | | 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 | Tcl_IncrRefCount(resultPtr); if (offset > 0) { /* * Copy the initial portion of the string in if an offset was * specified. */ Tcl_AppendUnicodeToObj(resultPtr, wstring, offset); } } numMatches++; /* * Copy the portion of the source string before the match to the * result variable. */ Tcl_RegExpGetInfo(regExpr, &info); start = info.matches[0].start; end = info.matches[0].end; Tcl_AppendUnicodeToObj(resultPtr, wstring + offset, start); /* * In command-prefix mode, the substitutions are added as quoted * arguments to the subSpec to form a command, that is then executed * and the result used as the string to substitute in. Actually, * everything is passed through Tcl_EvalObjv, as that's much faster. */ |
︙ | ︙ | |||
822 823 824 825 826 827 828 | Tcl_ResetResult(interp); /* * Refetch the unicode, in case the representation was smashed by * the user code. */ | | | | 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 | Tcl_ResetResult(interp); /* * Refetch the unicode, in case the representation was smashed by * the user code. */ wstring = Tcl_GetUnicodeFromObj(objPtr, &wlen); offset += end; if (end == 0 || start == end) { /* * Always consume at least one character of the input string * in order to prevent infinite loops, even when we * technically matched the empty string; we must not match * again at the same spot. */ if (offset < wlen) { Tcl_AppendUnicodeToObj(resultPtr, wstring + offset, 1); } offset++; } if (all) { continue; } else { break; |
︙ | ︙ | |||
863 864 865 866 867 868 869 | idx = 0; } else if (ch == '\\') { ch = wsrc[1]; if ((ch >= '0') && (ch <= '9')) { idx = ch - '0'; } else if ((ch == '\\') || (ch == '&')) { *wsrc = ch; | | | | | | | | 863 864 865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 930 931 932 933 | idx = 0; } else if (ch == '\\') { ch = wsrc[1]; if ((ch >= '0') && (ch <= '9')) { idx = ch - '0'; } else if ((ch == '\\') || (ch == '&')) { *wsrc = ch; Tcl_AppendUnicodeToObj(resultPtr, wfirstChar, wsrc - wfirstChar + 1); *wsrc = '\\'; wfirstChar = wsrc + 2; wsrc++; continue; } else { continue; } } else { continue; } if (wfirstChar != wsrc) { Tcl_AppendUnicodeToObj(resultPtr, wfirstChar, wsrc - wfirstChar); } if (idx <= info.nsubs) { subStart = info.matches[idx].start; subEnd = info.matches[idx].end; if ((subStart >= 0) && (subEnd >= 0)) { Tcl_AppendUnicodeToObj(resultPtr, wstring + offset + subStart, subEnd - subStart); } } if (*wsrc == '\\') { wsrc++; } wfirstChar = wsrc + 1; } if (wfirstChar != wsrc) { Tcl_AppendUnicodeToObj(resultPtr, wfirstChar, wsrc - wfirstChar); } if (end == 0) { /* * Always consume at least one character of the input string in * order to prevent infinite loops. */ if (offset < wlen) { Tcl_AppendUnicodeToObj(resultPtr, wstring + offset, 1); } offset++; } else { offset += end; if (start == end) { /* * We matched an empty string, which means we must go forward * one more step so we don't match again at the same spot. */ if (offset < wlen) { Tcl_AppendUnicodeToObj(resultPtr, wstring + offset, 1); } offset++; } } if (!all) { break; } |
︙ | ︙ | |||
944 945 946 947 948 949 950 | * On zero matches, just ignore the offset, since it shouldn't matter * to us in this case, and the user may have skewed it. */ resultPtr = objv[1]; Tcl_IncrRefCount(resultPtr); } else if (offset < wlen) { | | | 944 945 946 947 948 949 950 951 952 953 954 955 956 957 958 | * On zero matches, just ignore the offset, since it shouldn't matter * to us in this case, and the user may have skewed it. */ resultPtr = objv[1]; Tcl_IncrRefCount(resultPtr); } else if (offset < wlen) { Tcl_AppendUnicodeToObj(resultPtr, wstring + offset, wlen - offset); } if (objc == 4) { if (Tcl_ObjSetVar2(interp, objv[3], NULL, resultPtr, TCL_LEAVE_ERR_MSG) == NULL) { result = TCL_ERROR; } else { /* |
︙ | ︙ | |||
2076 2077 2078 2079 2080 2081 2082 | if (objv[objc-2] == objv[objc-1]) { sourceObj = Tcl_DuplicateObj(objv[objc-1]); copySource = 1; } else { sourceObj = objv[objc-1]; } | | | 2076 2077 2078 2079 2080 2081 2082 2083 2084 2085 2086 2087 2088 2089 2090 | if (objv[objc-2] == objv[objc-1]) { sourceObj = Tcl_DuplicateObj(objv[objc-1]); copySource = 1; } else { sourceObj = objv[objc-1]; } ustring1 = Tcl_GetUnicodeFromObj(sourceObj, &length1); if (length1 == 0) { /* * Empty input string, just stop now. */ goto done; } |
︙ | ︙ | |||
2105 2106 2107 2108 2109 2110 2111 | * identical to the multi-pair case. This will be >30% faster on * larger strings. */ int mapLen, u2lc; Tcl_UniChar *mapString; | | | | | | | 2105 2106 2107 2108 2109 2110 2111 2112 2113 2114 2115 2116 2117 2118 2119 2120 2121 2122 2123 2124 2125 2126 2127 2128 2129 2130 2131 2132 2133 2134 2135 2136 2137 2138 2139 2140 2141 2142 2143 2144 2145 2146 2147 2148 2149 2150 2151 2152 2153 2154 2155 2156 2157 2158 2159 2160 2161 2162 2163 2164 | * identical to the multi-pair case. This will be >30% faster on * larger strings. */ int mapLen, u2lc; Tcl_UniChar *mapString; ustring2 = Tcl_GetUnicodeFromObj(mapElemv[0], &length2); p = ustring1; if ((length2 > length1) || (length2 == 0)) { /* * Match string is either longer than input or empty. */ ustring1 = end; } else { mapString = Tcl_GetUnicodeFromObj(mapElemv[1], &mapLen); u2lc = (nocase ? Tcl_UniCharToLower(*ustring2) : 0); for (; ustring1 < end; ustring1++) { if (((*ustring1 == *ustring2) || (nocase&&Tcl_UniCharToLower(*ustring1)==u2lc)) && (length2==1 || strCmpFn(ustring1, ustring2, (unsigned long) length2) == 0)) { if (p != ustring1) { Tcl_AppendUnicodeToObj(resultPtr, p, ustring1-p); p = ustring1 + length2; } else { p += length2; } ustring1 = p - 1; Tcl_AppendUnicodeToObj(resultPtr, mapString, mapLen); } } } } else { Tcl_UniChar **mapStrings; int *mapLens, *u2lc = NULL; /* * Precompute pointers to the unicode string and length. This saves us * repeated function calls later, significantly speeding up the * algorithm. We only need the lowercase first char in the nocase * case. */ mapStrings = TclStackAlloc(interp, mapElemc*2*sizeof(Tcl_UniChar *)); mapLens = TclStackAlloc(interp, mapElemc * 2 * sizeof(int)); if (nocase) { u2lc = TclStackAlloc(interp, mapElemc * sizeof(int)); } for (index = 0; index < mapElemc; index++) { mapStrings[index] = Tcl_GetUnicodeFromObj(mapElemv[index], mapLens+index); if (nocase && ((index % 2) == 0)) { u2lc[index/2] = Tcl_UniCharToLower(*mapStrings[index]); } } for (p = ustring1; ustring1 < end; ustring1++) { for (index = 0; index < mapElemc; index += 2) { |
︙ | ︙ | |||
2174 2175 2176 2177 2178 2179 2180 | (end-ustring1 >= length2) && ((length2 == 1) || !strCmpFn(ustring2, ustring1, length2))) { if (p != ustring1) { /* * Put the skipped chars onto the result first. */ | | | | | 2174 2175 2176 2177 2178 2179 2180 2181 2182 2183 2184 2185 2186 2187 2188 2189 2190 2191 2192 2193 2194 2195 2196 2197 2198 2199 2200 2201 2202 2203 2204 2205 2206 2207 2208 2209 2210 2211 2212 2213 2214 2215 2216 2217 2218 2219 2220 2221 | (end-ustring1 >= length2) && ((length2 == 1) || !strCmpFn(ustring2, ustring1, length2))) { if (p != ustring1) { /* * Put the skipped chars onto the result first. */ Tcl_AppendUnicodeToObj(resultPtr, p, ustring1-p); p = ustring1 + length2; } else { p += length2; } /* * Adjust len to be full length of matched string. */ ustring1 = p - 1; /* * Append the map value to the unicode string. */ Tcl_AppendUnicodeToObj(resultPtr, mapStrings[index+1], mapLens[index+1]); break; } } } if (nocase) { TclStackFree(interp, u2lc); } TclStackFree(interp, mapLens); TclStackFree(interp, mapStrings); } if (p != ustring1) { /* * Put the rest of the unmapped chars onto result. */ Tcl_AppendUnicodeToObj(resultPtr, p, ustring1 - p); } Tcl_SetObjResult(interp, resultPtr); done: if (mapWithDict) { TclStackFree(interp, mapElemv); } if (copySource) { |
︙ | ︙ |
Changes to generic/tclDate.c.
︙ | ︙ | |||
89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 | * Bison generates several labels that happen to be unused. MS Visual C++ * doesn't like that, and complains. Tell it to shut up. */ #ifdef _MSC_VER #pragma warning( disable : 4102 ) #endif /* _MSC_VER */ /* * yyparse will accept a 'struct DateInfo' as its parameter; that's where the * parsed fields will be returned. */ typedef struct DateInfo { Tcl_Obj* messages; /* Error messages */ const char* separatrix; /* String separating messages */ time_t dateYear; time_t dateMonth; time_t dateDay; int dateHaveDate; time_t dateHour; time_t dateMinutes; time_t dateSeconds; | > > > > > > > > > > > | | 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 | * Bison generates several labels that happen to be unused. MS Visual C++ * doesn't like that, and complains. Tell it to shut up. */ #ifdef _MSC_VER #pragma warning( disable : 4102 ) #endif /* _MSC_VER */ /* * Meridian: am, pm, or 24-hour style. */ typedef enum _MERIDIAN { MERam, MERpm, MER24 } MERIDIAN; /* * yyparse will accept a 'struct DateInfo' as its parameter; that's where the * parsed fields will be returned. */ typedef struct DateInfo { Tcl_Obj* messages; /* Error messages */ const char* separatrix; /* String separating messages */ time_t dateYear; time_t dateMonth; time_t dateDay; int dateHaveDate; time_t dateHour; time_t dateMinutes; time_t dateSeconds; MERIDIAN dateMeridian; int dateHaveTime; time_t dateTimezone; int dateDSTmode; int dateHaveZone; time_t dateRelMonth; |
︙ | ︙ | |||
194 195 196 197 198 199 200 | /* * Daylight-savings mode: on, off, or not yet known. */ typedef enum _DSTMODE { DSTon, DSToff, DSTmaybe } DSTMODE; | < < < < < < < < < < < | 205 206 207 208 209 210 211 212 213 214 215 216 217 218 | /* * Daylight-savings mode: on, off, or not yet known. */ typedef enum _DSTMODE { DSTon, DSToff, DSTmaybe } DSTMODE; # ifndef YY_NULLPTR # if defined __cplusplus && 201103L <= __cplusplus # define YY_NULLPTR nullptr # else # define YY_NULLPTR 0 # endif |
︙ | ︙ |
Changes to generic/tclExecute.c.
︙ | ︙ | |||
5416 5417 5418 5419 5420 5421 5422 | if (value3Ptr == value2Ptr) { objResultPtr = valuePtr; goto doneStringMap; } else if (valuePtr == value2Ptr) { objResultPtr = value3Ptr; goto doneStringMap; } | | | | | | | | 5416 5417 5418 5419 5420 5421 5422 5423 5424 5425 5426 5427 5428 5429 5430 5431 5432 5433 5434 5435 5436 5437 5438 5439 5440 5441 5442 5443 5444 5445 5446 5447 5448 5449 5450 5451 5452 5453 5454 5455 5456 5457 5458 5459 5460 5461 5462 5463 5464 5465 5466 5467 5468 5469 5470 5471 5472 | if (value3Ptr == value2Ptr) { objResultPtr = valuePtr; goto doneStringMap; } else if (valuePtr == value2Ptr) { objResultPtr = value3Ptr; goto doneStringMap; } ustring1 = Tcl_GetUnicodeFromObj(valuePtr, &length); if (length == 0) { objResultPtr = valuePtr; goto doneStringMap; } ustring2 = Tcl_GetUnicodeFromObj(value2Ptr, &length2); if (length2 > length || length2 == 0) { objResultPtr = valuePtr; goto doneStringMap; } else if (length2 == length) { if (memcmp(ustring1, ustring2, sizeof(Tcl_UniChar) * length)) { objResultPtr = valuePtr; } else { objResultPtr = value3Ptr; } goto doneStringMap; } ustring3 = Tcl_GetUnicodeFromObj(value3Ptr, &length3); objResultPtr = Tcl_NewUnicodeObj(ustring1, 0); p = ustring1; end = ustring1 + length; for (; ustring1 < end; ustring1++) { if ((*ustring1 == *ustring2) && (length2==1 || memcmp(ustring1, ustring2, sizeof(Tcl_UniChar) * length2) == 0)) { if (p != ustring1) { Tcl_AppendUnicodeToObj(objResultPtr, p, ustring1-p); p = ustring1 + length2; } else { p += length2; } ustring1 = p - 1; Tcl_AppendUnicodeToObj(objResultPtr, ustring3, length3); } } if (p != ustring1) { /* * Put the rest of the unmapped chars onto result. */ Tcl_AppendUnicodeToObj(objResultPtr, p, ustring1 - p); } doneStringMap: TRACE_WITH_OBJ(("%.20s %.20s %.20s => ", O2S(value2Ptr), O2S(value3Ptr), O2S(valuePtr)), objResultPtr); NEXT_INST_V(1, 3, 1); case INST_STR_FIND: |
︙ | ︙ | |||
5486 5487 5488 5489 5490 5491 5492 | NEXT_INST_F(1, 2, 1); case INST_STR_CLASS: opnd = TclGetInt1AtPtr(pc+1); valuePtr = OBJ_AT_TOS; TRACE(("%s \"%.30s\" => ", tclStringClassTable[opnd].name, O2S(valuePtr))); | | | 5486 5487 5488 5489 5490 5491 5492 5493 5494 5495 5496 5497 5498 5499 5500 | NEXT_INST_F(1, 2, 1); case INST_STR_CLASS: opnd = TclGetInt1AtPtr(pc+1); valuePtr = OBJ_AT_TOS; TRACE(("%s \"%.30s\" => ", tclStringClassTable[opnd].name, O2S(valuePtr))); ustring1 = Tcl_GetUnicodeFromObj(valuePtr, &length); match = 1; if (length > 0) { end = ustring1 + length; for (p=ustring1 ; p<end ; p++) { if (!tclStringClassTable[opnd].comparator(*p)) { match = 0; break; |
︙ | ︙ | |||
5515 5516 5517 5518 5519 5520 5521 | * both. */ if (TclHasIntRep(valuePtr, &tclStringType) || TclHasIntRep(value2Ptr, &tclStringType)) { Tcl_UniChar *ustring1, *ustring2; | | | | 5515 5516 5517 5518 5519 5520 5521 5522 5523 5524 5525 5526 5527 5528 5529 5530 | * both. */ if (TclHasIntRep(valuePtr, &tclStringType) || TclHasIntRep(value2Ptr, &tclStringType)) { Tcl_UniChar *ustring1, *ustring2; ustring1 = Tcl_GetUnicodeFromObj(valuePtr, &length); ustring2 = Tcl_GetUnicodeFromObj(value2Ptr, &length2); match = TclUniCharMatch(ustring1, length, ustring2, length2, nocase); } else if (TclIsPureByteArray(valuePtr) && !nocase) { unsigned char *bytes1, *bytes2; bytes1 = Tcl_GetByteArrayFromObj(valuePtr, &length); bytes2 = Tcl_GetByteArrayFromObj(value2Ptr, &length2); |
︙ | ︙ |
Changes to generic/tclGetDate.y.
︙ | ︙ | |||
41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 | * doesn't like that, and complains. Tell it to shut up. */ #ifdef _MSC_VER #pragma warning( disable : 4102 ) #endif /* _MSC_VER */ /* * yyparse will accept a 'struct DateInfo' as its parameter; that's where the * parsed fields will be returned. */ typedef struct DateInfo { Tcl_Obj* messages; /* Error messages */ const char* separatrix; /* String separating messages */ time_t dateYear; time_t dateMonth; time_t dateDay; int dateHaveDate; time_t dateHour; time_t dateMinutes; time_t dateSeconds; | > > > > > > > > | | 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 | * doesn't like that, and complains. Tell it to shut up. */ #ifdef _MSC_VER #pragma warning( disable : 4102 ) #endif /* _MSC_VER */ /* * Meridian: am, pm, or 24-hour style. */ typedef enum _MERIDIAN { MERam, MERpm, MER24 } MERIDIAN; /* * yyparse will accept a 'struct DateInfo' as its parameter; that's where the * parsed fields will be returned. */ typedef struct DateInfo { Tcl_Obj* messages; /* Error messages */ const char* separatrix; /* String separating messages */ time_t dateYear; time_t dateMonth; time_t dateDay; int dateHaveDate; time_t dateHour; time_t dateMinutes; time_t dateSeconds; MERIDIAN dateMeridian; int dateHaveTime; time_t dateTimezone; int dateDSTmode; int dateHaveZone; time_t dateRelMonth; |
︙ | ︙ | |||
146 147 148 149 150 151 152 | * Daylight-savings mode: on, off, or not yet known. */ typedef enum _DSTMODE { DSTon, DSToff, DSTmaybe } DSTMODE; | < < < < < < < < | 154 155 156 157 158 159 160 161 162 163 164 165 166 167 | * Daylight-savings mode: on, off, or not yet known. */ typedef enum _DSTMODE { DSTon, DSToff, DSTmaybe } DSTMODE; %} %union { time_t Number; enum _MERIDIAN Meridian; } |
︙ | ︙ |
Changes to generic/tclInt.decls.
︙ | ︙ | |||
1030 1031 1032 1033 1034 1035 1036 | } # TIP 431: temporary directory creation function declare 258 { Tcl_Obj *TclpCreateTemporaryDirectory(Tcl_Obj *dirObj, Tcl_Obj *basenameObj) } | < < < < < < < < < | 1030 1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 | } # TIP 431: temporary directory creation function declare 258 { Tcl_Obj *TclpCreateTemporaryDirectory(Tcl_Obj *dirObj, Tcl_Obj *basenameObj) } ############################################################################## # Define the platform specific internal Tcl interface. These functions are # only available on the designated platform. interface tclIntPlat |
︙ | ︙ |
Changes to generic/tclIntDecls.h.
︙ | ︙ | |||
654 655 656 657 658 659 660 | EXTERN void TclStaticPackage(Tcl_Interp *interp, const char *pkgName, Tcl_PackageInitProc *initProc, Tcl_PackageInitProc *safeInitProc); /* 258 */ EXTERN Tcl_Obj * TclpCreateTemporaryDirectory(Tcl_Obj *dirObj, Tcl_Obj *basenameObj); | < < < < < | 654 655 656 657 658 659 660 661 662 663 664 665 666 667 | EXTERN void TclStaticPackage(Tcl_Interp *interp, const char *pkgName, Tcl_PackageInitProc *initProc, Tcl_PackageInitProc *safeInitProc); /* 258 */ EXTERN Tcl_Obj * TclpCreateTemporaryDirectory(Tcl_Obj *dirObj, Tcl_Obj *basenameObj); typedef struct TclIntStubs { int magic; void *hooks; void (*reserved0)(void); void (*reserved1)(void); |
︙ | ︙ | |||
923 924 925 926 927 928 929 | Tcl_Obj * (*tclPtrGetVar) (Tcl_Interp *interp, Tcl_Var varPtr, Tcl_Var arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, const int flags); /* 252 */ Tcl_Obj * (*tclPtrSetVar) (Tcl_Interp *interp, Tcl_Var varPtr, Tcl_Var arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, Tcl_Obj *newValuePtr, const int flags); /* 253 */ Tcl_Obj * (*tclPtrIncrObjVar) (Tcl_Interp *interp, Tcl_Var varPtr, Tcl_Var arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, Tcl_Obj *incrPtr, const int flags); /* 254 */ int (*tclPtrObjMakeUpvar) (Tcl_Interp *interp, Tcl_Var otherPtr, Tcl_Obj *myNamePtr, int myFlags); /* 255 */ int (*tclPtrUnsetVar) (Tcl_Interp *interp, Tcl_Var varPtr, Tcl_Var arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, const int flags); /* 256 */ void (*tclStaticPackage) (Tcl_Interp *interp, const char *pkgName, Tcl_PackageInitProc *initProc, Tcl_PackageInitProc *safeInitProc); /* 257 */ Tcl_Obj * (*tclpCreateTemporaryDirectory) (Tcl_Obj *dirObj, Tcl_Obj *basenameObj); /* 258 */ | < < | 918 919 920 921 922 923 924 925 926 927 928 929 930 931 | Tcl_Obj * (*tclPtrGetVar) (Tcl_Interp *interp, Tcl_Var varPtr, Tcl_Var arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, const int flags); /* 252 */ Tcl_Obj * (*tclPtrSetVar) (Tcl_Interp *interp, Tcl_Var varPtr, Tcl_Var arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, Tcl_Obj *newValuePtr, const int flags); /* 253 */ Tcl_Obj * (*tclPtrIncrObjVar) (Tcl_Interp *interp, Tcl_Var varPtr, Tcl_Var arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, Tcl_Obj *incrPtr, const int flags); /* 254 */ int (*tclPtrObjMakeUpvar) (Tcl_Interp *interp, Tcl_Var otherPtr, Tcl_Obj *myNamePtr, int myFlags); /* 255 */ int (*tclPtrUnsetVar) (Tcl_Interp *interp, Tcl_Var varPtr, Tcl_Var arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, const int flags); /* 256 */ void (*tclStaticPackage) (Tcl_Interp *interp, const char *pkgName, Tcl_PackageInitProc *initProc, Tcl_PackageInitProc *safeInitProc); /* 257 */ Tcl_Obj * (*tclpCreateTemporaryDirectory) (Tcl_Obj *dirObj, Tcl_Obj *basenameObj); /* 258 */ } TclIntStubs; extern const TclIntStubs *tclIntStubsPtr; #ifdef __cplusplus } #endif |
︙ | ︙ | |||
1370 1371 1372 1373 1374 1375 1376 | (tclIntStubsPtr->tclPtrObjMakeUpvar) /* 255 */ #define TclPtrUnsetVar \ (tclIntStubsPtr->tclPtrUnsetVar) /* 256 */ #define TclStaticPackage \ (tclIntStubsPtr->tclStaticPackage) /* 257 */ #define TclpCreateTemporaryDirectory \ (tclIntStubsPtr->tclpCreateTemporaryDirectory) /* 258 */ | < < < < | 1363 1364 1365 1366 1367 1368 1369 1370 1371 1372 1373 1374 1375 1376 | (tclIntStubsPtr->tclPtrObjMakeUpvar) /* 255 */ #define TclPtrUnsetVar \ (tclIntStubsPtr->tclPtrUnsetVar) /* 256 */ #define TclStaticPackage \ (tclIntStubsPtr->tclStaticPackage) /* 257 */ #define TclpCreateTemporaryDirectory \ (tclIntStubsPtr->tclpCreateTemporaryDirectory) /* 258 */ #endif /* defined(USE_TCL_STUBS) */ /* !END!: Do not edit above this line. */ #undef TCL_STORAGE_CLASS #define TCL_STORAGE_CLASS DLLIMPORT |
︙ | ︙ |
Changes to generic/tclRegexp.c.
︙ | ︙ | |||
478 479 480 481 482 483 484 | /* * Save the target object so we can extract strings from it later. */ regexpPtr->string = NULL; regexpPtr->objPtr = textObj; | | | 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 | /* * Save the target object so we can extract strings from it later. */ regexpPtr->string = NULL; regexpPtr->objPtr = textObj; udata = Tcl_GetUnicodeFromObj(textObj, &length); if (offset > length) { offset = length; } udata += offset; length -= offset; |
︙ | ︙ |
Changes to generic/tclStringObj.c.
︙ | ︙ | |||
609 610 611 612 613 614 615 | #ifndef TCL_NO_DEPRECATED #undef Tcl_GetUnicode Tcl_UniChar * Tcl_GetUnicode( Tcl_Obj *objPtr) /* The object to find the unicode string * for. */ { | | | | | 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 | #ifndef TCL_NO_DEPRECATED #undef Tcl_GetUnicode Tcl_UniChar * Tcl_GetUnicode( Tcl_Obj *objPtr) /* The object to find the unicode string * for. */ { return Tcl_GetUnicodeFromObj(objPtr, NULL); } #endif /* TCL_NO_DEPRECATED */ /* *---------------------------------------------------------------------- * * Tcl_GetUnicodeFromObj -- * * Get the Unicode form of the String object with length. If the object * is not already a String object, it will be converted to one. If the * String object does not have a Unicode rep, then one is create from the * UTF string format. * * Results: * Returns a pointer to the object's internal Unicode string. * * Side effects: * Converts the object to have the String internal rep. * *---------------------------------------------------------------------- */ Tcl_UniChar * Tcl_GetUnicodeFromObj( Tcl_Obj *objPtr, /* The object to find the unicode string * for. */ int *lengthPtr) /* If non-NULL, the location where the string * rep's unichar length should be stored. If * NULL, no length is stored. */ { String *stringPtr; |
︙ | ︙ | |||
1230 1231 1232 1233 1234 1235 1236 | { Tcl_AppendLimitedToObj(objPtr, bytes, length, INT_MAX, NULL); } /* *---------------------------------------------------------------------- * | | | | 1230 1231 1232 1233 1234 1235 1236 1237 1238 1239 1240 1241 1242 1243 1244 1245 1246 1247 1248 1249 1250 1251 1252 1253 1254 1255 1256 1257 1258 1259 | { Tcl_AppendLimitedToObj(objPtr, bytes, length, INT_MAX, NULL); } /* *---------------------------------------------------------------------- * * Tcl_AppendUnicodeToObj -- * * This function appends a Unicode string to an object in the most * efficient manner possible. Length must be >= 0. * * Results: * None. * * Side effects: * Invalidates the string rep and creates a new Unicode string. * *---------------------------------------------------------------------- */ void Tcl_AppendUnicodeToObj( Tcl_Obj *objPtr, /* Points to the object to append to. */ const Tcl_UniChar *unicode, /* The unicode string to append to the * object. */ int length) /* Number of chars in "unicode". */ { String *stringPtr; |
︙ | ︙ | |||
1389 1390 1391 1392 1393 1394 1395 | if (stringPtr->hasUnicode) { /* * If appendObjPtr is not of the "String" type, don't convert it. */ if (TclHasIntRep(appendObjPtr, &tclStringType)) { Tcl_UniChar *unicode = | | | 1389 1390 1391 1392 1393 1394 1395 1396 1397 1398 1399 1400 1401 1402 1403 | if (stringPtr->hasUnicode) { /* * If appendObjPtr is not of the "String" type, don't convert it. */ if (TclHasIntRep(appendObjPtr, &tclStringType)) { Tcl_UniChar *unicode = Tcl_GetUnicodeFromObj(appendObjPtr, &numChars); AppendUnicodeToUnicodeRep(objPtr, unicode, numChars); } else { bytes = TclGetStringFromObj(appendObjPtr, &length); AppendUtfToUnicodeRep(objPtr, bytes, length); } return; |
︙ | ︙ | |||
2869 2870 2871 2872 2873 2874 2875 | } if (binary) { /* Result will be pure byte array. Pre-size it */ Tcl_GetByteArrayFromObj(objPtr, &length); } else if (unichar) { /* Result will be pure Tcl_UniChar array. Pre-size it. */ | | | 2869 2870 2871 2872 2873 2874 2875 2876 2877 2878 2879 2880 2881 2882 2883 | } if (binary) { /* Result will be pure byte array. Pre-size it */ Tcl_GetByteArrayFromObj(objPtr, &length); } else if (unichar) { /* Result will be pure Tcl_UniChar array. Pre-size it. */ Tcl_GetUnicodeFromObj(objPtr, &length); } else { /* Result will be concat of string reps. Pre-size it. */ Tcl_GetStringFromObj(objPtr, &length); } if (length == 0) { /* Any repeats of empty is empty. */ |
︙ | ︙ | |||
2930 2931 2932 2933 2934 2935 2936 | return NULL; } Tcl_SetObjLength(objResultPtr, length); while (count - done > done) { Tcl_AppendObjToObj(objResultPtr, objResultPtr); done *= 2; } | | | 2930 2931 2932 2933 2934 2935 2936 2937 2938 2939 2940 2941 2942 2943 2944 | return NULL; } Tcl_SetObjLength(objResultPtr, length); while (count - done > done) { Tcl_AppendObjToObj(objResultPtr, objResultPtr); done *= 2; } Tcl_AppendUnicodeToObj(objResultPtr, Tcl_GetUnicode(objResultPtr), (count - done) * length); } else { /* * Efficiently concatenate string reps. */ if (!inPlace || Tcl_IsShared(objPtr)) { |
︙ | ︙ | |||
3087 3088 3089 3090 3091 3092 3093 | oc = objc; do { Tcl_Obj *objPtr = *ov++; if ((objPtr->bytes == NULL) || (objPtr->length)) { int numChars; | | | 3087 3088 3089 3090 3091 3092 3093 3094 3095 3096 3097 3098 3099 3100 3101 | oc = objc; do { Tcl_Obj *objPtr = *ov++; if ((objPtr->bytes == NULL) || (objPtr->length)) { int numChars; Tcl_GetUnicodeFromObj(objPtr, &numChars); /* PANIC? */ if (numChars) { last = objc - oc; if (length == 0) { first = last; } else if (numChars > INT_MAX - length) { goto overflow; } |
︙ | ︙ | |||
3237 3238 3239 3240 3241 3242 3243 | if (inPlace && !Tcl_IsShared(*objv)) { int start; objResultPtr = *objv++; objc--; /* Ugly interface! Force resize of the unicode array. */ | | | 3237 3238 3239 3240 3241 3242 3243 3244 3245 3246 3247 3248 3249 3250 3251 | if (inPlace && !Tcl_IsShared(*objv)) { int start; objResultPtr = *objv++; objc--; /* Ugly interface! Force resize of the unicode array. */ Tcl_GetUnicodeFromObj(objResultPtr, &start); Tcl_InvalidateStringRep(objResultPtr); if (0 == Tcl_AttemptSetObjLength(objResultPtr, length)) { if (interp) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "concatenation failed: unable to alloc %" TCL_Z_MODIFIER "u bytes", STRING_SIZE(length))); |
︙ | ︙ | |||
3273 3274 3275 3276 3277 3278 3279 | dst = Tcl_GetUnicode(objResultPtr); } while (objc--) { Tcl_Obj *objPtr = *objv++; if ((objPtr->bytes == NULL) || (objPtr->length)) { int more; | | | 3273 3274 3275 3276 3277 3278 3279 3280 3281 3282 3283 3284 3285 3286 3287 | dst = Tcl_GetUnicode(objResultPtr); } while (objc--) { Tcl_Obj *objPtr = *objv++; if ((objPtr->bytes == NULL) || (objPtr->length)) { int more; Tcl_UniChar *src = Tcl_GetUnicodeFromObj(objPtr, &more); memcpy(dst, src, more * sizeof(Tcl_UniChar)); dst += more; } } } else { /* Efficiently concatenate string reps */ char *dst; |
︙ | ︙ | |||
3396 3397 3398 3399 3400 3401 3402 | * 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) { | | | | 3396 3397 3398 3399 3400 3401 3402 3403 3404 3405 3406 3407 3408 3409 3410 3411 | * 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) |
︙ | ︙ | |||
3607 3608 3609 3610 3611 3612 3613 | * locking down in practice more firmly just what encodings produce * what supported results for the objPtr->bytes values. For now, * do only the well-defined Tcl_UniChar array search. */ { Tcl_UniChar *check, *end, *uh; | | | | 3607 3608 3609 3610 3611 3612 3613 3614 3615 3616 3617 3618 3619 3620 3621 3622 3623 | * locking down in practice more firmly just what encodings produce * what supported results for the objPtr->bytes values. For now, * do only the well-defined Tcl_UniChar array search. */ { Tcl_UniChar *check, *end, *uh; Tcl_UniChar *un = Tcl_GetUnicodeFromObj(needle, &ln); uh = Tcl_GetUnicodeFromObj(haystack, &lh); if ((lh < ln) || (start > lh - ln)) { /* Don't start the loop if there cannot be a valid answer */ return -1; } end = uh + lh; for (check = uh + start; check + ln <= end; check++) { |
︙ | ︙ | |||
3686 3687 3688 3689 3690 3691 3692 | } check--; } return -1; } { | | | | 3686 3687 3688 3689 3690 3691 3692 3693 3694 3695 3696 3697 3698 3699 3700 3701 | } check--; } return -1; } { Tcl_UniChar *check, *uh = Tcl_GetUnicodeFromObj(haystack, &lh); Tcl_UniChar *un = Tcl_GetUnicodeFromObj(needle, &ln); if (last >= lh) { last = lh - 1; } if (last + 1 < ln) { /* Don't start the loop if there cannot be a valid answer */ return -1; |
︙ | ︙ | |||
3983 3984 3985 3986 3987 3988 3989 | * when it can be determined objPtr->bytes points to a string of * all single-byte characters so we can index it directly. */ /* The traditional implementation... */ { int numChars; | | | | 3983 3984 3985 3986 3987 3988 3989 3990 3991 3992 3993 3994 3995 3996 3997 3998 3999 4000 4001 4002 4003 4004 4005 4006 | * when it can be determined objPtr->bytes points to a string of * all single-byte characters so we can index it directly. */ /* The traditional implementation... */ { int numChars; Tcl_UniChar *ustring = Tcl_GetUnicodeFromObj(objPtr, &numChars); /* TODO: Is there an in-place option worth pursuing here? */ result = Tcl_NewUnicodeObj(ustring, first); if (insertPtr) { Tcl_AppendObjToObj(result, insertPtr); } if (first + count < numChars) { Tcl_AppendUnicodeToObj(result, ustring + first + count, numChars - first - count); } return result; } } |
︙ | ︙ |
Changes to generic/tclStubInit.c.
︙ | ︙ | |||
468 469 470 471 472 473 474 | # define TclFindNamespace Tcl_FindNamespace # define TclFindCommand Tcl_FindCommand # define TclGetCommandFromObj Tcl_GetCommandFromObj # define TclGetCommandFullName Tcl_GetCommandFullName # define TclpLocaltime_unix TclpLocaltime # define TclpGmtime_unix TclpGmtime # define TclOldFreeObj TclFreeObj | < < | 468 469 470 471 472 473 474 475 476 477 478 479 480 481 | # define TclFindNamespace Tcl_FindNamespace # define TclFindCommand Tcl_FindCommand # define TclGetCommandFromObj Tcl_GetCommandFromObj # define TclGetCommandFullName Tcl_GetCommandFullName # define TclpLocaltime_unix TclpLocaltime # define TclpGmtime_unix TclpGmtime # define TclOldFreeObj TclFreeObj static int seekOld( Tcl_Channel chan, /* The channel on which to seek. */ int offset, /* Offset to seek to. */ int mode) /* Relative to which location to seek? */ { |
︙ | ︙ | |||
775 776 777 778 779 780 781 | TclPtrGetVar, /* 252 */ TclPtrSetVar, /* 253 */ TclPtrIncrObjVar, /* 254 */ TclPtrObjMakeUpvar, /* 255 */ TclPtrUnsetVar, /* 256 */ TclStaticPackage, /* 257 */ TclpCreateTemporaryDirectory, /* 258 */ | < < | 773 774 775 776 777 778 779 780 781 782 783 784 785 786 | TclPtrGetVar, /* 252 */ TclPtrSetVar, /* 253 */ TclPtrIncrObjVar, /* 254 */ TclPtrObjMakeUpvar, /* 255 */ TclPtrUnsetVar, /* 256 */ TclStaticPackage, /* 257 */ TclpCreateTemporaryDirectory, /* 258 */ }; static const TclIntPlatStubs tclIntPlatStubs = { TCL_STUB_MAGIC, 0, #if !defined(_WIN32) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */ TclGetAndDetachPids, /* 0 */ |
︙ | ︙ |
Changes to generic/tclTestObj.c.
︙ | ︙ | |||
1174 1175 1176 1177 1178 1179 1180 | int varIndex, option, i, length; #define MAX_STRINGS 11 const char *index, *string, *strings[MAX_STRINGS+1]; String *strPtr; Tcl_Obj **varPtr; static const char *const options[] = { "append", "appendstrings", "get", "get2", "length", "length2", | | < | 1174 1175 1176 1177 1178 1179 1180 1181 1182 1183 1184 1185 1186 1187 1188 | int varIndex, option, i, length; #define MAX_STRINGS 11 const char *index, *string, *strings[MAX_STRINGS+1]; String *strPtr; Tcl_Obj **varPtr; static const char *const options[] = { "append", "appendstrings", "get", "get2", "length", "length2", "set", "set2", "setlength", "maxchars", "appendself", NULL }; if (objc < 3) { wrongNumArgs: Tcl_WrongNumArgs(interp, 1, objv, "option arg ?arg ...?"); return TCL_ERROR; } |
︙ | ︙ | |||
1340 1341 1342 1343 1344 1345 1346 | strPtr = varPtr[varIndex]->internalRep.twoPtrValue.ptr1; length = strPtr->maxChars; } else { length = -1; } Tcl_SetIntObj(Tcl_GetObjResult(interp), length); break; | | < < < < < < | 1339 1340 1341 1342 1343 1344 1345 1346 1347 1348 1349 1350 1351 1352 1353 | strPtr = varPtr[varIndex]->internalRep.twoPtrValue.ptr1; length = strPtr->maxChars; } else { length = -1; } Tcl_SetIntObj(Tcl_GetObjResult(interp), length); break; case 10: /* appendself */ if (objc != 4) { goto wrongNumArgs; } if (varPtr[varIndex] == NULL) { SetVarToObj(varPtr, varIndex, Tcl_NewObj()); } |
︙ | ︙ | |||
1377 1378 1379 1380 1381 1382 1383 | "index value out of range", -1)); return TCL_ERROR; } Tcl_AppendToObj(varPtr[varIndex], string + i, length - i); Tcl_SetObjResult(interp, varPtr[varIndex]); break; | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | 1370 1371 1372 1373 1374 1375 1376 1377 1378 1379 1380 1381 1382 1383 | "index value out of range", -1)); return TCL_ERROR; } Tcl_AppendToObj(varPtr[varIndex], string + i, length - i); Tcl_SetObjResult(interp, varPtr[varIndex]); break; } return TCL_OK; } /* *---------------------------------------------------------------------- |
︙ | ︙ |
Changes to generic/tclUtil.c.
︙ | ︙ | |||
2659 2660 2661 2662 2663 2664 2665 | * XXX: TclReToGlob tells us about trivial = nocase ? 0 : TclMatchIsTrivial(TclGetString(ptnObj)); */ if (TclHasIntRep(strObj, &tclStringType) || (strObj->typePtr == NULL)) { Tcl_UniChar *udata, *uptn; | | | | 2659 2660 2661 2662 2663 2664 2665 2666 2667 2668 2669 2670 2671 2672 2673 2674 | * XXX: TclReToGlob tells us about trivial = nocase ? 0 : TclMatchIsTrivial(TclGetString(ptnObj)); */ if (TclHasIntRep(strObj, &tclStringType) || (strObj->typePtr == NULL)) { Tcl_UniChar *udata, *uptn; udata = Tcl_GetUnicodeFromObj(strObj, &length); uptn = Tcl_GetUnicodeFromObj(ptnObj, &plen); match = TclUniCharMatch(udata, length, uptn, plen, flags); } else if (TclIsPureByteArray(strObj) && TclIsPureByteArray(ptnObj) && !flags) { unsigned char *data, *ptn; data = Tcl_GetByteArrayFromObj(strObj, &length); ptn = Tcl_GetByteArrayFromObj(ptnObj, &plen); |
︙ | ︙ |
Changes to tests/chanio.test.
︙ | ︙ | |||
39 40 41 42 43 44 45 46 47 48 49 50 51 52 | testConstraint testbytestring [llength [info commands testbytestring]] testConstraint testchannel [llength [info commands testchannel]] testConstraint openpipe 1 testConstraint testfevent [llength [info commands testfevent]] testConstraint testchannelevent [llength [info commands testchannelevent]] testConstraint testmainthread [llength [info commands testmainthread]] # You need a *very* special environment to do some tests. In particular, # many file systems do not support large-files... testConstraint largefileSupport [expr {$::tcl_platform(os) ne "Darwin"}] # some tests can only be run is umask is 2 if "umask" cannot be run, the # tests will be skipped. | > | 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 | testConstraint testbytestring [llength [info commands testbytestring]] testConstraint testchannel [llength [info commands testchannel]] testConstraint openpipe 1 testConstraint testfevent [llength [info commands testfevent]] testConstraint testchannelevent [llength [info commands testchannelevent]] testConstraint testmainthread [llength [info commands testmainthread]] testConstraint knownMsvcBug [expr {![info exists ::env(TRAVIS_OS_NAME)] || ![string match windows $::env(TRAVIS_OS_NAME)]}] # You need a *very* special environment to do some tests. In particular, # many file systems do not support large-files... testConstraint largefileSupport [expr {$::tcl_platform(os) ne "Darwin"}] # some tests can only be run is umask is 2 if "umask" cannot be run, the # tests will be skipped. |
︙ | ︙ | |||
2786 2787 2788 2789 2790 2791 2792 | variable x running set l abcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyz proc writelots {s l} { for {set i 0} {$i < 2000} {incr i} { chan puts $s $l } } | | | 2787 2788 2789 2790 2791 2792 2793 2794 2795 2796 2797 2798 2799 2800 2801 | variable x running set l abcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyz proc writelots {s l} { for {set i 0} {$i < 2000} {incr i} { chan puts $s $l } } } -constraints {socket tempNotMac fileevent knownMsvcBug} -body { proc accept {s a p} { variable x chan event $s readable [namespace code [list readit $s]] chan configure $s -blocking off set x accepted } proc readit {s} { |
︙ | ︙ |
Changes to tests/io.test.
︙ | ︙ | |||
39 40 41 42 43 44 45 46 47 48 49 50 51 52 | testConstraint testbytestring [llength [info commands testbytestring]] testConstraint testchannel [llength [info commands testchannel]] testConstraint openpipe 1 testConstraint testfevent [llength [info commands testfevent]] testConstraint testchannelevent [llength [info commands testchannelevent]] testConstraint testmainthread [llength [info commands testmainthread]] testConstraint testobj [llength [info commands testobj]] # You need a *very* special environment to do some tests. In # particular, many file systems do not support large-files... testConstraint largefileSupport [expr {$::tcl_platform(os) ne "Darwin"}] # some tests can only be run is umask is 2 # if "umask" cannot be run, the tests will be skipped. | > | 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 | testConstraint testbytestring [llength [info commands testbytestring]] testConstraint testchannel [llength [info commands testchannel]] testConstraint openpipe 1 testConstraint testfevent [llength [info commands testfevent]] testConstraint testchannelevent [llength [info commands testchannelevent]] testConstraint testmainthread [llength [info commands testmainthread]] testConstraint testobj [llength [info commands testobj]] testConstraint knownMsvcBug [expr {![info exists ::env(TRAVIS_OS_NAME)] || ![string match windows $::env(TRAVIS_OS_NAME)]}] # You need a *very* special environment to do some tests. In # particular, many file systems do not support large-files... testConstraint largefileSupport [expr {$::tcl_platform(os) ne "Darwin"}] # some tests can only be run is umask is 2 # if "umask" cannot be run, the tests will be skipped. |
︙ | ︙ | |||
2224 2225 2226 2227 2228 2229 2230 | close $f lappend l [file size $path(test1)] set l } {0 60 72} set path(pipe) [makeFile {} pipe] set path(output) [makeFile {} output] test io-27.6 {FlushChannel, async flushing, async close} \ | | | 2225 2226 2227 2228 2229 2230 2231 2232 2233 2234 2235 2236 2237 2238 2239 | close $f lappend l [file size $path(test1)] set l } {0 60 72} set path(pipe) [makeFile {} pipe] set path(output) [makeFile {} output] test io-27.6 {FlushChannel, async flushing, async close} \ {stdio asyncPipeClose openpipe knownMsvcBug} { # This test may fail on old Unix systems (seen on IRIX64 6.5) with # obsolete gettimeofday() calls. See Tcl Bugs 3530533, 1942197. file delete $path(pipe) file delete $path(output) set f [open $path(pipe) w] puts $f "set f \[[list open $path(output) w]]" puts $f { |
︙ | ︙ | |||
2828 2829 2830 2831 2832 2833 2834 | # allow a little time for the background process to close. # otherwise, the following test fails on the [file delete $path(output) # on Windows because a process still has the file open. after 100 set v 1; vwait v set result } ok test io-29.32 {Tcl_WriteChars, background flush to slow reader} \ | | | 2829 2830 2831 2832 2833 2834 2835 2836 2837 2838 2839 2840 2841 2842 2843 | # allow a little time for the background process to close. # otherwise, the following test fails on the [file delete $path(output) # on Windows because a process still has the file open. after 100 set v 1; vwait v set result } ok test io-29.32 {Tcl_WriteChars, background flush to slow reader} \ {stdio asyncPipeClose openpipe knownMsvcBug} { # This test may fail on old Unix systems (seen on IRIX64 6.5) with # obsolete gettimeofday() calls. See Tcl Bugs 3530533, 1942197. file delete $path(pipe) file delete $path(output) set f [open $path(pipe) w] puts $f "set f \[[list open $path(output) w]]" puts $f {fconfigure $f -translation lf} |
︙ | ︙ |
Changes to tests/stringObj.test.
︙ | ︙ | |||
435 436 437 438 439 440 441 | } 1 test stringObj-13.8 {Tcl_GetCharLength with identity nulls} {testobj testbytestring} { string length [testbytestring \x01\x00\x02] } 3 test stringObj-14.1 {Tcl_SetObjLength on pure unicode object} testobj { teststringobj set 1 foo | | | | 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 | } 1 test stringObj-13.8 {Tcl_GetCharLength with identity nulls} {testobj testbytestring} { string length [testbytestring \x01\x00\x02] } 3 test stringObj-14.1 {Tcl_SetObjLength on pure unicode object} testobj { teststringobj set 1 foo teststringobj maxchars 1 teststringobj append 1 bar -1 teststringobj maxchars 1 teststringobj append 1 bar -1 teststringobj setlength 1 0 teststringobj append 1 bar -1 teststringobj get 1 } {bar} test stringObj-15.1 {Tcl_Append*ToObj: self appends} testobj { |
︙ | ︙ |
Changes to tests/utf.test.
︙ | ︙ | |||
467 468 469 470 471 472 473 | test utf-25.1 {Tcl_UniCharNcasecmp} -constraints teststringobj \ -setup { testobj freeallvars } \ -body { teststringobj set 1 a teststringobj set 2 b | | | | | | | | | | 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 | test utf-25.1 {Tcl_UniCharNcasecmp} -constraints teststringobj \ -setup { testobj freeallvars } \ -body { teststringobj set 1 a teststringobj set 2 b teststringobj maxchars 1 teststringobj maxchars 2 string compare -nocase [teststringobj get 1] [teststringobj get 2] } \ -cleanup { testobj freeallvars } \ -result -1 test utf-25.2 {Tcl_UniCharNcasecmp} -constraints teststringobj \ -setup { testobj freeallvars } \ -body { teststringobj set 1 b teststringobj set 2 a teststringobj maxchars 1 teststringobj maxchars 2 string compare -nocase [teststringobj get 1] [teststringobj get 2] } \ -cleanup { testobj freeallvars } \ -result 1 test utf-25.3 {Tcl_UniCharNcasecmp} -constraints teststringobj \ -setup { testobj freeallvars } \ -body { teststringobj set 1 B teststringobj set 2 a teststringobj maxchars 1 teststringobj maxchars 2 string compare -nocase [teststringobj get 1] [teststringobj get 2] } \ -cleanup { testobj freeallvars } \ -result 1 test utf-25.4 {Tcl_UniCharNcasecmp} -constraints teststringobj \ -setup { testobj freeallvars } \ -body { teststringobj set 1 aBcB teststringobj set 2 abca teststringobj maxchars 1 teststringobj maxchars 2 string compare -nocase [teststringobj get 1] [teststringobj get 2] } \ -cleanup { testobj freeallvars } \ -result 1 |
︙ | ︙ |