Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
Comment: | merge trunk |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | dgp-trunk-read |
Files: | files | file ages | folders |
SHA1: |
15f3a695ca8960682ec0f138f75c3f2c |
User & Date: | dgp 2014-04-17 19:11:47 |
Context
2014-04-21
| ||
20:02 | merge trunk check-in: 58bcc7a29a user: dgp tags: dgp-trunk-read | |
2014-04-17
| ||
19:11 | merge trunk check-in: 15f3a695ca user: dgp tags: dgp-trunk-read | |
18:10 | Merge reflected channel improvements. check-in: 3c6eba5c93 user: dgp tags: trunk | |
2014-04-16
| ||
17:35 | merge trunk check-in: 505682a5bb user: dgp tags: dgp-trunk-read | |
Changes
Changes to generic/tclIORChan.c.
︙ | ︙ | |||
96 97 98 99 100 101 102 | * command is gone. */ #ifdef TCL_THREADS Tcl_ThreadId thread; /* Thread the 'interp' belongs to. == Handler thread */ Tcl_ThreadId owner; /* Thread owning the structure. == Channel thread */ #endif Tcl_Obj *cmd; /* Callback command prefix */ | | | < < < < | 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 | * command is gone. */ #ifdef TCL_THREADS Tcl_ThreadId thread; /* Thread the 'interp' belongs to. == Handler thread */ Tcl_ThreadId owner; /* Thread owning the structure. == Channel thread */ #endif Tcl_Obj *cmd; /* Callback command prefix */ Tcl_Obj *methods; /* Methods to append to command prefix */ Tcl_Obj *name; /* Name of the channel as created */ int mode; /* Mask of R/W mode */ int interest; /* Mask of events the channel is interested * in. */ int dead; /* Boolean signal that some operations * should no longer be attempted. */ |
︙ | ︙ | |||
429 430 431 432 433 434 435 | const char *objName, Tcl_Obj *obj, int *mask); static Tcl_Obj * DecodeEventMask(int mask); static ReflectedChannel * NewReflectedChannel(Tcl_Interp *interp, Tcl_Obj *cmdpfxObj, int mode, Tcl_Obj *handleObj); static Tcl_Obj * NextHandle(void); static void FreeReflectedChannel(ReflectedChannel *rcPtr); static int InvokeTclMethod(ReflectedChannel *rcPtr, | | < < | 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 | const char *objName, Tcl_Obj *obj, int *mask); static Tcl_Obj * DecodeEventMask(int mask); static ReflectedChannel * NewReflectedChannel(Tcl_Interp *interp, Tcl_Obj *cmdpfxObj, int mode, Tcl_Obj *handleObj); static Tcl_Obj * NextHandle(void); static void FreeReflectedChannel(ReflectedChannel *rcPtr); static int InvokeTclMethod(ReflectedChannel *rcPtr, MethodName method, Tcl_Obj *argOneObj, Tcl_Obj *argTwoObj, Tcl_Obj **resultObjPtr); static ReflectedChannelMap * GetReflectedChannelMap(Tcl_Interp *interp); static void DeleteReflectedChannelMap(ClientData clientData, Tcl_Interp *interp); static int ErrnoReturn(ReflectedChannel *rcPtr, Tcl_Obj *resObj); /* * Global constant strings (messages). ================== * These string are used directly as bypass errors, thus they have to be valid * Tcl lists where the last element is the message itself. Hence the * list-quoting to keep the words of the message together. See also [x]. */ static const char *msg_read_toomuch = "{read delivered more than requested}"; static const char *msg_write_toomuch = "{write wrote more than requested}"; static const char *msg_write_nothing = "{write wrote nothing}"; static const char *msg_seek_beforestart = "{Tried to seek before origin}"; #ifdef TCL_THREADS static const char *msg_send_originlost = "{Channel thread lost}"; static const char *msg_send_dstlost = "{Owner lost}"; #endif /* TCL_THREADS */ |
︙ | ︙ | |||
560 561 562 563 564 565 566 | /* * Now create the channel. */ rcId = NextHandle(); rcPtr = NewReflectedChannel(interp, cmdObj, mode, rcId); | < < < < < | | 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 | /* * Now create the channel. */ rcId = NextHandle(); rcPtr = NewReflectedChannel(interp, cmdObj, mode, rcId); /* * Invoke 'initialize' and validate that the handler is present and ok. * Squash the channel if not. * * Note: The conversion of 'mode' back into a Tcl_Obj ensures that * 'initialize' is invoked with canonical mode names, and no * abbreviations. Using modeObj directly could feed abbreviations into the * handler, and the handler is not specified to handle such. */ modeObj = DecodeEventMask(mode); /* assert modeObj.refCount == 1 */ result = InvokeTclMethod(rcPtr, METH_INIT, modeObj, NULL, &resObj); Tcl_DecrRefCount(modeObj); if (result != TCL_OK) { UnmarshallErrorResult(interp, resObj); Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */ goto error; } |
︙ | ︙ | |||
661 662 663 664 665 666 667 | Tcl_ResetResult(interp); /* * Everything is fine now. */ | > > | > > | 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 | Tcl_ResetResult(interp); /* * Everything is fine now. */ chan = Tcl_CreateChannel(&tclRChannelType, TclGetString(rcId), rcPtr, mode); rcPtr->chan = chan; Tcl_Preserve(chan); chanPtr = (Channel *) chan; if ((methods & NULLABLE_METHODS) != NULLABLE_METHODS) { /* * Some of the nullable methods are not supported. We clone the * channel type, null the associated C functions, and use the result * as the actual channel type. */ |
︙ | ︙ | |||
722 723 724 725 726 727 728 | */ Tcl_SetObjResult(interp, Tcl_NewStringObj(chanPtr->state->channelName, -1)); return TCL_OK; error: | < < < | | | > | 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 | */ Tcl_SetObjResult(interp, Tcl_NewStringObj(chanPtr->state->channelName, -1)); return TCL_OK; error: Tcl_DecrRefCount(rcPtr->name); Tcl_DecrRefCount(rcPtr->methods); Tcl_DecrRefCount(rcPtr->cmd); ckfree((char*) rcPtr); return TCL_ERROR; #undef MODE #undef CMD } /* |
︙ | ︙ | |||
1157 1158 1159 1160 1161 1162 1163 | } #endif Tcl_EventuallyFree(rcPtr, (Tcl_FreeProc *) FreeReflectedChannel); return EOK; } | < < < < < < < < < < < < | 1148 1149 1150 1151 1152 1153 1154 1155 1156 1157 1158 1159 1160 1161 | } #endif Tcl_EventuallyFree(rcPtr, (Tcl_FreeProc *) FreeReflectedChannel); return EOK; } /* * Are we in the correct thread? */ #ifdef TCL_THREADS if (rcPtr->thread != Tcl_GetCurrentThread()) { ForwardParam p; |
︙ | ︙ | |||
1193 1194 1195 1196 1197 1198 1199 | Tcl_EventuallyFree(rcPtr, (Tcl_FreeProc *) FreeReflectedChannel); if (result != TCL_OK) { PassReceivedErrorInterp(interp, &p); } } else { #endif | | | 1172 1173 1174 1175 1176 1177 1178 1179 1180 1181 1182 1183 1184 1185 1186 | Tcl_EventuallyFree(rcPtr, (Tcl_FreeProc *) FreeReflectedChannel); if (result != TCL_OK) { PassReceivedErrorInterp(interp, &p); } } else { #endif result = InvokeTclMethod(rcPtr, METH_FINAL, NULL, NULL, &resObj); if ((result != TCL_OK) && (interp != NULL)) { Tcl_SetChannelErrorInterp(interp, resObj); } Tcl_DecrRefCount(resObj); /* Remove reference we held from the * invoke */ |
︙ | ︙ | |||
1267 1268 1269 1270 1271 1272 1273 | { ReflectedChannel *rcPtr = clientData; Tcl_Obj *toReadObj; int bytec; /* Number of returned bytes */ unsigned char *bytev; /* Array of returned bytes */ Tcl_Obj *resObj; /* Result data for 'read' */ | < < < < < < < < < < < < | 1246 1247 1248 1249 1250 1251 1252 1253 1254 1255 1256 1257 1258 1259 | { ReflectedChannel *rcPtr = clientData; Tcl_Obj *toReadObj; int bytec; /* Number of returned bytes */ unsigned char *bytev; /* Array of returned bytes */ Tcl_Obj *resObj; /* Result data for 'read' */ /* * Are we in the correct thread? */ #ifdef TCL_THREADS if (rcPtr->thread != Tcl_GetCurrentThread()) { ForwardParam p; |
︙ | ︙ | |||
1317 1318 1319 1320 1321 1322 1323 | /* ASSERT: rcPtr->mode & TCL_READABLE */ Tcl_Preserve(rcPtr); toReadObj = Tcl_NewIntObj(toRead); Tcl_IncrRefCount(toReadObj); | | | 1284 1285 1286 1287 1288 1289 1290 1291 1292 1293 1294 1295 1296 1297 1298 | /* ASSERT: rcPtr->mode & TCL_READABLE */ Tcl_Preserve(rcPtr); toReadObj = Tcl_NewIntObj(toRead); Tcl_IncrRefCount(toReadObj); if (InvokeTclMethod(rcPtr, METH_READ, toReadObj, NULL, &resObj)!=TCL_OK) { int code = ErrnoReturn(rcPtr, resObj); if (code < 0) { *errorCodePtr = -code; goto error; } |
︙ | ︙ | |||
1382 1383 1384 1385 1386 1387 1388 | int *errorCodePtr) { ReflectedChannel *rcPtr = clientData; Tcl_Obj *bufObj; Tcl_Obj *resObj; /* Result data for 'write' */ int written; | < < < < < < < < < < < < | 1349 1350 1351 1352 1353 1354 1355 1356 1357 1358 1359 1360 1361 1362 | int *errorCodePtr) { ReflectedChannel *rcPtr = clientData; Tcl_Obj *bufObj; Tcl_Obj *resObj; /* Result data for 'write' */ int written; /* * Are we in the correct thread? */ #ifdef TCL_THREADS if (rcPtr->thread != Tcl_GetCurrentThread()) { ForwardParam p; |
︙ | ︙ | |||
1432 1433 1434 1435 1436 1437 1438 | /* ASSERT: rcPtr->mode & TCL_WRITABLE */ Tcl_Preserve(rcPtr); bufObj = Tcl_NewByteArrayObj((unsigned char *) buf, toWrite); Tcl_IncrRefCount(bufObj); | | | 1387 1388 1389 1390 1391 1392 1393 1394 1395 1396 1397 1398 1399 1400 1401 | /* ASSERT: rcPtr->mode & TCL_WRITABLE */ Tcl_Preserve(rcPtr); bufObj = Tcl_NewByteArrayObj((unsigned char *) buf, toWrite); Tcl_IncrRefCount(bufObj); if (InvokeTclMethod(rcPtr, METH_WRITE, bufObj, NULL, &resObj) != TCL_OK) { int code = ErrnoReturn(rcPtr, resObj); if (code < 0) { *errorCodePtr = -code; goto error; } |
︙ | ︙ | |||
1546 1547 1548 1549 1550 1551 1552 | offObj = Tcl_NewWideIntObj(offset); baseObj = Tcl_NewStringObj( (seekMode == SEEK_SET) ? "start" : (seekMode == SEEK_CUR) ? "current" : "end", -1); Tcl_IncrRefCount(offObj); Tcl_IncrRefCount(baseObj); | | | 1501 1502 1503 1504 1505 1506 1507 1508 1509 1510 1511 1512 1513 1514 1515 | offObj = Tcl_NewWideIntObj(offset); baseObj = Tcl_NewStringObj( (seekMode == SEEK_SET) ? "start" : (seekMode == SEEK_CUR) ? "current" : "end", -1); Tcl_IncrRefCount(offObj); Tcl_IncrRefCount(baseObj); if (InvokeTclMethod(rcPtr, METH_SEEK, offObj, baseObj, &resObj)!=TCL_OK) { Tcl_SetChannelError(rcPtr->chan, resObj); goto invalid; } if (Tcl_GetWideIntFromObj(rcPtr->interp, resObj, &newLoc) != TCL_OK) { Tcl_SetChannelError(rcPtr->chan, MarshallError(rcPtr->interp)); goto invalid; |
︙ | ︙ | |||
1617 1618 1619 1620 1621 1622 1623 | ReflectWatch( ClientData clientData, int mask) { ReflectedChannel *rcPtr = clientData; Tcl_Obj *maskObj; | < < | 1572 1573 1574 1575 1576 1577 1578 1579 1580 1581 1582 1583 1584 1585 | ReflectWatch( ClientData clientData, int mask) { ReflectedChannel *rcPtr = clientData; Tcl_Obj *maskObj; /* * We restrict the interest to what the channel can support. IOW there * will never be write events for a channel which is not writable. * Analoguously for read events and non-readable channels. */ mask &= rcPtr->mode; |
︙ | ︙ | |||
1661 1662 1663 1664 1665 1666 1667 | } #endif Tcl_Preserve(rcPtr); maskObj = DecodeEventMask(mask); /* assert maskObj.refCount == 1 */ | | | 1614 1615 1616 1617 1618 1619 1620 1621 1622 1623 1624 1625 1626 1627 1628 | } #endif Tcl_Preserve(rcPtr); maskObj = DecodeEventMask(mask); /* assert maskObj.refCount == 1 */ (void) InvokeTclMethod(rcPtr, METH_WATCH, maskObj, NULL, NULL); Tcl_DecrRefCount(maskObj); Tcl_Release(rcPtr); } /* *---------------------------------------------------------------------- |
︙ | ︙ | |||
1720 1721 1722 1723 1724 1725 1726 | #endif blockObj = Tcl_NewBooleanObj(!nonblocking); Tcl_IncrRefCount(blockObj); Tcl_Preserve(rcPtr); | | | 1673 1674 1675 1676 1677 1678 1679 1680 1681 1682 1683 1684 1685 1686 1687 | #endif blockObj = Tcl_NewBooleanObj(!nonblocking); Tcl_IncrRefCount(blockObj); Tcl_Preserve(rcPtr); if (InvokeTclMethod(rcPtr,METH_BLOCKING,blockObj,NULL,&resObj)!=TCL_OK) { Tcl_SetChannelError(rcPtr->chan, resObj); errorNum = EINVAL; } else { errorNum = EOK; } Tcl_DecrRefCount(blockObj); |
︙ | ︙ | |||
1832 1833 1834 1835 1836 1837 1838 | optionObj = Tcl_NewStringObj(optionName, -1); valueObj = Tcl_NewStringObj(newValue, -1); Tcl_IncrRefCount(optionObj); Tcl_IncrRefCount(valueObj); | | | 1785 1786 1787 1788 1789 1790 1791 1792 1793 1794 1795 1796 1797 1798 1799 | optionObj = Tcl_NewStringObj(optionName, -1); valueObj = Tcl_NewStringObj(newValue, -1); Tcl_IncrRefCount(optionObj); Tcl_IncrRefCount(valueObj); result = InvokeTclMethod(rcPtr, METH_CONFIGURE,optionObj,valueObj, &resObj); if (result != TCL_OK) { UnmarshallErrorResult(interp, resObj); } Tcl_DecrRefCount(optionObj); Tcl_DecrRefCount(valueObj); Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */ |
︙ | ︙ | |||
1877 1878 1879 1880 1881 1882 1883 | */ ReflectedChannel *rcPtr = clientData; Tcl_Obj *optionObj; Tcl_Obj *resObj; /* Result data for 'configure' */ int listc, result = TCL_OK; Tcl_Obj **listv; | | | 1830 1831 1832 1833 1834 1835 1836 1837 1838 1839 1840 1841 1842 1843 1844 | */ ReflectedChannel *rcPtr = clientData; Tcl_Obj *optionObj; Tcl_Obj *resObj; /* Result data for 'configure' */ int listc, result = TCL_OK; Tcl_Obj **listv; MethodName method; /* * Are we in the correct thread? */ #ifdef TCL_THREADS if (rcPtr->thread != Tcl_GetCurrentThread()) { |
︙ | ︙ | |||
1916 1917 1918 1919 1920 1921 1922 | #endif if (optionName == NULL) { /* * Retrieve all options. */ | | | | 1869 1870 1871 1872 1873 1874 1875 1876 1877 1878 1879 1880 1881 1882 1883 1884 1885 1886 1887 1888 1889 1890 | #endif if (optionName == NULL) { /* * Retrieve all options. */ method = METH_CGETALL; optionObj = NULL; } else { /* * Retrieve the value of one option. */ method = METH_CGET; optionObj = Tcl_NewStringObj(optionName, -1); Tcl_IncrRefCount(optionObj); } Tcl_Preserve(rcPtr); if (InvokeTclMethod(rcPtr, method, optionObj, NULL, &resObj)!=TCL_OK) { |
︙ | ︙ | |||
2137 2138 2139 2140 2141 2142 2143 2144 2145 2146 2147 | NewReflectedChannel( Tcl_Interp *interp, Tcl_Obj *cmdpfxObj, int mode, Tcl_Obj *handleObj) { ReflectedChannel *rcPtr; rcPtr = ckalloc(sizeof(ReflectedChannel)); /* rcPtr->chan: Assigned by caller. Dummy data here. */ | > < < > > > | > > > | | | 2090 2091 2092 2093 2094 2095 2096 2097 2098 2099 2100 2101 2102 2103 2104 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 | NewReflectedChannel( Tcl_Interp *interp, Tcl_Obj *cmdpfxObj, int mode, Tcl_Obj *handleObj) { ReflectedChannel *rcPtr; MethodName mn = METH_BLOCKING; rcPtr = ckalloc(sizeof(ReflectedChannel)); /* rcPtr->chan: Assigned by caller. Dummy data here. */ rcPtr->chan = NULL; rcPtr->interp = interp; rcPtr->dead = 0; #ifdef TCL_THREADS rcPtr->thread = Tcl_GetCurrentThread(); #endif rcPtr->mode = mode; rcPtr->interest = 0; /* Initially no interest registered */ /* ASSERT: cmdpfxObj is a Tcl List */ rcPtr->cmd = TclListObjCopy(NULL, cmdpfxObj); Tcl_IncrRefCount(rcPtr->cmd); rcPtr->methods = Tcl_NewListObj(METH_WRITE + 1, NULL); while (mn <= METH_WRITE) { Tcl_ListObjAppendElement(NULL, rcPtr->methods, Tcl_NewStringObj(methodNames[mn++], -1)); } Tcl_IncrRefCount(rcPtr->methods); rcPtr->name = handleObj; Tcl_IncrRefCount(rcPtr->name); return rcPtr; } /* *---------------------------------------------------------------------- * * NextHandle -- |
︙ | ︙ | |||
2218 2219 2220 2221 2222 2223 2224 2225 2226 2227 2228 2229 2230 2231 | * Delete a cloned ChannelType structure. */ ckfree(chanPtr->typePtr); chanPtr->typePtr = NULL; } Tcl_Release(chanPtr); Tcl_DecrRefCount(rcPtr->cmd); ckfree(rcPtr); } /* *---------------------------------------------------------------------- * | > > | 2176 2177 2178 2179 2180 2181 2182 2183 2184 2185 2186 2187 2188 2189 2190 2191 | * Delete a cloned ChannelType structure. */ ckfree(chanPtr->typePtr); chanPtr->typePtr = NULL; } Tcl_Release(chanPtr); Tcl_DecrRefCount(rcPtr->name); Tcl_DecrRefCount(rcPtr->methods); Tcl_DecrRefCount(rcPtr->cmd); ckfree(rcPtr); } /* *---------------------------------------------------------------------- * |
︙ | ︙ | |||
2249 2250 2251 2252 2253 2254 2255 | * *---------------------------------------------------------------------- */ static int InvokeTclMethod( ReflectedChannel *rcPtr, | | < | 2209 2210 2211 2212 2213 2214 2215 2216 2217 2218 2219 2220 2221 2222 2223 2224 2225 2226 2227 2228 2229 2230 2231 2232 | * *---------------------------------------------------------------------- */ static int InvokeTclMethod( ReflectedChannel *rcPtr, MethodName method, Tcl_Obj *argOneObj, /* NULL'able */ Tcl_Obj *argTwoObj, /* NULL'able */ Tcl_Obj **resultObjPtr) /* NULL'able */ { Tcl_Obj *methObj = NULL; /* Method name in object form */ Tcl_InterpState sr; /* State of handler interp */ int result; /* Result code of method invokation */ Tcl_Obj *resObj = NULL; /* Result of method invokation. */ Tcl_Obj *cmd; if (rcPtr->dead) { /* * The channel is marked as dead. Bail out immediately, with an * appropriate error. */ |
︙ | ︙ | |||
2281 2282 2283 2284 2285 2286 2287 | * Not touching argOneObj, argTwoObj, they have not been used. * See the contract as well. */ return TCL_ERROR; } | < < < < < < < | > | > | 2240 2241 2242 2243 2244 2245 2246 2247 2248 2249 2250 2251 2252 2253 2254 2255 2256 2257 2258 2259 2260 2261 2262 2263 | * Not touching argOneObj, argTwoObj, they have not been used. * See the contract as well. */ return TCL_ERROR; } /* * Insert method into the callback command, after the command prefix, * before the channel id. */ cmd = TclListObjCopy(NULL, rcPtr->cmd); Tcl_ListObjIndex(NULL, rcPtr->methods, method, &methObj); Tcl_ListObjAppendElement(NULL, cmd, methObj); Tcl_ListObjAppendElement(NULL, cmd, rcPtr->name); /* * Append the additional argument containing method specific details * behind the channel id. If specified. * * Because of the contract there is no need to increment the refcounts. * The objects will survive the Tcl_EvalObjv without change. |
︙ | ︙ | |||
2359 2360 2361 2362 2363 2364 2365 | "chan handler returned bad code: %d", result)); Tcl_LogCommandInfo(rcPtr->interp, cmdString, cmdString, cmdLen); Tcl_DecrRefCount(cmd); result = TCL_ERROR; } Tcl_AppendObjToErrorInfo(rcPtr->interp, Tcl_ObjPrintf( | | > | 2313 2314 2315 2316 2317 2318 2319 2320 2321 2322 2323 2324 2325 2326 2327 2328 | "chan handler returned bad code: %d", result)); Tcl_LogCommandInfo(rcPtr->interp, cmdString, cmdString, cmdLen); Tcl_DecrRefCount(cmd); result = TCL_ERROR; } Tcl_AppendObjToErrorInfo(rcPtr->interp, Tcl_ObjPrintf( "\n (chan handler subcommand \"%s\")", methodNames[method])); resObj = MarshallError(rcPtr->interp); } Tcl_IncrRefCount(resObj); } Tcl_DecrRefCount(cmd); Tcl_RestoreInterpState(rcPtr->interp, sr); Tcl_Release(rcPtr->interp); |
︙ | ︙ | |||
2920 2921 2922 2923 2924 2925 2926 | */ case ForwardedClose: /* * No parameters/results. */ | | | 2875 2876 2877 2878 2879 2880 2881 2882 2883 2884 2885 2886 2887 2888 2889 | */ case ForwardedClose: /* * No parameters/results. */ if (InvokeTclMethod(rcPtr, METH_FINAL, NULL, NULL, &resObj)!=TCL_OK) { ForwardSetObjError(paramPtr, resObj); } /* * Freeing is done here, in the origin thread, callback command * objects belong to this thread. Deallocating them in a different * thread is not allowed |
︙ | ︙ | |||
2951 2952 2953 2954 2955 2956 2957 | break; case ForwardedInput: { Tcl_Obj *toReadObj = Tcl_NewIntObj(paramPtr->input.toRead); Tcl_IncrRefCount(toReadObj); Tcl_Preserve(rcPtr); | | | 2906 2907 2908 2909 2910 2911 2912 2913 2914 2915 2916 2917 2918 2919 2920 | break; case ForwardedInput: { Tcl_Obj *toReadObj = Tcl_NewIntObj(paramPtr->input.toRead); Tcl_IncrRefCount(toReadObj); Tcl_Preserve(rcPtr); if (InvokeTclMethod(rcPtr, METH_READ, toReadObj, NULL, &resObj)!=TCL_OK){ int code = ErrnoReturn(rcPtr, resObj); if (code < 0) { paramPtr->base.code = code; } else { ForwardSetObjError(paramPtr, resObj); } |
︙ | ︙ | |||
2991 2992 2993 2994 2995 2996 2997 | case ForwardedOutput: { Tcl_Obj *bufObj = Tcl_NewByteArrayObj((unsigned char *) paramPtr->output.buf, paramPtr->output.toWrite); Tcl_IncrRefCount(bufObj); Tcl_Preserve(rcPtr); | | | 2946 2947 2948 2949 2950 2951 2952 2953 2954 2955 2956 2957 2958 2959 2960 | case ForwardedOutput: { Tcl_Obj *bufObj = Tcl_NewByteArrayObj((unsigned char *) paramPtr->output.buf, paramPtr->output.toWrite); Tcl_IncrRefCount(bufObj); Tcl_Preserve(rcPtr); if (InvokeTclMethod(rcPtr, METH_WRITE, bufObj, NULL, &resObj) != TCL_OK) { int code = ErrnoReturn(rcPtr, resObj); if (code < 0) { paramPtr->base.code = code; } else { ForwardSetObjError(paramPtr, resObj); } |
︙ | ︙ | |||
3034 3035 3036 3037 3038 3039 3040 | (paramPtr->seek.seekMode==SEEK_SET) ? "start" : (paramPtr->seek.seekMode==SEEK_CUR) ? "current" : "end", -1); Tcl_IncrRefCount(offObj); Tcl_IncrRefCount(baseObj); Tcl_Preserve(rcPtr); | | | 2989 2990 2991 2992 2993 2994 2995 2996 2997 2998 2999 3000 3001 3002 3003 | (paramPtr->seek.seekMode==SEEK_SET) ? "start" : (paramPtr->seek.seekMode==SEEK_CUR) ? "current" : "end", -1); Tcl_IncrRefCount(offObj); Tcl_IncrRefCount(baseObj); Tcl_Preserve(rcPtr); if (InvokeTclMethod(rcPtr, METH_SEEK, offObj, baseObj, &resObj)!=TCL_OK){ ForwardSetObjError(paramPtr, resObj); paramPtr->seek.offset = -1; } else { /* * Process a regular result. If the type is wrong this may change * into an error. */ |
︙ | ︙ | |||
3070 3071 3072 3073 3074 3075 3076 | } case ForwardedWatch: { Tcl_Obj *maskObj = DecodeEventMask(paramPtr->watch.mask); /* assert maskObj.refCount == 1 */ Tcl_Preserve(rcPtr); | | | | | | | 3025 3026 3027 3028 3029 3030 3031 3032 3033 3034 3035 3036 3037 3038 3039 3040 3041 3042 3043 3044 3045 3046 3047 3048 3049 3050 3051 3052 3053 3054 3055 3056 3057 3058 3059 3060 3061 3062 3063 3064 3065 3066 3067 3068 3069 3070 3071 3072 3073 3074 3075 3076 3077 3078 3079 3080 3081 3082 3083 3084 3085 3086 3087 3088 3089 3090 3091 3092 3093 3094 3095 3096 3097 3098 3099 3100 3101 | } case ForwardedWatch: { Tcl_Obj *maskObj = DecodeEventMask(paramPtr->watch.mask); /* assert maskObj.refCount == 1 */ Tcl_Preserve(rcPtr); (void) InvokeTclMethod(rcPtr, METH_WATCH, maskObj, NULL, NULL); Tcl_DecrRefCount(maskObj); Tcl_Release(rcPtr); break; } case ForwardedBlock: { Tcl_Obj *blockObj = Tcl_NewBooleanObj(!paramPtr->block.nonblocking); Tcl_IncrRefCount(blockObj); Tcl_Preserve(rcPtr); if (InvokeTclMethod(rcPtr, METH_BLOCKING, blockObj, NULL, &resObj) != TCL_OK) { ForwardSetObjError(paramPtr, resObj); } Tcl_Release(rcPtr); Tcl_DecrRefCount(blockObj); break; } case ForwardedSetOpt: { Tcl_Obj *optionObj = Tcl_NewStringObj(paramPtr->setOpt.name, -1); Tcl_Obj *valueObj = Tcl_NewStringObj(paramPtr->setOpt.value, -1); Tcl_IncrRefCount(optionObj); Tcl_IncrRefCount(valueObj); Tcl_Preserve(rcPtr); if (InvokeTclMethod(rcPtr, METH_CONFIGURE, optionObj, valueObj, &resObj) != TCL_OK) { ForwardSetObjError(paramPtr, resObj); } Tcl_Release(rcPtr); Tcl_DecrRefCount(optionObj); Tcl_DecrRefCount(valueObj); break; } case ForwardedGetOpt: { /* * Retrieve the value of one option. */ Tcl_Obj *optionObj = Tcl_NewStringObj(paramPtr->getOpt.name, -1); Tcl_IncrRefCount(optionObj); Tcl_Preserve(rcPtr); if (InvokeTclMethod(rcPtr, METH_CGET, optionObj, NULL, &resObj)!=TCL_OK){ ForwardSetObjError(paramPtr, resObj); } else { TclDStringAppendObj(paramPtr->getOpt.value, resObj); } Tcl_Release(rcPtr); Tcl_DecrRefCount(optionObj); break; } case ForwardedGetOptAll: /* * Retrieve all options. */ Tcl_Preserve(rcPtr); if (InvokeTclMethod(rcPtr, METH_CGETALL, NULL, NULL, &resObj) != TCL_OK){ ForwardSetObjError(paramPtr, resObj); } else { /* * Extract list, validate that it is a list, and #elements. See * NOTE (4) as well. */ |
︙ | ︙ |
Changes to tests/fCmd.test.
︙ | ︙ | |||
507 508 509 510 511 512 513 | file mkdir td1 testchmod 000 td1 createfile tf1 file rename tf1 td1 } -returnCodes error -cleanup { testchmod 755 td1 } -result {error renaming "tf1" to "td1/tf1": permission denied} | < < < < < < | 507 508 509 510 511 512 513 514 515 516 517 518 519 520 | file mkdir td1 testchmod 000 td1 createfile tf1 file rename tf1 td1 } -returnCodes error -cleanup { testchmod 755 td1 } -result {error renaming "tf1" to "td1/tf1": permission denied} test fCmd-6.9 {CopyRenameOneFile: errno == ENOENT} -setup { cleanup } -constraints {unix notRoot} -body { createfile tf1 file rename tf1 tf2 glob tf* } -result {tf2} |
︙ | ︙ |
Changes to tests/http.test.
︙ | ︙ | |||
488 489 490 491 492 493 494 | proc myProgress {token total current} { global progress httpLog if {[info exists httpLog] && $httpLog} { puts "progress $total $current" } set progress [list $total $current] } | < < < | | | | < | 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 | proc myProgress {token total current} { global progress httpLog if {[info exists httpLog] && $httpLog} { puts "progress $total $current" } set progress [list $total $current] } test http-4.6.1 {http::Event} knownBug { set token [http::geturl $url -blocksize 50 -progress myProgress] return $progress } {111 111} test http-4.7 {http::Event} -body { set token [http::geturl $url -keepalive 0 -progress myProgress] return $progress } -cleanup { http::cleanup $token } -result {111 111} test http-4.8 {http::Event} -body { |
︙ | ︙ |
Changes to tests/winFCmd.test.
︙ | ︙ | |||
204 205 206 207 208 209 210 | catch {close $fd} } -returnCodes error -result EACCES test winFCmd-1.13 {TclpRenameFile: errno: EACCES} -setup { cleanup } -constraints {win win2000orXP testfile} -body { testfile mv nul tf1 } -returnCodes error -result EINVAL | | < < < < < < < < < < < | 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 | catch {close $fd} } -returnCodes error -result EACCES test winFCmd-1.13 {TclpRenameFile: errno: EACCES} -setup { cleanup } -constraints {win win2000orXP testfile} -body { testfile mv nul tf1 } -returnCodes error -result EINVAL test winFCmd-1.14 {TclpRenameFile: errno: EACCES} -setup { cleanup } -constraints {win nt winOlderThan2000 testfile} -body { testfile mv nul tf1 } -returnCodes error -result EACCES test winFCmd-1.15 {TclpRenameFile: errno: EEXIST} -setup { cleanup } -constraints {win nt testfile} -body { createfile tf1 testfile mv tf1 nul } -returnCodes error -result EEXIST |
︙ | ︙ | |||
253 254 255 256 257 258 259 | testfile mv nul tf1 } -returnCodes error -result EINVAL test winFCmd-1.19.1 {TclpRenameFile: errno == EACCES} -setup { cleanup } -constraints {win nt winOlderThan2000 testfile} -body { testfile mv nul tf1 } -returnCodes error -result EACCES | < < < < < | 242 243 244 245 246 247 248 249 250 251 252 253 254 255 | testfile mv nul tf1 } -returnCodes error -result EINVAL test winFCmd-1.19.1 {TclpRenameFile: errno == EACCES} -setup { cleanup } -constraints {win nt winOlderThan2000 testfile} -body { testfile mv nul tf1 } -returnCodes error -result EACCES test winFCmd-1.20 {TclpRenameFile: src is dir} -setup { cleanup } -constraints {win nt testfile} -body { # under 95, this would actually succeed and move the current dir out from # under the current process! file delete /tf1 testfile mv [pwd] /tf1 |
︙ | ︙ | |||
470 471 472 473 474 475 476 | createfile tf1 testfile cp tf1 "" } -cleanup { cleanup } -returnCodes error -result ENOENT test winFCmd-2.7 {TclpCopyFile: errno: EACCES} -setup { cleanup | < < < < < < < < < < | < < < < < | 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 | createfile tf1 testfile cp tf1 "" } -cleanup { cleanup } -returnCodes error -result ENOENT test winFCmd-2.7 {TclpCopyFile: errno: EACCES} -setup { cleanup } -constraints {win win2000orXP testfile} -body { testfile cp nul tf1 } -returnCodes error -result EINVAL test winFCmd-2.8 {TclpCopyFile: errno: EACCES} -setup { cleanup } -constraints {win nt winOlderThan2000 testfile} -body { testfile cp nul tf1 } -returnCodes error -result EACCES test winFCmd-2.10 {TclpCopyFile: CopyFile succeeds} -setup { cleanup } -constraints {win testfile} -body { createfile tf1 tf1 testfile cp tf1 tf2 list [contents tf1] [contents tf2] } -cleanup { |
︙ | ︙ | |||
569 570 571 572 573 574 575 | testchmod 000 tf2 testfile cp tf1 tf2 list [file writable tf2] [contents tf2] } -cleanup { catch {testchmod 666 tf2} cleanup } -result {1 tf1} | < < < < < < < < < < < | 538 539 540 541 542 543 544 545 546 547 548 549 550 551 | testchmod 000 tf2 testfile cp tf1 tf2 list [file writable tf2] [contents tf2] } -cleanup { catch {testchmod 666 tf2} cleanup } -result {1 tf1} test winFCmd-3.1 {TclpDeleteFile: errno: EACCES} -body { testfile rm $cdfile $cdrom/dummy~~.fil } -constraints {win cdrom testfile} -returnCodes error -result EACCES test winFCmd-3.2 {TclpDeleteFile: errno: EISDIR} -setup { cleanup } -constraints {win testfile} -body { |
︙ | ︙ | |||
662 663 664 665 666 667 668 | catch {testchmod 666 tf1} cleanup } -returnCodes error -result EACCES test winFCmd-4.1 {TclpCreateDirectory: errno: EACCES} -body { testfile mkdir $cdrom/dummy~~.dir } -constraints {win nt cdrom testfile} -returnCodes error -result EACCES | < < < | 620 621 622 623 624 625 626 627 628 629 630 631 632 633 | catch {testchmod 666 tf1} cleanup } -returnCodes error -result EACCES test winFCmd-4.1 {TclpCreateDirectory: errno: EACCES} -body { testfile mkdir $cdrom/dummy~~.dir } -constraints {win nt cdrom testfile} -returnCodes error -result EACCES test winFCmd-4.3 {TclpCreateDirectory: errno: EEXIST} -setup { cleanup } -constraints {win testfile} -body { file mkdir td1 testfile mkdir td1 } -cleanup { cleanup |
︙ | ︙ | |||
760 761 762 763 764 765 766 | testchmod 000 td1 testfile rmdir td1 file exists td1 } -returnCodes error -cleanup { catch {testchmod 666 td1} cleanup } -result {td1 EACCES} | < < < < < < < < < < < < < < < < < < < < < < < < < | 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 | testchmod 000 td1 testfile rmdir td1 file exists td1 } -returnCodes error -cleanup { catch {testchmod 666 td1} cleanup } -result {td1 EACCES} test winFCmd-6.11 {TclpRemoveDirectory: attr == -1} -setup { cleanup } -constraints {win nt testfile} -body { testfile rmdir / # WinXP returns EEXIST, WinNT seems to return EACCES. No policy # decision has been made as to which is correct. } -returnCodes error -match regexp -result {^/ E(ACCES|EXIST)$} test winFCmd-6.13 {TclpRemoveDirectory: write-protected} -setup { cleanup } -constraints {winVista testfile testchmod} -body { file mkdir td1 testchmod 000 td1 testfile rmdir td1 file exists td1 } -cleanup { catch {testchmod 666 td1} cleanup } -returnCodes error -result {td1 EACCES} # This next test has a very hokey way of matching... test winFCmd-6.15 {TclpRemoveDirectory: !recursive} -setup { cleanup } -constraints {win testfile} -body { file mkdir td1/td2 list [catch {testfile rmdir td1} msg] [file tail $msg] } -result {1 {td1 EEXIST}} |
︙ | ︙ | |||
883 884 885 886 887 888 889 | file mkdir td1 createfile td1/tf1 tf1 testfile cpdir td1 td2 contents td2/tf1 } -cleanup { cleanup } -result {tf1} | < < < < < | 813 814 815 816 817 818 819 820 821 822 823 824 825 826 | file mkdir td1 createfile td1/tf1 tf1 testfile cpdir td1 td2 contents td2/tf1 } -cleanup { cleanup } -result {tf1} test winFCmd-7.9 {TraverseWinTree: append \ to source if necessary} -body { testfile rmdir $cdrom/ } -constraints {win nt cdrom testfile} -returnCodes error -match glob \ -result {* EACCES} test winFCmd-7.10 {TraverseWinTree: can't read directory: handle == INVALID} \ {win emptyTest} { # can't make it happen |
︙ | ︙ | |||
926 927 928 929 930 931 932 | file mkdir td1 createfile td1/tf1 tf1 testfile cpdir td1 td2 contents td2/tf1 } -cleanup { cleanup } -result {tf1} | < < < < < < < < | 851 852 853 854 855 856 857 858 859 860 861 862 863 864 | file mkdir td1 createfile td1/tf1 tf1 testfile cpdir td1 td2 contents td2/tf1 } -cleanup { cleanup } -result {tf1} test winFCmd-7.15 {TraverseWinTree: append \ to target if necessary} -setup { cleanup } -constraints {win nt testfile} -body { file mkdir td1 testfile cpdir td1 / } -cleanup { cleanup |
︙ | ︙ | |||
1034 1035 1036 1037 1038 1039 1040 | test winFCmd-9.1 {TraversalDelete: DOTREE_F} -setup { cleanup } -constraints {win testfile} -body { file mkdir td1 createfile td1/tf1 testfile rmdir -force td1 } -result {} | < < < < < < < < < | 951 952 953 954 955 956 957 958 959 960 961 962 963 964 | test winFCmd-9.1 {TraversalDelete: DOTREE_F} -setup { cleanup } -constraints {win testfile} -body { file mkdir td1 createfile td1/tf1 testfile rmdir -force td1 } -result {} test winFCmd-9.3 {TraversalDelete: DOTREE_PRED} -setup { cleanup } -constraints {winVista testfile testchmod} -body { file mkdir td1/td2 testchmod 000 td1 testfile rmdir -force td1 file exists td1 |
︙ | ︙ |
Changes to tests/winFile.test.
︙ | ︙ | |||
33 34 35 36 37 38 39 | test winFile-1.1 {TclpGetUserHome} -constraints {win} -body { glob ~nosuchuser } -returnCodes error -result {user "nosuchuser" doesn't exist} test winFile-1.2 {TclpGetUserHome} -constraints {win nt nonPortable} -body { # The administrator account should always exist. glob ~administrator } -match glob -result * | < < < < < < < < < < < < < < < < < < | 33 34 35 36 37 38 39 40 41 42 43 44 45 46 | test winFile-1.1 {TclpGetUserHome} -constraints {win} -body { glob ~nosuchuser } -returnCodes error -result {user "nosuchuser" doesn't exist} test winFile-1.2 {TclpGetUserHome} -constraints {win nt nonPortable} -body { # The administrator account should always exist. glob ~administrator } -match glob -result * test winFile-1.4 {TclpGetUserHome} {win nt nonPortable} { catch {glob ~stanton@workgroup} } {0} test winFile-2.1 {TclpMatchFiles: case sensitivity} -constraints {win} -body { makeFile {} GlobCapS list [glob -nocomplain GlobC*] [glob -nocomplain globc*] |
︙ | ︙ |
Changes to tests/winPipe.test.
︙ | ︙ | |||
78 79 80 81 82 83 84 | exec [interpreter] $path(more) < $path(little) | $cat32 > $path(stdout) 2> $path(stderr) list [contents $path(stdout)] [contents $path(stderr)] } {little stderr32} test winpipe-1.4 {32 bit comprehensive tests: a lot from pipe} {win nt exec cat32} { exec [interpreter] $path(more) < $path(big) | $cat32 > $path(stdout) 2> $path(stderr) list [contents $path(stdout)] [contents $path(stderr)] } "{$big} stderr32" | < < < < | 78 79 80 81 82 83 84 85 86 87 88 89 90 91 | exec [interpreter] $path(more) < $path(little) | $cat32 > $path(stdout) 2> $path(stderr) list [contents $path(stdout)] [contents $path(stderr)] } {little stderr32} test winpipe-1.4 {32 bit comprehensive tests: a lot from pipe} {win nt exec cat32} { exec [interpreter] $path(more) < $path(big) | $cat32 > $path(stdout) 2> $path(stderr) list [contents $path(stdout)] [contents $path(stderr)] } "{$big} stderr32" test winpipe-1.6 {32 bit comprehensive tests: from console} \ {win cat32 AllocConsole} { # would block waiting for human input } {} test winpipe-1.7 {32 bit comprehensive tests: from NUL} {win exec cat32} { exec $cat32 < nul > $path(stdout) 2> $path(stderr) list [contents $path(stdout)] [contents $path(stderr)] |
︙ | ︙ | |||
170 171 172 173 174 175 176 | puts $f $big puts $f \032 flush $f set r [read $f 64] catch {close $f} set r } "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb" | < < < < | 166 167 168 169 170 171 172 173 174 175 176 177 178 179 | puts $f $big puts $f \032 flush $f set r [read $f 64] catch {close $f} set r } "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb" test winpipe-4.1 {Tcl_WaitPid} {win nt exec cat32} { proc readResults {f} { global x result if { [eof $f] } { close $f set x 1 |
︙ | ︙ |