Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
Comment: | merge trunk |
---|---|
Downloads: | Tarball | ZIP archive |
Timelines: | family | ancestors | descendants | both | dgp-properbytearray |
Files: | files | file ages | folders |
SHA3-256: |
d850dacf9b62e859d6594470144ea7fc |
User & Date: | dgp 2019-05-06 17:41:24.194 |
Context
2019-05-10
| ||
15:02 | merge trunk check-in: 80416841b2 user: dgp tags: dgp-properbytearray | |
2019-05-06
| ||
17:41 | merge trunk check-in: d850dacf9b user: dgp tags: dgp-properbytearray | |
2019-05-04
| ||
22:51 | merge mark check-in: 8c9c2b8b55 user: dgp tags: trunk | |
2019-05-03
| ||
15:58 | merge trunk check-in: 61db2fb4ce user: dgp tags: dgp-properbytearray | |
Changes
Changes to generic/tclBasic.c.
︙ | ︙ | |||
153 154 155 156 157 158 159 160 161 162 163 164 165 166 | static Tcl_NRPostProc TEOV_RestoreVarFrame; static Tcl_NRPostProc TEOV_RunLeaveTraces; static Tcl_NRPostProc EvalObjvCore; static Tcl_NRPostProc Dispatch; static Tcl_ObjCmdProc NRCoroInjectObjCmd; static Tcl_NRPostProc NRPostInvoke; MODULE_SCOPE const TclStubs tclStubs; /* * Magical counts for the number of arguments accepted by a coroutine command * after particular kinds of [yield]. */ | > | 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 | static Tcl_NRPostProc TEOV_RestoreVarFrame; static Tcl_NRPostProc TEOV_RunLeaveTraces; static Tcl_NRPostProc EvalObjvCore; static Tcl_NRPostProc Dispatch; static Tcl_ObjCmdProc NRCoroInjectObjCmd; static Tcl_NRPostProc NRPostInvoke; static Tcl_ObjCmdProc CoroTypeObjCmd; MODULE_SCOPE const TclStubs tclStubs; /* * Magical counts for the number of arguments accepted by a coroutine command * after particular kinds of [yield]. */ |
︙ | ︙ | |||
933 934 935 936 937 938 939 940 941 942 943 944 945 946 947 948 | /* Adding the bytecode assembler command */ cmdPtr = (Command *) Tcl_NRCreateCommand(interp, "::tcl::unsupported::assemble", Tcl_AssembleObjCmd, TclNRAssembleObjCmd, NULL, NULL); cmdPtr->compileProc = &TclCompileAssembleCmd; Tcl_NRCreateCommand(interp, "::tcl::unsupported::inject", NULL, NRCoroInjectObjCmd, NULL, NULL); /* Export unsupported commands */ nsPtr = Tcl_FindNamespace(interp, "::tcl::unsupported", NULL, 0); if (nsPtr) { Tcl_Export(interp, nsPtr, "*", 1); } | > > > | 934 935 936 937 938 939 940 941 942 943 944 945 946 947 948 949 950 951 952 | /* Adding the bytecode assembler command */ cmdPtr = (Command *) Tcl_NRCreateCommand(interp, "::tcl::unsupported::assemble", Tcl_AssembleObjCmd, TclNRAssembleObjCmd, NULL, NULL); cmdPtr->compileProc = &TclCompileAssembleCmd; /* Coroutine monkeybusiness */ Tcl_NRCreateCommand(interp, "::tcl::unsupported::inject", NULL, NRCoroInjectObjCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "::tcl::unsupported::corotype", CoroTypeObjCmd, NULL, NULL); /* Export unsupported commands */ nsPtr = Tcl_FindNamespace(interp, "::tcl::unsupported", NULL, 0); if (nsPtr) { Tcl_Export(interp, nsPtr, "*", 1); } |
︙ | ︙ | |||
2325 2326 2327 2328 2329 2330 2331 | /* * isNew - No conflict with existing command. * deleted - We've already deleted a conflicting command */ break; } | > | > > | | | < | | | < | 2329 2330 2331 2332 2333 2334 2335 2336 2337 2338 2339 2340 2341 2342 2343 2344 2345 2346 2347 2348 2349 2350 2351 2352 2353 2354 2355 2356 2357 2358 2359 2360 2361 2362 2363 2364 2365 2366 2367 2368 2369 2370 2371 2372 2373 2374 2375 2376 2377 2378 2379 2380 | /* * isNew - No conflict with existing command. * deleted - We've already deleted a conflicting command */ break; } /* * An existing command conflicts. Try to delete it... */ cmdPtr = Tcl_GetHashValue(hPtr); /* * Be careful to preserve any existing import links so we can restore * them down below. That way, you can redefine a command and its * import status will remain intact. */ cmdPtr->refCount++; if (cmdPtr->importRefPtr) { cmdPtr->flags |= CMD_REDEF_IN_PROGRESS; } Tcl_DeleteCommandFromToken(interp, (Tcl_Command) cmdPtr); if (cmdPtr->flags & CMD_REDEF_IN_PROGRESS) { oldRefPtr = cmdPtr->importRefPtr; cmdPtr->importRefPtr = NULL; } TclCleanupCommandMacro(cmdPtr); deleted = 1; } if (!isNew) { /* * If the deletion callback recreated the command, just throw away the * new command (if we try to delete it again, we could get stuck in an * infinite loop). */ Tcl_Free(Tcl_GetHashValue(hPtr)); } if (!deleted) { /* * Command resolvers (per-interp, per-namespace) might have resolved * to a command for the given namespace scope with this command not * being registered with the namespace's command table. During BC * compilation, the so-resolved command turns into a CmdName literal. * Without invalidating a possible CmdName literal here explicitly, * such literals keep being reused while pointing to overhauled |
︙ | ︙ | |||
2543 2544 2545 2546 2547 2548 2549 | * isNew - No conflict with existing command. * deleted - We've already deleted a conflicting command */ break; } /* | | | 2548 2549 2550 2551 2552 2553 2554 2555 2556 2557 2558 2559 2560 2561 2562 | * isNew - No conflict with existing command. * deleted - We've already deleted a conflicting command */ break; } /* * An existing command conflicts. Try to delete it... */ cmdPtr = Tcl_GetHashValue(hPtr); /* * Command already exists; delete it. Be careful to preserve any * existing import links so we can restore them down below. That way, |
︙ | ︙ | |||
4168 4169 4170 4171 4172 4173 4174 | /* * Lookup the Command to dispatch. */ reresolve: assert(cmdPtr == NULL); if (preCmdPtr) { | > | > > > | > > | | > < < > < | | | | | | < | | | | 4173 4174 4175 4176 4177 4178 4179 4180 4181 4182 4183 4184 4185 4186 4187 4188 4189 4190 4191 4192 4193 4194 4195 4196 4197 4198 4199 4200 4201 4202 4203 4204 4205 4206 4207 4208 4209 4210 4211 4212 4213 4214 4215 4216 4217 4218 4219 4220 4221 4222 4223 4224 4225 4226 4227 4228 4229 4230 4231 4232 4233 4234 4235 4236 4237 4238 4239 4240 4241 4242 4243 4244 4245 4246 4247 4248 4249 4250 4251 4252 4253 4254 4255 4256 4257 | /* * Lookup the Command to dispatch. */ reresolve: assert(cmdPtr == NULL); if (preCmdPtr) { /* * Caller gave it to us. */ if (!(preCmdPtr->flags & CMD_IS_DELETED)) { /* * So long as it exists, use it. */ cmdPtr = preCmdPtr; } else if (flags & TCL_EVAL_NORESOLVE) { /* * When it's been deleted, and we're told not to attempt resolving * it ourselves, all we can do is raise an error. */ Tcl_SetObjResult(interp, Tcl_ObjPrintf( "attempt to invoke a deleted command")); Tcl_SetErrorCode(interp, "TCL", "EVAL", "DELETEDCOMMAND", NULL); return TCL_ERROR; } } if (cmdPtr == NULL) { cmdPtr = TEOV_LookupCmdFromObj(interp, objv[0], lookupNsPtr); if (!cmdPtr) { return TEOV_NotFound(interp, objc, objv, lookupNsPtr); } } if (enterTracesDone || iPtr->tracePtr || (cmdPtr->flags & CMD_HAS_EXEC_TRACES)) { Tcl_Obj *commandPtr = TclGetSourceFromFrame( flags & TCL_EVAL_SOURCE_IN_FRAME ? iPtr->cmdFramePtr : NULL, objc, objv); Tcl_IncrRefCount(commandPtr); if (!enterTracesDone) { int code = TEOV_RunEnterTraces(interp, &cmdPtr, commandPtr, objc, objv); /* * Send any exception from enter traces back as an exception * raised by the traced command. * TODO: Is this a bug? Letting an execution trace BREAK or * CONTINUE or RETURN in the place of the traced command? Would * either converting all exceptions to TCL_ERROR, or just * swallowing them be better? (Swallowing them has the problem of * permanently hiding program errors.) */ if (code != TCL_OK) { Tcl_DecrRefCount(commandPtr); return code; } /* * If the enter traces made the resolved cmdPtr unusable, go back * and resolve again, but next time don't run enter traces again. */ if (cmdPtr == NULL) { enterTracesDone = 1; Tcl_DecrRefCount(commandPtr); goto reresolve; } } /* * Schedule leave traces. Raise the refCount on the resolved cmdPtr, * so that when it passes to the leave traces we know it's still * valid. */ cmdPtr->refCount++; TclNRAddCallback(interp, TEOV_RunLeaveTraces, INT2PTR(objc), commandPtr, cmdPtr, objv); } |
︙ | ︙ | |||
4301 4302 4303 4304 4305 4306 4307 | TclNRRunCallbacks( Tcl_Interp *interp, int result, struct NRE_callback *rootPtr) /* All callbacks down to rootPtr not inclusive * are to be run. */ { | > | | < < < | 4310 4311 4312 4313 4314 4315 4316 4317 4318 4319 4320 4321 4322 4323 4324 4325 4326 4327 | TclNRRunCallbacks( Tcl_Interp *interp, int result, struct NRE_callback *rootPtr) /* All callbacks down to rootPtr not inclusive * are to be run. */ { while (TOP_CB(interp) != rootPtr) { NRE_callback *callbackPtr = TOP_CB(interp); Tcl_NRPostProc *procPtr = callbackPtr->procPtr; TOP_CB(interp) = callbackPtr->nextPtr; result = procPtr(callbackPtr->data, interp, result); TCLNR_FREE(interp, callbackPtr); } return result; } |
︙ | ︙ | |||
6374 6375 6376 6377 6378 6379 6380 | "invalid hidden command name \"%s\"", cmdName)); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "HIDDENTOKEN", cmdName, NULL); return TCL_ERROR; } cmdPtr = Tcl_GetHashValue(hPtr); | > | > > | | | 6381 6382 6383 6384 6385 6386 6387 6388 6389 6390 6391 6392 6393 6394 6395 6396 6397 6398 6399 6400 6401 6402 6403 6404 6405 | "invalid hidden command name \"%s\"", cmdName)); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "HIDDENTOKEN", cmdName, NULL); return TCL_ERROR; } cmdPtr = Tcl_GetHashValue(hPtr); /* * Avoid the exception-handling brain damage when numLevels == 0 */ iPtr->numLevels++; Tcl_NRAddCallback(interp, NRPostInvoke, NULL, NULL, NULL, NULL); /* * Normal command resolution of objv[0] isn't going to find cmdPtr. * That's the whole point of **hidden** commands. So tell the Eval core * machinery not to even try (and risk finding something wrong). */ return TclNREvalObjv(interp, objc, objv, TCL_EVAL_NORESOLVE, cmdPtr); } static int NRPostInvoke( |
︙ | ︙ | |||
7622 7623 7624 7625 7626 7627 7628 | kini("line"); kini("level"); #undef kini } for (i = 0; i < 6; i++) { Tcl_DictObjGet(NULL, info, *k++, &val); args[i] = val ? TclGetString(val) : NULL; } | > > | > > > > | > > | 7632 7633 7634 7635 7636 7637 7638 7639 7640 7641 7642 7643 7644 7645 7646 7647 7648 7649 7650 7651 7652 7653 7654 7655 7656 7657 7658 7659 7660 | kini("line"); kini("level"); #undef kini } for (i = 0; i < 6; i++) { Tcl_DictObjGet(NULL, info, *k++, &val); args[i] = val ? TclGetString(val) : NULL; } /* * no "proc" -> use "lambda" */ if (!args[2]) { Tcl_DictObjGet(NULL, info, *k, &val); args[2] = val ? TclGetString(val) : NULL; } k++; /* * no "class" -> use "object" */ if (!args[5]) { Tcl_DictObjGet(NULL, info, *k, &val); args[5] = val ? TclGetString(val) : NULL; } k++; for (i = 0; i < 2; i++) { Tcl_DictObjGet(NULL, info, *k++, &val); |
︙ | ︙ | |||
7982 7983 7984 7985 7986 7987 7988 | * at the proper time. */ if (objc > 1) { Tcl_Obj *listPtr, *nsObjPtr; Tcl_Namespace *nsPtr = (Tcl_Namespace *) iPtr->varFramePtr->nsPtr; | > | | > | 8000 8001 8002 8003 8004 8005 8006 8007 8008 8009 8010 8011 8012 8013 8014 8015 8016 8017 | * at the proper time. */ if (objc > 1) { Tcl_Obj *listPtr, *nsObjPtr; Tcl_Namespace *nsPtr = (Tcl_Namespace *) iPtr->varFramePtr->nsPtr; /* * The tailcall data is in a Tcl list: the first element is the * namespace, the rest the command to be tailcalled. */ nsObjPtr = Tcl_NewStringObj(nsPtr->fullName, -1); listPtr = Tcl_NewListObj(objc, objv); TclListObjSetElement(interp, listPtr, 0, nsObjPtr); iPtr->varFramePtr->tailcallPtr = listPtr; } |
︙ | ︙ | |||
8434 8435 8436 8437 8438 8439 8440 8441 8442 8443 8444 8445 8446 8447 | TclListObjGetElements(NULL, listPtr, &objc, &objv); return TclNREvalObjv(interp, objc, objv, 0, NULL); } /* *---------------------------------------------------------------------- * * NRCoroInjectObjCmd -- * * Implementation of [::tcl::unsupported::inject] command. * *---------------------------------------------------------------------- */ | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 8454 8455 8456 8457 8458 8459 8460 8461 8462 8463 8464 8465 8466 8467 8468 8469 8470 8471 8472 8473 8474 8475 8476 8477 8478 8479 8480 8481 8482 8483 8484 8485 8486 8487 8488 8489 8490 8491 8492 8493 8494 8495 8496 8497 8498 8499 8500 8501 8502 8503 8504 8505 8506 8507 8508 8509 8510 8511 8512 8513 8514 8515 8516 8517 8518 8519 8520 8521 8522 8523 8524 8525 8526 8527 8528 8529 8530 8531 8532 8533 8534 8535 8536 | TclListObjGetElements(NULL, listPtr, &objc, &objv); return TclNREvalObjv(interp, objc, objv, 0, NULL); } /* *---------------------------------------------------------------------- * * CoroTypeObjCmd -- * * Implementation of [::tcl::unsupported::corotype] command. * *---------------------------------------------------------------------- */ static int CoroTypeObjCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { Command *cmdPtr; CoroutineData *corPtr; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "coroName"); return TCL_ERROR; } /* * Look up the coroutine. */ cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, objv[1]); if ((!cmdPtr) || (cmdPtr->nreProc != TclNRInterpCoroutine)) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "can only get coroutine type of a coroutine", -1)); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COROUTINE", TclGetString(objv[1]), NULL); return TCL_ERROR; } /* * An active coroutine is "active". Can't tell what it might do in the * future. */ corPtr = cmdPtr->objClientData; if (!COR_IS_SUSPENDED(corPtr)) { Tcl_SetObjResult(interp, Tcl_NewStringObj("active", -1)); return TCL_OK; } /* * Inactive coroutines are classified by the (effective) command used to * suspend them, which matters when you're injecting a probe. */ switch (corPtr->nargs) { case COROUTINE_ARGUMENTS_SINGLE_OPTIONAL: Tcl_SetObjResult(interp, Tcl_NewStringObj("yield", -1)); return TCL_OK; case COROUTINE_ARGUMENTS_ARBITRARY: Tcl_SetObjResult(interp, Tcl_NewStringObj("yieldto", -1)); return TCL_OK; default: Tcl_SetObjResult(interp, Tcl_NewStringObj( "unknown coroutine type", -1)); Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "BAD_TYPE", NULL); return TCL_ERROR; } } /* *---------------------------------------------------------------------- * * NRCoroInjectObjCmd -- * * Implementation of [::tcl::unsupported::inject] command. * *---------------------------------------------------------------------- */ |
︙ | ︙ | |||
8664 8665 8666 8667 8668 8669 8670 | corPtr->callerEEPtr = iPtr->execEnvPtr; RESTORE_CONTEXT(corPtr->running); iPtr->execEnvPtr = corPtr->eePtr; TclNRAddCallback(interp, NRCoroutineExitCallback, corPtr, NULL, NULL, NULL); | > | > > | | 8753 8754 8755 8756 8757 8758 8759 8760 8761 8762 8763 8764 8765 8766 8767 8768 8769 8770 8771 8772 | corPtr->callerEEPtr = iPtr->execEnvPtr; RESTORE_CONTEXT(corPtr->running); iPtr->execEnvPtr = corPtr->eePtr; TclNRAddCallback(interp, NRCoroutineExitCallback, corPtr, NULL, NULL, NULL); /* * Ensure that the command is looked up in the correct namespace. */ iPtr->lookupNsPtr = lookupNsPtr; Tcl_NREvalObj(interp, Tcl_NewListObj(objc - 2, objv + 2), 0); iPtr->numLevels--; SAVE_CONTEXT(corPtr->running); RESTORE_CONTEXT(corPtr->caller); iPtr->execEnvPtr = corPtr->callerEEPtr; /* |
︙ | ︙ |
Changes to generic/tclBinary.c.
︙ | ︙ | |||
741 742 743 744 745 746 747 | Tcl_Panic("%s called with shared object","TclAppendBytesToByteArray"); } if (len == TCL_AUTO_LENGTH) { Tcl_Panic("%s must be called with definite number of bytes to append", "TclAppendBytesToByteArray"); } if (len == 0) { | > | > > | 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 | Tcl_Panic("%s called with shared object","TclAppendBytesToByteArray"); } if (len == TCL_AUTO_LENGTH) { Tcl_Panic("%s must be called with definite number of bytes to append", "TclAppendBytesToByteArray"); } if (len == 0) { /* * Append zero bytes is a no-op. */ return; } irPtr = TclFetchIntRep(objPtr, &properByteArrayType); if (irPtr == NULL) { if (TCL_ERROR == SetByteArrayFromAny(NULL, objPtr)) { Tcl_Panic("attempt to append bytes to non-bytearray"); |
︙ | ︙ |
Changes to generic/tclOO.c.
︙ | ︙ | |||
342 343 344 345 346 347 348 | Tcl_SetNamespaceUnknownHandler(interp, fPtr->objdefNs, namePtr); /* * Create the subcommands in the oo::define and oo::objdefine spaces. */ Tcl_DStringInit(&buffer); | | | | | | | 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 | Tcl_SetNamespaceUnknownHandler(interp, fPtr->objdefNs, namePtr); /* * Create the subcommands in the oo::define and oo::objdefine spaces. */ Tcl_DStringInit(&buffer); for (i = 0 ; defineCmds[i].name ; i++) { TclDStringAppendLiteral(&buffer, "::oo::define::"); Tcl_DStringAppend(&buffer, defineCmds[i].name, -1); Tcl_CreateObjCommand(interp, Tcl_DStringValue(&buffer), defineCmds[i].objProc, INT2PTR(defineCmds[i].flag), NULL); Tcl_DStringFree(&buffer); } for (i = 0 ; objdefCmds[i].name ; i++) { TclDStringAppendLiteral(&buffer, "::oo::objdefine::"); Tcl_DStringAppend(&buffer, objdefCmds[i].name, -1); Tcl_CreateObjCommand(interp, Tcl_DStringValue(&buffer), objdefCmds[i].objProc, INT2PTR(objdefCmds[i].flag), NULL); Tcl_DStringFree(&buffer); } Tcl_CallWhenDeleted(interp, KillFoundation, NULL); /* * Create the special objects at the core of the object system. */ InitClassSystemRoots(interp, fPtr); /* * Basic method declarations for the core classes. */ for (i = 0 ; objMethods[i].name ; i++) { TclOONewBasicMethod(interp, fPtr->objectCls, &objMethods[i]); } for (i = 0 ; clsMethods[i].name ; i++) { TclOONewBasicMethod(interp, fPtr->classCls, &clsMethods[i]); } /* * Finish setting up the class of classes by marking the 'new' method as * private; classes, unlike general objects, must have explicit names. We * also need to create the constructor for classes. */ TclNewLiteralStringObj(namePtr, "new"); Tcl_NewInstanceMethod(interp, (Tcl_Object) fPtr->classCls->thisPtr, namePtr /* keeps ref */, 0 /* private */, NULL, NULL); fPtr->classCls->constructorPtr = (Method *) Tcl_NewMethod(interp, (Tcl_Class) fPtr->classCls, NULL, 0, &classConstructor, NULL); /* * Create non-object commands and plug ourselves into the Tcl [info] * ensemble. */ |
︙ | ︙ | |||
663 664 665 666 667 668 669 | * have to get rid of the error message from Tcl_CreateNamespace, * since that's something that should not be exposed to the user. */ Tcl_ResetResult(interp); } | < < | | 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 | * have to get rid of the error message from Tcl_CreateNamespace, * since that's something that should not be exposed to the user. */ Tcl_ResetResult(interp); } configNamespace: ((Namespace *) oPtr->namespacePtr)->refCount++; /* * Make the namespace know about the helper commands. This grants access * to the [self] and [next] commands. */ if (fPtr->helpersNs != NULL) { |
︙ | ︙ | |||
870 871 872 873 874 875 876 | /* * Squelch classes that this class has been mixed into. */ if (clsPtr->mixinSubs.num > 0) { while (clsPtr->mixinSubs.num > 0) { | > | > > | > | | > | 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 | /* * Squelch classes that this class has been mixed into. */ if (clsPtr->mixinSubs.num > 0) { while (clsPtr->mixinSubs.num > 0) { mixinSubclassPtr = clsPtr->mixinSubs.list[clsPtr->mixinSubs.num - 1]; /* * This condition also covers the case where mixinSubclassPtr == * clsPtr */ if (!Deleted(mixinSubclassPtr->thisPtr) && !(mixinSubclassPtr->thisPtr->flags & DONT_DELETE)) { Tcl_DeleteCommandFromToken(interp, mixinSubclassPtr->thisPtr->command); } TclOORemoveFromMixinSubs(mixinSubclassPtr, clsPtr); } } if (clsPtr->mixinSubs.size > 0) { Tcl_Free(clsPtr->mixinSubs.list); clsPtr->mixinSubs.size = 0; } /* * Squelch subclasses of this class. */ if (clsPtr->subclasses.num > 0) { while (clsPtr->subclasses.num > 0) { subclassPtr = clsPtr->subclasses.list[clsPtr->subclasses.num - 1]; if (!Deleted(subclassPtr->thisPtr) && !IsRoot(subclassPtr) && !(subclassPtr->thisPtr->flags & DONT_DELETE)) { Tcl_DeleteCommandFromToken(interp, subclassPtr->thisPtr->command); } TclOORemoveFromSubclasses(subclassPtr, clsPtr); } } if (clsPtr->subclasses.size > 0) { Tcl_Free(clsPtr->subclasses.list); clsPtr->subclasses.list = NULL; clsPtr->subclasses.size = 0; } /* * Squelch instances of this class (includes objects we're mixed into). */ if (clsPtr->instances.num > 0) { while (clsPtr->instances.num > 0) { instancePtr = clsPtr->instances.list[clsPtr->instances.num - 1]; /* * This condition also covers the case where instancePtr == oPtr */ if (!Deleted(instancePtr) && !IsRoot(instancePtr) && !(instancePtr->flags & DONT_DELETE)) { Tcl_DeleteCommandFromToken(interp, instancePtr->command); |
︙ | ︙ | |||
1115 1116 1117 1118 1119 1120 1121 | Tcl_Obj *filterObj, *variableObj; PrivateVariableMapping *privateVariable; Tcl_Interp *interp = oPtr->fPtr->interp; int i; if (Deleted(oPtr)) { /* | | | > | > > < > | | | | | 1118 1119 1120 1121 1122 1123 1124 1125 1126 1127 1128 1129 1130 1131 1132 1133 1134 1135 1136 1137 1138 1139 1140 1141 1142 1143 1144 1145 1146 1147 1148 1149 1150 1151 1152 1153 1154 1155 1156 1157 1158 1159 1160 1161 1162 1163 1164 1165 1166 1167 1168 1169 1170 1171 1172 1173 1174 1175 1176 1177 1178 1179 1180 1181 1182 1183 1184 1185 1186 1187 1188 1189 1190 1191 | Tcl_Obj *filterObj, *variableObj; PrivateVariableMapping *privateVariable; Tcl_Interp *interp = oPtr->fPtr->interp; int i; if (Deleted(oPtr)) { /* * TODO: Can ObjectNamespaceDeleted ever be called twice? If not, * this guard could be removed. */ return; } /* * One rule for the teardown routines is that if an object is in the * process of being deleted, nothing else may modify its bookeeping * records. This is the flag that */ oPtr->flags |= OBJECT_DELETED; /* * Let the dominoes fall! */ if (oPtr->classPtr) { TclOODeleteDescendants(interp, oPtr); } /* * We do not run destructors on the core class objects when the * interpreter is being deleted; their incestuous nature causes problems * in that case when the destructor is partially deleted before the uses * of it have gone. [Bug 2949397] */ if (!Tcl_InterpDeleted(interp) && !(oPtr->flags & DESTRUCTOR_CALLED)) { CallContext *contextPtr = TclOOGetCallContext(oPtr, NULL, DESTRUCTOR, NULL, NULL, NULL); int result; Tcl_InterpState state; oPtr->flags |= DESTRUCTOR_CALLED; if (contextPtr != NULL) { contextPtr->callPtr->flags |= DESTRUCTOR; contextPtr->skip = 0; state = Tcl_SaveInterpState(interp, TCL_OK); result = Tcl_NRCallObjProc(interp, TclOOInvokeContext, contextPtr, 0, NULL); if (result != TCL_OK) { Tcl_BackgroundException(interp, result); } Tcl_RestoreInterpState(interp, state); TclOODeleteContext(contextPtr); } } /* * Instruct everyone to no longer use any allocated fields of the object. * Also delete the command that refers to the object at this point (if it * still exists) because otherwise its pointer to the object points into * freed memory. */ if (((Command *) oPtr->command)->flags && CMD_IS_DELETED) { /* * Something has already started the command deletion process. We can * go ahead and clean up the the namespace, */ } else { /* * The namespace must have been deleted directly. Delete the command |
︙ | ︙ | |||
1197 1198 1199 1200 1201 1202 1203 | } /* * Splice the object out of its context. After this, we must *not* call * methods on the object. */ | < | < < | 1203 1204 1205 1206 1207 1208 1209 1210 1211 1212 1213 1214 1215 1216 1217 | } /* * Splice the object out of its context. After this, we must *not* call * methods on the object. */ /* TODO: Should this be protected with a !IsRoot() condition? */ TclOORemoveFromInstances(oPtr, oPtr->selfCls); if (oPtr->mixins.num > 0) { FOREACH(mixinPtr, oPtr->mixins) { TclOORemoveFromInstances(oPtr, mixinPtr); TclOODecrRefCount(mixinPtr->thisPtr); } |
︙ | ︙ | |||
1761 1762 1763 1764 1765 1766 1767 | */ TclNRAddCallback(interp, FinalizeAlloc, contextPtr, oPtr, state, objectPtr); TclPushTailcallPoint(interp); return TclOOInvokeContext(contextPtr, interp, objc, objv); } | < < | | < < < < < < < | 1764 1765 1766 1767 1768 1769 1770 1771 1772 1773 1774 1775 1776 1777 1778 1779 1780 1781 1782 1783 1784 1785 1786 1787 1788 1789 1790 1791 1792 1793 1794 1795 1796 1797 1798 1799 1800 1801 1802 1803 1804 1805 1806 1807 1808 | */ TclNRAddCallback(interp, FinalizeAlloc, contextPtr, oPtr, state, objectPtr); TclPushTailcallPoint(interp); return TclOOInvokeContext(contextPtr, interp, objc, objv); } Object * TclNewObjectInstanceCommon( Tcl_Interp *interp, Class *classPtr, const char *nameStr, const char *nsNameStr) { Tcl_HashEntry *hPtr; Foundation *fPtr = GetFoundation(interp); Object *oPtr; const char *simpleName = NULL; Namespace *nsPtr = NULL, *dummy; Namespace *inNsPtr = (Namespace *) TclGetCurrentNamespace(interp); if (nameStr) { TclGetNamespaceForQualName(interp, nameStr, inNsPtr, TCL_CREATE_NS_IF_UNKNOWN, &nsPtr, &dummy, &dummy, &simpleName); /* * Disallow creation of an object over an existing command. */ hPtr = Tcl_FindHashEntry(&nsPtr->cmdTable, simpleName); if (hPtr) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "can't create object \"%s\": command already exists with" " that name", nameStr)); Tcl_SetErrorCode(interp, "TCL", "OO", "OVERWRITE_OBJECT", NULL); return NULL; } } /* * Create the object. */ oPtr = AllocObject(interp, simpleName, nsPtr, nsNameStr); |
︙ | ︙ | |||
1833 1834 1835 1836 1837 1838 1839 | TclOOAddToSubclasses(oPtr->classPtr, fPtr->objectCls); } else { oPtr->classPtr = NULL; } return oPtr; } | < < | 1827 1828 1829 1830 1831 1832 1833 1834 1835 1836 1837 1838 1839 1840 | TclOOAddToSubclasses(oPtr->classPtr, fPtr->objectCls); } else { oPtr->classPtr = NULL; } return oPtr; } static int FinalizeAlloc( ClientData data[], Tcl_Interp *interp, int result) { CallContext *contextPtr = data[0]; |
︙ | ︙ | |||
1970 1971 1972 1973 1974 1975 1976 | Tcl_Free(o2Ptr->mixins.list); } DUPLICATE(o2Ptr->mixins, oPtr->mixins, Class *); FOREACH(mixinPtr, o2Ptr->mixins) { if (mixinPtr && mixinPtr != o2Ptr->selfCls) { TclOOAddToInstances(o2Ptr, mixinPtr); } | > > | > > | 1962 1963 1964 1965 1966 1967 1968 1969 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 | Tcl_Free(o2Ptr->mixins.list); } DUPLICATE(o2Ptr->mixins, oPtr->mixins, Class *); FOREACH(mixinPtr, o2Ptr->mixins) { if (mixinPtr && mixinPtr != o2Ptr->selfCls) { TclOOAddToInstances(o2Ptr, mixinPtr); } /* * For the reference just created in DUPLICATE. */ AddRef(mixinPtr->thisPtr); } /* * Copy the object's filter list to the new object. */ |
︙ | ︙ | |||
2008 2009 2010 2011 2012 2013 2014 2015 2016 2017 2018 2019 2020 2021 | * kept object-local. The duplicate is never deleted at this point, nor is * it the root of the object system or in the midst of processing a filter * call. */ o2Ptr->flags = oPtr->flags & ~( OBJECT_DELETED | ROOT_OBJECT | ROOT_CLASS | FILTER_HANDLING); /* * Copy the object's metadata. */ if (oPtr->metadataPtr != NULL) { Tcl_ObjectMetadataType *metadataTypePtr; ClientData value, duplicate; | > | 2004 2005 2006 2007 2008 2009 2010 2011 2012 2013 2014 2015 2016 2017 2018 | * kept object-local. The duplicate is never deleted at this point, nor is * it the root of the object system or in the midst of processing a filter * call. */ o2Ptr->flags = oPtr->flags & ~( OBJECT_DELETED | ROOT_OBJECT | ROOT_CLASS | FILTER_HANDLING); /* * Copy the object's metadata. */ if (oPtr->metadataPtr != NULL) { Tcl_ObjectMetadataType *metadataTypePtr; ClientData value, duplicate; |
︙ | ︙ | |||
2071 2072 2073 2074 2075 2076 2077 | } memcpy(cls2Ptr->superclasses.list, clsPtr->superclasses.list, sizeof(Class *) * clsPtr->superclasses.num); cls2Ptr->superclasses.num = clsPtr->superclasses.num; FOREACH(superPtr, cls2Ptr->superclasses) { TclOOAddToSubclasses(cls2Ptr, superPtr); | > | | > | 2068 2069 2070 2071 2072 2073 2074 2075 2076 2077 2078 2079 2080 2081 2082 2083 2084 2085 2086 | } memcpy(cls2Ptr->superclasses.list, clsPtr->superclasses.list, sizeof(Class *) * clsPtr->superclasses.num); cls2Ptr->superclasses.num = clsPtr->superclasses.num; FOREACH(superPtr, cls2Ptr->superclasses) { TclOOAddToSubclasses(cls2Ptr, superPtr); /* * For the new item in cls2Ptr->superclasses that memcpy just * created. */ AddRef(superPtr->thisPtr); } /* * Duplicate the source class's filters. */ |
︙ | ︙ | |||
2117 2118 2119 2120 2121 2122 2123 | TclOODecrRefCount(mixinPtr->thisPtr); } Tcl_Free(clsPtr->mixins.list); } DUPLICATE(cls2Ptr->mixins, clsPtr->mixins, Class *); FOREACH(mixinPtr, cls2Ptr->mixins) { TclOOAddToMixinSubs(cls2Ptr, mixinPtr); | > > | > > | 2116 2117 2118 2119 2120 2121 2122 2123 2124 2125 2126 2127 2128 2129 2130 2131 2132 2133 2134 | TclOODecrRefCount(mixinPtr->thisPtr); } Tcl_Free(clsPtr->mixins.list); } DUPLICATE(cls2Ptr->mixins, clsPtr->mixins, Class *); FOREACH(mixinPtr, cls2Ptr->mixins) { TclOOAddToMixinSubs(cls2Ptr, mixinPtr); /* * For the copy just created in DUPLICATE. */ AddRef(mixinPtr->thisPtr); } /* * Duplicate the source class's methods, constructor and destructor. */ |
︙ | ︙ | |||
2779 2780 2781 2782 2783 2784 2785 | int skip) { CallContext *contextPtr = (CallContext *) context; int savedIndex = contextPtr->index; int savedSkip = contextPtr->skip; int result; | | | 2782 2783 2784 2785 2786 2787 2788 2789 2790 2791 2792 2793 2794 2795 2796 | int skip) { CallContext *contextPtr = (CallContext *) context; int savedIndex = contextPtr->index; int savedSkip = contextPtr->skip; int result; if (contextPtr->index + 1 >= contextPtr->callPtr->numChain) { /* * We're at the end of the chain; generate an error message unless the * interpreter is being torn down, in which case we might be getting * here because of methods/destructors doing a [next] (or equivalent) * unexpectedly. */ |
︙ | ︙ | |||
2848 2849 2850 2851 2852 2853 2854 | Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv, int skip) { register CallContext *contextPtr = (CallContext *) context; | | | 2851 2852 2853 2854 2855 2856 2857 2858 2859 2860 2861 2862 2863 2864 2865 | Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv, int skip) { register CallContext *contextPtr = (CallContext *) context; if (contextPtr->index + 1 >= contextPtr->callPtr->numChain) { /* * We're at the end of the chain; generate an error message unless the * interpreter is being torn down, in which case we might be getting * here because of methods/destructors doing a [next] (or equivalent) * unexpectedly. */ |
︙ | ︙ |
Changes to generic/tclOOCall.c.
︙ | ︙ | |||
324 325 326 327 328 329 330 | * entries in the chain so that they do not get deleted out from under our * feet. */ if (contextPtr->index == 0) { int i; | | | 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 | * entries in the chain so that they do not get deleted out from under our * feet. */ if (contextPtr->index == 0) { int i; for (i = 0 ; i < contextPtr->callPtr->numChain ; i++) { AddRef(contextPtr->callPtr->chain[i].mPtr); } /* * Ensure that the method name itself is part of the arguments when * we're doing unknown processing. */ |
︙ | ︙ | |||
402 403 404 405 406 407 408 | ClientData data[], Tcl_Interp *interp, int result) { CallContext *contextPtr = data[0]; int i; | | | 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 | ClientData data[], Tcl_Interp *interp, int result) { CallContext *contextPtr = data[0]; int i; for (i = 0 ; i < contextPtr->callPtr->numChain ; i++) { TclOODelMethodRef(contextPtr->callPtr->chain[i].mPtr); } return result; } /* * ---------------------------------------------------------------------- |
︙ | ︙ | |||
637 638 639 640 641 642 643 | } else { Tcl_Free((void *)strings); *stringsPtr = NULL; } return i; } | > | > > | 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 | } else { Tcl_Free((void *)strings); *stringsPtr = NULL; } return i; } /* * Comparator for SortMethodNames */ static int CmpStr( const void *ptr1, const void *ptr2) { const char **strPtr1 = (const char **) ptr1; const char **strPtr2 = (const char **) ptr2; |
︙ | ︙ | |||
1000 1001 1002 1003 1004 1005 1006 | } /* * First test whether the method is already in the call chain. Skip over * any leading filters. */ | | | | | 1003 1004 1005 1006 1007 1008 1009 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 | } /* * First test whether the method is already in the call chain. Skip over * any leading filters. */ for (i = cbPtr->filterLength ; i < callPtr->numChain ; i++) { if (callPtr->chain[i].mPtr == mPtr && callPtr->chain[i].isFilter == (doneFilters != NULL)) { /* * Call chain semantics states that methods come as *late* in the * call chain as possible. This is done by copying down the * following methods. Note that this does not change the number of * method invocations in the call chain; it just rearranges them. */ Class *declCls = callPtr->chain[i].filterDeclarer; for (; i + 1 < callPtr->numChain ; i++) { callPtr->chain[i] = callPtr->chain[i + 1]; } callPtr->chain[i].mPtr = mPtr; callPtr->chain[i].isFilter = (doneFilters != NULL); callPtr->chain[i].filterDeclarer = declCls; return; } } |
︙ | ︙ | |||
1813 1814 1815 1816 1817 1818 1819 | * special because it's a filter method). The second word is the name of * the method in question (which differs for "unknown" and "filter" types) * and the third word is the full name of the class that declares the * method (or "object" if it is declared on the instance). */ objv = TclStackAlloc(interp, callPtr->numChain * sizeof(Tcl_Obj *)); | | | 1816 1817 1818 1819 1820 1821 1822 1823 1824 1825 1826 1827 1828 1829 1830 | * special because it's a filter method). The second word is the name of * the method in question (which differs for "unknown" and "filter" types) * and the third word is the full name of the class that declares the * method (or "object" if it is declared on the instance). */ objv = TclStackAlloc(interp, callPtr->numChain * sizeof(Tcl_Obj *)); for (i = 0 ; i < callPtr->numChain ; i++) { struct MInvoke *miPtr = &callPtr->chain[i]; descObjs[0] = miPtr->isFilter ? filterLiteral : callPtr->flags & OO_UNKNOWN_METHOD ? fPtr->unknownMethodNameObj : IS_PRIVATE(miPtr->mPtr) ? privateLiteral : methodLiteral; |
︙ | ︙ |
Changes to generic/tclOODefineCmds.c.
︙ | ︙ | |||
45 46 47 48 49 50 51 52 53 54 55 56 57 58 | {TCL_OO_METHOD_VERSION_CURRENT, "core method: " name " Getter", \ getter, NULL, NULL}, \ {TCL_OO_METHOD_VERSION_CURRENT, "core method: " name " Setter", \ setter, NULL, NULL}, \ {TCL_OO_METHOD_VERSION_CURRENT, "core method: " name " Resolver", \ resolver, NULL, NULL}} /* * Forward declarations. */ static inline void BumpGlobalEpoch(Tcl_Interp *interp, Class *classPtr); static Tcl_Command FindCommand(Tcl_Interp *interp, Tcl_Obj *stringObj, Tcl_Namespace *const namespacePtr); | > > > > > > | 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 | {TCL_OO_METHOD_VERSION_CURRENT, "core method: " name " Getter", \ getter, NULL, NULL}, \ {TCL_OO_METHOD_VERSION_CURRENT, "core method: " name " Setter", \ setter, NULL, NULL}, \ {TCL_OO_METHOD_VERSION_CURRENT, "core method: " name " Resolver", \ resolver, NULL, NULL}} /* * A [string match] pattern used to determine if a method should be exported. */ #define PUBLIC_PATTERN "[a-z]*" /* * Forward declarations. */ static inline void BumpGlobalEpoch(Tcl_Interp *interp, Class *classPtr); static Tcl_Command FindCommand(Tcl_Interp *interp, Tcl_Obj *stringObj, Tcl_Namespace *const namespacePtr); |
︙ | ︙ | |||
274 275 276 277 278 279 280 | int size = sizeof(Tcl_Obj *) * numFilters; /* should be size_t */ if (oPtr->filters.num == 0) { filtersList = Tcl_Alloc(size); } else { filtersList = Tcl_Realloc(oPtr->filters.list, size); } | | | 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 | int size = sizeof(Tcl_Obj *) * numFilters; /* should be size_t */ if (oPtr->filters.num == 0) { filtersList = Tcl_Alloc(size); } else { filtersList = Tcl_Realloc(oPtr->filters.list, size); } for (i = 0 ; i < numFilters ; i++) { filtersList[i] = filters[i]; Tcl_IncrRefCount(filters[i]); } oPtr->filters.list = filtersList; oPtr->filters.num = numFilters; oPtr->flags &= ~USE_CLASS_CACHE; } |
︙ | ︙ | |||
333 334 335 336 337 338 339 | int size = sizeof(Tcl_Obj *) * numFilters; /* should be size_t */ if (classPtr->filters.num == 0) { filtersList = Tcl_Alloc(size); } else { filtersList = Tcl_Realloc(classPtr->filters.list, size); } | | | 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 | int size = sizeof(Tcl_Obj *) * numFilters; /* should be size_t */ if (classPtr->filters.num == 0) { filtersList = Tcl_Alloc(size); } else { filtersList = Tcl_Realloc(classPtr->filters.list, size); } for (i = 0 ; i < numFilters ; i++) { filtersList[i] = filters[i]; Tcl_IncrRefCount(filters[i]); } classPtr->filters.list = filtersList; classPtr->filters.num = numFilters; } |
︙ | ︙ | |||
396 397 398 399 400 401 402 | oPtr->flags &= ~USE_CLASS_CACHE; } oPtr->mixins.num = numMixins; memcpy(oPtr->mixins.list, mixins, sizeof(Class *) * numMixins); FOREACH(mixinPtr, oPtr->mixins) { if (mixinPtr != oPtr->selfCls) { TclOOAddToInstances(oPtr, mixinPtr); | > > | > > | 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 | oPtr->flags &= ~USE_CLASS_CACHE; } oPtr->mixins.num = numMixins; memcpy(oPtr->mixins.list, mixins, sizeof(Class *) * numMixins); FOREACH(mixinPtr, oPtr->mixins) { if (mixinPtr != oPtr->selfCls) { TclOOAddToInstances(oPtr, mixinPtr); /* * For the new copy created by memcpy(). */ AddRef(mixinPtr->thisPtr); } } } oPtr->epoch++; } |
︙ | ︙ | |||
448 449 450 451 452 453 454 | } else { classPtr->mixins.list = Tcl_Alloc(sizeof(Class *) * numMixins); } classPtr->mixins.num = numMixins; memcpy(classPtr->mixins.list, mixins, sizeof(Class *) * numMixins); FOREACH(mixinPtr, classPtr->mixins) { TclOOAddToMixinSubs(classPtr, mixinPtr); | > > | > > | 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 | } else { classPtr->mixins.list = Tcl_Alloc(sizeof(Class *) * numMixins); } classPtr->mixins.num = numMixins; memcpy(classPtr->mixins.list, mixins, sizeof(Class *) * numMixins); FOREACH(mixinPtr, classPtr->mixins) { TclOOAddToMixinSubs(classPtr, mixinPtr); /* * For the new copy created by memcpy. */ AddRef(mixinPtr->thisPtr); } } BumpGlobalEpoch(interp, classPtr); } /* |
︙ | ︙ | |||
720 721 722 723 724 725 726 | } if (matchedStr != NULL) { /* * Got one match, and only one match! */ | | > | | | 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 | } if (matchedStr != NULL) { /* * Got one match, and only one match! */ Tcl_Obj **newObjv = TclStackAlloc(interp, sizeof(Tcl_Obj*) * (objc - 1)); int result; newObjv[0] = Tcl_NewStringObj(matchedStr, -1); Tcl_IncrRefCount(newObjv[0]); if (objc > 2) { memcpy(newObjv + 1, objv + 2, sizeof(Tcl_Obj *) * (objc - 2)); } result = Tcl_EvalObjv(interp, objc - 1, newObjv, 0); Tcl_DecrRefCount(newObjv[0]); TclStackFree(interp, newObjv); return result; } noMatch: Tcl_SetObjResult(interp, Tcl_ObjPrintf( |
︙ | ︙ | |||
1035 1036 1037 1038 1039 1040 1041 | * comments above for why these contortions are necessary. */ objPtr = Tcl_NewObj(); obj2Ptr = Tcl_NewObj(); cmd = FindCommand(interp, objv[cmdIndex], nsPtr); if (cmd == NULL) { | > | > > | | | 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 | * comments above for why these contortions are necessary. */ objPtr = Tcl_NewObj(); obj2Ptr = Tcl_NewObj(); cmd = FindCommand(interp, objv[cmdIndex], nsPtr); if (cmd == NULL) { /* * Punt this case! */ Tcl_AppendObjToObj(obj2Ptr, objv[cmdIndex]); } else { Tcl_GetCommandFullName(interp, cmd, obj2Ptr); } Tcl_ListObjAppendElement(NULL, objPtr, obj2Ptr); /* TODO: overflow? */ Tcl_ListObjReplace(NULL, objPtr, 1, 0, objc - offset, objv + offset); Tcl_ListObjGetElements(NULL, objPtr, &dummy, &objs); result = Tcl_EvalObjv(interp, objc - cmdIndex, objs, TCL_EVAL_INVOKE); if (isRoot) { TclResetRewriteEnsemble(interp, 1); } Tcl_DecrRefCount(objPtr); return result; } |
︙ | ︙ | |||
1681 1682 1683 1684 1685 1686 1687 | if (!isInstanceDeleteMethod && !oPtr->classPtr) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "attempt to misuse API", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL); return TCL_ERROR; } | | | 1699 1700 1701 1702 1703 1704 1705 1706 1707 1708 1709 1710 1711 1712 1713 | if (!isInstanceDeleteMethod && !oPtr->classPtr) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "attempt to misuse API", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL); return TCL_ERROR; } for (i = 1; i < objc; i++) { /* * Delete the method structure from the appropriate hash table. */ if (RenameDeleteMethod(interp, oPtr, !isInstanceDeleteMethod, objv[i], NULL) != TCL_OK) { return TCL_ERROR; |
︙ | ︙ | |||
1807 1808 1809 1810 1811 1812 1813 | if (!isInstanceExport && !clsPtr) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "attempt to misuse API", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL); return TCL_ERROR; } | | | 1825 1826 1827 1828 1829 1830 1831 1832 1833 1834 1835 1836 1837 1838 1839 | if (!isInstanceExport && !clsPtr) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "attempt to misuse API", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL); return TCL_ERROR; } for (i = 1; i < objc; i++) { /* * Exporting is done by adding the PUBLIC_METHOD flag to the method * record. If there is no such method in this object or class (i.e. * the method comes from something inherited from or that we're an * instance of) then we put in a blank record with that flag; such * records are skipped over by the call chain engine *except* for * their flags member. |
︙ | ︙ | |||
1900 1901 1902 1903 1904 1905 1906 | } if (!isInstanceForward && !oPtr->classPtr) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "attempt to misuse API", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL); return TCL_ERROR; } | | | | 1918 1919 1920 1921 1922 1923 1924 1925 1926 1927 1928 1929 1930 1931 1932 1933 1934 1935 1936 1937 1938 1939 1940 1941 1942 | } if (!isInstanceForward && !oPtr->classPtr) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "attempt to misuse API", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL); return TCL_ERROR; } isPublic = Tcl_StringMatch(TclGetString(objv[1]), PUBLIC_PATTERN) ? PUBLIC_METHOD : 0; if (IsPrivateDefine(interp)) { isPublic = TRUE_PRIVATE_METHOD; } /* * Create the method structure. */ prefixObj = Tcl_NewListObj(objc - 2, objv + 2); if (isInstanceForward) { mPtr = TclOONewForwardInstanceMethod(interp, oPtr, isPublic, objv[1], prefixObj); } else { mPtr = TclOONewForwardMethod(interp, oPtr->classPtr, isPublic, objv[1], prefixObj); } |
︙ | ︙ | |||
1998 1999 2000 2001 2002 2003 2004 | isPublic = 0; break; } } else { if (IsPrivateDefine(interp)) { isPublic = TRUE_PRIVATE_METHOD; } else { | | | 2016 2017 2018 2019 2020 2021 2022 2023 2024 2025 2026 2027 2028 2029 2030 | isPublic = 0; break; } } else { if (IsPrivateDefine(interp)) { isPublic = TRUE_PRIVATE_METHOD; } else { isPublic = Tcl_StringMatch(TclGetString(objv[1]), PUBLIC_PATTERN) ? PUBLIC_METHOD : 0; } } /* * Create the method by using the right back-end API. */ |
︙ | ︙ | |||
2120 2121 2122 2123 2124 2125 2126 | if (!isInstanceUnexport && !clsPtr) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "attempt to misuse API", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL); return TCL_ERROR; } | | | 2138 2139 2140 2141 2142 2143 2144 2145 2146 2147 2148 2149 2150 2151 2152 | if (!isInstanceUnexport && !clsPtr) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "attempt to misuse API", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL); return TCL_ERROR; } for (i = 1; i < objc; i++) { /* * Unexporting is done by removing the PUBLIC_METHOD flag from the * method record. If there is no such method in this object or class * (i.e. the method comes from something inherited from or that we're * an instance of) then we put in a blank record without that flag; * such records are skipped over by the call chain engine *except* for * their flags member. |
︙ | ︙ | |||
2336 2337 2338 2339 2340 2341 2342 | int objc, Tcl_Obj *const *objv) { Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp); int filterc; Tcl_Obj **filterv; | | | 2354 2355 2356 2357 2358 2359 2360 2361 2362 2363 2364 2365 2366 2367 2368 | int objc, Tcl_Obj *const *objv) { Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp); int filterc; Tcl_Obj **filterv; if (Tcl_ObjectContextSkippedArgs(context) + 1 != objc) { Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv, "filterList"); return TCL_ERROR; } objv += Tcl_ObjectContextSkippedArgs(context); if (oPtr == NULL) { |
︙ | ︙ | |||
2420 2421 2422 2423 2424 2425 2426 | Tcl_Obj *const *objv) { Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp); int mixinc, i; Tcl_Obj **mixinv; Class **mixins; | | | | 2438 2439 2440 2441 2442 2443 2444 2445 2446 2447 2448 2449 2450 2451 2452 2453 2454 2455 2456 2457 2458 2459 2460 2461 2462 2463 2464 2465 2466 2467 2468 2469 2470 2471 2472 2473 | Tcl_Obj *const *objv) { Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp); int mixinc, i; Tcl_Obj **mixinv; Class **mixins; if (Tcl_ObjectContextSkippedArgs(context) + 1 != objc) { Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv, "mixinList"); return TCL_ERROR; } objv += Tcl_ObjectContextSkippedArgs(context); if (oPtr == NULL) { return TCL_ERROR; } else if (!oPtr->classPtr) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "attempt to misuse API", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL); return TCL_ERROR; } else if (Tcl_ListObjGetElements(interp, objv[0], &mixinc, &mixinv) != TCL_OK) { return TCL_ERROR; } mixins = TclStackAlloc(interp, sizeof(Class *) * mixinc); for (i = 0; i < mixinc; i++) { mixins[i] = GetClassInOuterContext(interp, mixinv[i], "may only mix in classes"); if (mixins[i] == NULL) { i--; goto freeAndError; } if (TclOOIsReachable(oPtr->classPtr, mixins[i])) { |
︙ | ︙ | |||
2525 2526 2527 2528 2529 2530 2531 | Tcl_Obj *const *objv) { Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp); int superc, i, j; Tcl_Obj **superv; Class **superclasses, *superPtr; | | | 2543 2544 2545 2546 2547 2548 2549 2550 2551 2552 2553 2554 2555 2556 2557 | Tcl_Obj *const *objv) { Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp); int superc, i, j; Tcl_Obj **superv; Class **superclasses, *superPtr; if (Tcl_ObjectContextSkippedArgs(context) + 1 != objc) { Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv, "superclassList"); return TCL_ERROR; } objv += Tcl_ObjectContextSkippedArgs(context); if (oPtr == NULL) { |
︙ | ︙ | |||
2572 2573 2574 2575 2576 2577 2578 | superclasses[0] = oPtr->fPtr->classCls; } else { superclasses[0] = oPtr->fPtr->objectCls; } superc = 1; AddRef(superclasses[0]->thisPtr); } else { | | | | 2590 2591 2592 2593 2594 2595 2596 2597 2598 2599 2600 2601 2602 2603 2604 2605 2606 2607 2608 2609 2610 2611 | superclasses[0] = oPtr->fPtr->classCls; } else { superclasses[0] = oPtr->fPtr->objectCls; } superc = 1; AddRef(superclasses[0]->thisPtr); } else { for (i = 0; i < superc; i++) { superclasses[i] = GetClassInOuterContext(interp, superv[i], "only a class can be a superclass"); if (superclasses[i] == NULL) { i--; goto failedAfterAlloc; } for (j = 0; j < i; j++) { if (superclasses[j] == superclasses[i]) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "class should only be a direct superclass once", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "REPETITIOUS",NULL); goto failedAfterAlloc; } |
︙ | ︙ | |||
2701 2702 2703 2704 2705 2706 2707 | Tcl_Obj *const *objv) { Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp); int varc; Tcl_Obj **varv; int i; | | | | 2719 2720 2721 2722 2723 2724 2725 2726 2727 2728 2729 2730 2731 2732 2733 2734 2735 2736 2737 2738 2739 2740 2741 2742 2743 2744 2745 2746 2747 2748 2749 2750 2751 2752 | Tcl_Obj *const *objv) { Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp); int varc; Tcl_Obj **varv; int i; if (Tcl_ObjectContextSkippedArgs(context) + 1 != objc) { Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv, "filterList"); return TCL_ERROR; } objv += Tcl_ObjectContextSkippedArgs(context); if (oPtr == NULL) { return TCL_ERROR; } else if (!oPtr->classPtr) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "attempt to misuse API", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL); return TCL_ERROR; } else if (Tcl_ListObjGetElements(interp, objv[0], &varc, &varv) != TCL_OK) { return TCL_ERROR; } for (i = 0; i < varc; i++) { const char *varName = TclGetString(varv[i]); if (strstr(varName, "::") != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "invalid declared variable name \"%s\": must not %s", varName, "contain namespace separators")); Tcl_SetErrorCode(interp, "TCL", "OO", "BAD_DECLVAR", NULL); |
︙ | ︙ | |||
2799 2800 2801 2802 2803 2804 2805 | int objc, Tcl_Obj *const *objv) { Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp); int filterc; Tcl_Obj **filterv; | | | 2817 2818 2819 2820 2821 2822 2823 2824 2825 2826 2827 2828 2829 2830 2831 | int objc, Tcl_Obj *const *objv) { Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp); int filterc; Tcl_Obj **filterv; if (Tcl_ObjectContextSkippedArgs(context) + 1 != objc) { Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv, "filterList"); return TCL_ERROR; } else if (oPtr == NULL) { return TCL_ERROR; } objv += Tcl_ObjectContextSkippedArgs(context); |
︙ | ︙ | |||
2873 2874 2875 2876 2877 2878 2879 | { Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp); int mixinc; Tcl_Obj **mixinv; Class **mixins; int i; | | | | 2891 2892 2893 2894 2895 2896 2897 2898 2899 2900 2901 2902 2903 2904 2905 2906 2907 2908 2909 2910 2911 2912 2913 2914 2915 2916 2917 2918 2919 2920 | { Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp); int mixinc; Tcl_Obj **mixinv; Class **mixins; int i; if (Tcl_ObjectContextSkippedArgs(context) + 1 != objc) { Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv, "mixinList"); return TCL_ERROR; } else if (oPtr == NULL) { return TCL_ERROR; } objv += Tcl_ObjectContextSkippedArgs(context); if (Tcl_ListObjGetElements(interp, objv[0], &mixinc, &mixinv) != TCL_OK) { return TCL_ERROR; } mixins = TclStackAlloc(interp, sizeof(Class *) * mixinc); for (i = 0; i < mixinc; i++) { mixins[i] = GetClassInOuterContext(interp, mixinv[i], "may only mix in classes"); if (mixins[i] == NULL) { TclStackFree(interp, mixins); return TCL_ERROR; } } |
︙ | ︙ | |||
2963 2964 2965 2966 2967 2968 2969 | int objc, Tcl_Obj *const *objv) { Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp); int varc, i; Tcl_Obj **varv; | | | | 2981 2982 2983 2984 2985 2986 2987 2988 2989 2990 2991 2992 2993 2994 2995 2996 2997 2998 2999 3000 3001 3002 3003 3004 3005 3006 3007 3008 | int objc, Tcl_Obj *const *objv) { Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp); int varc, i; Tcl_Obj **varv; if (Tcl_ObjectContextSkippedArgs(context) + 1 != objc) { Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv, "variableList"); return TCL_ERROR; } else if (oPtr == NULL) { return TCL_ERROR; } objv += Tcl_ObjectContextSkippedArgs(context); if (Tcl_ListObjGetElements(interp, objv[0], &varc, &varv) != TCL_OK) { return TCL_ERROR; } for (i = 0; i < varc; i++) { const char *varName = TclGetString(varv[i]); if (strstr(varName, "::") != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "invalid declared variable name \"%s\": must not %s", varName, "contain namespace separators")); Tcl_SetErrorCode(interp, "TCL", "OO", "BAD_DECLVAR", NULL); |
︙ | ︙ |
Changes to generic/tclTest.c.
︙ | ︙ | |||
962 963 964 965 966 967 968 | int id = PTR2INT(clientData); const char *listArgv[4]; char *cmd; char string[TCL_INTEGER_SPACE]; Tcl_MutexLock(&asyncTestMutex); for (asyncPtr = firstHandler; asyncPtr != NULL; | | | > > | 962 963 964 965 966 967 968 969 970 971 972 973 974 975 976 977 978 979 | int id = PTR2INT(clientData); const char *listArgv[4]; char *cmd; char string[TCL_INTEGER_SPACE]; Tcl_MutexLock(&asyncTestMutex); for (asyncPtr = firstHandler; asyncPtr != NULL; asyncPtr = asyncPtr->nextPtr) { if (asyncPtr->id == id) { break; } } Tcl_MutexUnlock(&asyncTestMutex); if (!asyncPtr) { /* Woops - this one was deleted between the AsyncMark and now */ return TCL_OK; } |
︙ | ︙ |
Changes to generic/tclTimer.c.
︙ | ︙ | |||
306 307 308 309 310 311 312 | memcpy(&timerHandlerPtr->time, timePtr, sizeof(Tcl_Time)); timerHandlerPtr->proc = proc; timerHandlerPtr->clientData = clientData; tsdPtr->lastTimerId++; timerHandlerPtr->token = (Tcl_TimerToken) INT2PTR(tsdPtr->lastTimerId); /* | | | | 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 | memcpy(&timerHandlerPtr->time, timePtr, sizeof(Tcl_Time)); timerHandlerPtr->proc = proc; timerHandlerPtr->clientData = clientData; tsdPtr->lastTimerId++; timerHandlerPtr->token = (Tcl_TimerToken) INT2PTR(tsdPtr->lastTimerId); /* * Add the event to the queue in the correct position (ordered by event * firing time). */ for (tPtr2 = tsdPtr->firstTimerHandlerPtr, prevPtr = NULL; tPtr2 != NULL; prevPtr = tPtr2, tPtr2 = tPtr2->nextPtr) { if (TCL_TIME_BEFORE(timerHandlerPtr->time, tPtr2->time)) { break; } |
︙ | ︙ | |||
1009 1010 1011 1012 1013 1014 1015 | Interp *iPtr = (Interp *) interp; Tcl_Time endTime, now; Tcl_WideInt diff; Tcl_GetTime(&now); endTime = now; | | | | 1009 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 | Interp *iPtr = (Interp *) interp; Tcl_Time endTime, now; Tcl_WideInt diff; Tcl_GetTime(&now); endTime = now; endTime.sec += (long)(ms / 1000); endTime.usec += ((int)(ms % 1000)) * 1000; if (endTime.usec >= 1000000) { endTime.sec++; endTime.usec -= 1000000; } do { if (Tcl_AsyncReady()) { |
︙ | ︙ | |||
1038 1039 1040 1041 1042 1043 1044 | } if (iPtr->limit.timeEvent == NULL || TCL_TIME_BEFORE(endTime, iPtr->limit.time)) { diff = TCL_TIME_DIFF_MS_CEILING(endTime, now); if (diff > TCL_TIME_MAXIMUM_SLICE) { diff = TCL_TIME_MAXIMUM_SLICE; } | | | | | | | | | | | 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 | } if (iPtr->limit.timeEvent == NULL || TCL_TIME_BEFORE(endTime, iPtr->limit.time)) { diff = TCL_TIME_DIFF_MS_CEILING(endTime, now); if (diff > TCL_TIME_MAXIMUM_SLICE) { diff = TCL_TIME_MAXIMUM_SLICE; } if (diff == 0 && TCL_TIME_BEFORE(now, endTime)) { diff = 1; } if (diff > 0) { Tcl_Sleep((long) diff); if (diff < SLEEP_OFFLOAD_GETTIMEOFDAY) { break; } } else { break; } } else { diff = TCL_TIME_DIFF_MS(iPtr->limit.time, now); if (diff > TCL_TIME_MAXIMUM_SLICE) { diff = TCL_TIME_MAXIMUM_SLICE; } if (diff > 0) { Tcl_Sleep((int) diff); |
︙ | ︙ |
Changes to library/msgs/ja.msg.
︙ | ︙ | |||
36 37 38 39 40 41 42 | ::msgcat::mcset ja DATE_FORMAT "%Y/%m/%d" ::msgcat::mcset ja TIME_FORMAT "%k:%M:%S" ::msgcat::mcset ja TIME_FORMAT_12 "%P %I:%M:%S" ::msgcat::mcset ja DATE_TIME_FORMAT "%Y/%m/%d %k:%M:%S %z" ::msgcat::mcset ja LOCALE_DATE_FORMAT "%EY年%m月%d日" ::msgcat::mcset ja LOCALE_TIME_FORMAT "%H時%M分%S秒" ::msgcat::mcset ja LOCALE_DATE_TIME_FORMAT "%EY年%m月%d日 (%a) %H時%M分%S秒 %z" | | | 36 37 38 39 40 41 42 43 44 | ::msgcat::mcset ja DATE_FORMAT "%Y/%m/%d" ::msgcat::mcset ja TIME_FORMAT "%k:%M:%S" ::msgcat::mcset ja TIME_FORMAT_12 "%P %I:%M:%S" ::msgcat::mcset ja DATE_TIME_FORMAT "%Y/%m/%d %k:%M:%S %z" ::msgcat::mcset ja LOCALE_DATE_FORMAT "%EY年%m月%d日" ::msgcat::mcset ja LOCALE_TIME_FORMAT "%H時%M分%S秒" ::msgcat::mcset ja LOCALE_DATE_TIME_FORMAT "%EY年%m月%d日 (%a) %H時%M分%S秒 %z" ::msgcat::mcset ja LOCALE_ERAS "{-9223372036854775808 西暦 0} {-3061011600 明治 1867} {-1812186000 大正 1911} {-1357635600 昭和 1925} {600220800 平成 1988} {1556668800 令和 2018}" } |
Changes to tests/basic.test.
︙ | ︙ | |||
959 960 961 962 963 964 965 966 967 968 969 970 971 972 | } -result {0 10 1 Hejsan} test basic-48.24.$noComp {expansion: empty not canonical list, regression test, bug [cc1e91552c]} -constraints $constraints -setup { unset -nocomplain a } -body { run {list [list {*}{ }] [list {*}[format %c 32]] [list {*}[set a { }]]} } -result [lrepeat 3 {}] -cleanup {unset -nocomplain a} } ;# End of noComp loop test basic-49.1 {Tcl_EvalEx: verify TCL_EVAL_GLOBAL operation} testevalex { set ::x global namespace eval ns { variable x namespace | > > > > > > > > > > > > | 959 960 961 962 963 964 965 966 967 968 969 970 971 972 973 974 975 976 977 978 979 980 981 982 983 984 | } -result {0 10 1 Hejsan} test basic-48.24.$noComp {expansion: empty not canonical list, regression test, bug [cc1e91552c]} -constraints $constraints -setup { unset -nocomplain a } -body { run {list [list {*}{ }] [list {*}[format %c 32]] [list {*}[set a { }]]} } -result [lrepeat 3 {}] -cleanup {unset -nocomplain a} test basic-48.25.$noComp {Bug cc191552c: expansion: empty non-canonical list} -setup { unset -nocomplain ::CRLF set ::CRLF "\r\n" } -body { # Force variant that turned up in Bug 2c154a40be as that's externally # noticeable in an important downstream project. run {scan [list {*}$::CRLF]x %c%c%c} } -cleanup { unset -nocomplain ::CRLF } -result {120 {} {}} } ;# End of noComp loop test basic-49.1 {Tcl_EvalEx: verify TCL_EVAL_GLOBAL operation} testevalex { set ::x global namespace eval ns { variable x namespace |
︙ | ︙ |
Changes to tests/clock.test.
︙ | ︙ | |||
36703 36704 36705 36706 36707 36708 36709 | } } return $retval } } -body { set trouble {} | | | | | | | | | | > > | | 36703 36704 36705 36706 36707 36708 36709 36710 36711 36712 36713 36714 36715 36716 36717 36718 36719 36720 36721 36722 36723 36724 36725 36726 36727 36728 | } } return $retval } } -body { set trouble {} foreach {date jdate} { 1872-12-31 \u897f\u66a61872\u5e7412\u670831\u65e5 1873-01-01 \u660e\u6cbb06\u5e7401\u670801\u65e5 1912-07-29 \u660e\u6cbb45\u5e7407\u670829\u65e5 1912-07-30 \u5927\u6b6301\u5e7407\u670830\u65e5 1926-12-24 \u5927\u6b6315\u5e7412\u670824\u65e5 1926-12-25 \u662d\u548c01\u5e7412\u670825\u65e5 1989-01-07 \u662d\u548c64\u5e7401\u670807\u65e5 1989-01-08 \u5e73\u621001\u5e7401\u670808\u65e5 2019-04-30 \u5e73\u621031\u5e7404\u670830\u65e5 2019-05-01 \u4ee4\u548c01\u5e7405\u670801\u65e5 } { set status [catch { set secs [clock scan $date \ -timezone +0900 \ -locale ja_JP \ -format %Y-%m-%d] set jda [clock format $secs \ -timezone +0900 \ |
︙ | ︙ |
Changes to tests/coroutine.test.
︙ | ︙ | |||
788 789 790 791 792 793 794 795 796 797 798 799 800 801 | } slave eval demo set result [slave eval {set ::result}] interp delete slave set result } -result {inject-executed} # cleanup unset lambda ::tcltest::cleanupTests return | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 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 849 850 851 852 853 854 855 856 857 858 859 860 861 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 | } slave eval demo set result [slave eval {set ::result}] interp delete slave set result } -result {inject-executed} test coroutine-9.1 {coro type} { coroutine demo eval { yield yield "PHASE 1" yieldto string cat "PHASE 2" ::tcl::unsupported::corotype [info coroutine] } list [demo] [::tcl::unsupported::corotype demo] \ [demo] [::tcl::unsupported::corotype demo] [demo] } {{PHASE 1} yield {PHASE 2} yieldto active} test coroutine-9.2 {coro type} -setup { catch {rename nosuchcommand ""} } -returnCodes error -body { ::tcl::unsupported::corotype nosuchcommand } -result {can only get coroutine type of a coroutine} test coroutine-9.3 {coro type} -returnCodes error -body { proc notacoroutine {} {} ::tcl::unsupported::corotype notacoroutine } -returnCodes error -cleanup { rename notacoroutine {} } -result {can only get coroutine type of a coroutine} test coroutine-10.1 {coroutine general introspection} -setup { set i [interp create] } -body { $i eval { # Make the introspection code namespace path tcl::unsupported proc probe {type var} { upvar 1 $var v set f [info frame] incr f -1 set result [list $v [dict get [info frame $f] proc]] if {$type eq "yield"} { tailcall yield $result } else { tailcall yieldto string cat $result } } proc pokecoro {c var} { inject $c probe [corotype $c] $var $c } # Coroutine implementations proc cbody1 {} { set val [info coroutine] set accum {} while {[set val [yield $val]] ne ""} { lappend accum $val set val ok } return $accum } proc cbody2 {} { set val [info coroutine] set accum {} while {[llength [set val [yieldto string cat $val]]]} { lappend accum {*}$val set val ok } return $accum } # Make the coroutines coroutine c1 cbody1 coroutine c2 cbody2 list [c1 abc] [c2 1 2 3] [pokecoro c1 accum] [pokecoro c2 accum] \ [c1 def] [c2 4 5 6] [pokecoro c1 accum] [pokecoro c2 accum] \ [c1] [c2] } } -cleanup { interp delete $i } -result {ok ok {abc ::cbody1} {{1 2 3} ::cbody2} ok ok {{abc def} ::cbody1} {{1 2 3 4 5 6} ::cbody2} {abc def} {1 2 3 4 5 6}} # cleanup unset lambda ::tcltest::cleanupTests return |
︙ | ︙ |
Changes to tests/link.test.
︙ | ︙ | |||
21 22 23 24 25 26 27 28 29 30 31 32 33 34 | testConstraint testlink [llength [info commands testlink]] testConstraint testlinkarray [llength [info commands testlinkarray]] foreach i {int real bool string} { unset -nocomplain $i } test link-1.1 {reading C variables from Tcl} -constraints {testlink} -setup { testlink delete } -body { testlink set 43 1.23 4 - 12341234 64 250 30000 60000 0xbeefbabe 12321 32123 3.25 1231231234 testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1 list $int $real $bool $string $wide | > > > > > > > > > > | 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 | testConstraint testlink [llength [info commands testlink]] testConstraint testlinkarray [llength [info commands testlinkarray]] foreach i {int real bool string} { unset -nocomplain $i } test link-0.1 {leak test} {testlink} { interp create i load {} Tcltest i i eval { testlink create 1 0 0 0 0 0 0 0 0 0 0 0 0 0 namespace delete :: } interp delete i } {} test link-1.1 {reading C variables from Tcl} -constraints {testlink} -setup { testlink delete } -body { testlink set 43 1.23 4 - 12341234 64 250 30000 60000 0xbeefbabe 12321 32123 3.25 1231231234 testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1 list $int $real $bool $string $wide |
︙ | ︙ |
Changes to win/tclWinFile.c.
︙ | ︙ | |||
676 677 678 679 680 681 682 | const WCHAR *linkDirPath, /* The junction to read */ REPARSE_DATA_BUFFER *buffer,/* Pointer to buffer. Cannot be NULL */ DWORD desiredAccess) { HANDLE hFile; DWORD returnedLength; | | > | 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 | const WCHAR *linkDirPath, /* The junction to read */ REPARSE_DATA_BUFFER *buffer,/* Pointer to buffer. Cannot be NULL */ DWORD desiredAccess) { HANDLE hFile; DWORD returnedLength; hFile = CreateFile(linkDirPath, desiredAccess, FILE_SHARE_READ, NULL, OPEN_EXISTING, FILE_FLAG_OPEN_REPARSE_POINT | FILE_FLAG_BACKUP_SEMANTICS, NULL); if (hFile == INVALID_HANDLE_VALUE) { /* * Error creating directory. */ |
︙ | ︙ | |||
828 829 830 831 832 833 834 | OutputDebugStringW(msgString); } else { MessageBeep(MB_ICONEXCLAMATION); MessageBoxW(NULL, msgString, L"Fatal Error", MB_ICONSTOP | MB_OK | MB_TASKMODAL | MB_SETFOREGROUND); } } | | | 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 | OutputDebugStringW(msgString); } else { MessageBeep(MB_ICONEXCLAMATION); MessageBoxW(NULL, msgString, L"Fatal Error", MB_ICONSTOP | MB_OK | MB_TASKMODAL | MB_SETFOREGROUND); } } /* *--------------------------------------------------------------------------- * * TclpFindExecutable -- * * This function computes the absolute path name of the current * application. |
︙ | ︙ | |||
1426 1427 1428 1429 1430 1431 1432 | Tcl_DStringInit(bufferPtr); wDomain = NULL; domain = Tcl_UtfFindFirst(name, '@'); if (domain == NULL) { const char *ptr; | > | > > | | < > | > > | | > | > > > > | > > | > > > > > > | > > | | > > | 1427 1428 1429 1430 1431 1432 1433 1434 1435 1436 1437 1438 1439 1440 1441 1442 1443 1444 1445 1446 1447 1448 1449 1450 1451 1452 1453 1454 1455 1456 1457 1458 1459 1460 1461 1462 1463 1464 1465 1466 1467 1468 1469 1470 1471 1472 1473 1474 1475 1476 1477 1478 1479 1480 1481 1482 1483 1484 1485 1486 1487 1488 1489 1490 1491 1492 1493 1494 1495 1496 1497 1498 1499 1500 1501 1502 1503 1504 1505 1506 1507 1508 1509 1510 1511 1512 1513 1514 1515 1516 1517 | Tcl_DStringInit(bufferPtr); wDomain = NULL; domain = Tcl_UtfFindFirst(name, '@'); if (domain == NULL) { const char *ptr; /* * No domain. Firstly check it's the current user */ ptr = TclpGetUserName(&ds); if (ptr != NULL && strcasecmp(name, ptr) == 0) { /* * Try safest and fastest way to get current user home */ ptr = TclGetEnv("HOME", &ds); if (ptr != NULL) { Tcl_JoinPath(1, &ptr, bufferPtr); rc = 1; result = Tcl_DStringValue(bufferPtr); } } Tcl_DStringFree(&ds); } else { Tcl_DStringInit(&ds); wName = TclUtfToWCharDString(domain + 1, -1, &ds); rc = NetGetDCName(NULL, wName, (LPBYTE *) &wDomain); Tcl_DStringFree(&ds); nameLen = domain - name; } if (rc == 0) { Tcl_DStringInit(&ds); wName = TclUtfToWCharDString(name, nameLen, &ds); while (NetUserGetInfo(wDomain, wName, 1, (LPBYTE *) &uiPtr) != 0) { /* * User does not exist; if domain was not specified, try again * using current domain. */ rc = 1; if (domain != NULL) { break; } /* * Get current domain */ rc = NetGetDCName(NULL, NULL, (LPBYTE *) &wDomain); if (rc != 0) { break; } domain = INT2PTR(-1); /* repeat once */ } if (rc == 0) { DWORD i, size = MAX_PATH; wHomeDir = uiPtr->usri1_home_dir; if ((wHomeDir != NULL) && (wHomeDir[0] != L'\0')) { size = lstrlenW(wHomeDir); TclWCharToUtfDString(wHomeDir, size, bufferPtr); } else { /* * User exists but has no home dir. Return * "{GetProfilesDirectory}/<user>". */ GetProfilesDirectoryW(buf, &size); TclWCharToUtfDString(buf, size-1, bufferPtr); Tcl_DStringAppend(bufferPtr, "/", 1); Tcl_DStringAppend(bufferPtr, name, nameLen); } result = Tcl_DStringValue(bufferPtr); /* * Be sure we return normalized path */ for (i = 0; i < size; ++i) { if (result[i] == '\\') { result[i] = '/'; } } NetApiBufferFree((void *) uiPtr); } Tcl_DStringFree(&ds); } if (wDomain != NULL) { NetApiBufferFree((void *) wDomain); |
︙ | ︙ | |||
1568 1569 1570 1571 1572 1573 1574 1575 1576 1577 1578 | return 0; } /* * If it's not a directory (assume file), do several fast checks: */ if (!(attr & FILE_ATTRIBUTE_DIRECTORY)) { /* * If the attributes say this is not writable at all. The file is a * regular file (i.e., not a directory), then the file is not | > | | | > > | > > > > | > > > | > > | > > | > | > | | > > | > > > > | > > | 1591 1592 1593 1594 1595 1596 1597 1598 1599 1600 1601 1602 1603 1604 1605 1606 1607 1608 1609 1610 1611 1612 1613 1614 1615 1616 1617 1618 1619 1620 1621 1622 1623 1624 1625 1626 1627 1628 1629 1630 1631 1632 1633 1634 1635 1636 1637 1638 1639 1640 1641 1642 1643 1644 1645 1646 1647 1648 1649 1650 1651 1652 1653 1654 1655 1656 1657 1658 1659 1660 1661 1662 1663 1664 1665 1666 1667 1668 1669 1670 | return 0; } /* * If it's not a directory (assume file), do several fast checks: */ if (!(attr & FILE_ATTRIBUTE_DIRECTORY)) { /* * If the attributes say this is not writable at all. The file is a * regular file (i.e., not a directory), then the file is not * writable, full stop. For directories, the read-only bit is * (mostly) ignored by Windows, so we can't ascertain anything about * directory access from the attrib data. However, if we have the * advanced 'getFileSecurityProc', then more robust ACL checks will be * done below. */ if ((mode & W_OK) && (attr & FILE_ATTRIBUTE_READONLY)) { Tcl_SetErrno(EACCES); return -1; } /* * If doesn't have the correct extension, it can't be executable */ if ((mode & X_OK) && !NativeIsExec(nativePath)) { Tcl_SetErrno(EACCES); return -1; } /* * Special case for read/write/executable check on file */ if ((mode & (R_OK|W_OK|X_OK)) && !(mode & ~(R_OK|W_OK|X_OK))) { DWORD mask = 0; HANDLE hFile; if (mode & R_OK) { mask |= GENERIC_READ; } if (mode & W_OK) { mask |= GENERIC_WRITE; } if (mode & X_OK) { mask |= GENERIC_EXECUTE; } hFile = CreateFile(nativePath, mask, FILE_SHARE_READ | FILE_SHARE_WRITE | FILE_SHARE_DELETE, NULL, OPEN_EXISTING, FILE_FLAG_NO_BUFFERING, NULL); if (hFile != INVALID_HANDLE_VALUE) { CloseHandle(hFile); return 0; } /* * Fast exit if access was denied */ if (GetLastError() == ERROR_ACCESS_DENIED) { Tcl_SetErrno(EACCES); return -1; } } /* * We cannnot verify the access fast, check it below using security * info. */ } /* * It looks as if the permissions are ok, but if we are on NT, 2000 or XP, * we have a more complex permissions structure so we try to check that. * The code below is remarkably complex for such a simple thing as finding * what permissions the OS has set for a file. |
︙ | ︙ | |||
1984 1985 1986 1987 1988 1989 1990 | /* * If we can use 'createFile' on this, then we can use the resulting * fileHandle to read more information (nlink, ino) than we can get from * other attributes reading APIs. If not, then we try to fall back on the * 'getFileAttributesExProc', and if that isn't available, then on even * simpler routines. * | | | | | | | < > > | > > | 2031 2032 2033 2034 2035 2036 2037 2038 2039 2040 2041 2042 2043 2044 2045 2046 2047 2048 2049 2050 2051 2052 2053 2054 2055 2056 2057 2058 2059 2060 2061 2062 2063 2064 2065 2066 2067 2068 2069 2070 2071 2072 | /* * If we can use 'createFile' on this, then we can use the resulting * fileHandle to read more information (nlink, ino) than we can get from * other attributes reading APIs. If not, then we try to fall back on the * 'getFileAttributesExProc', and if that isn't available, then on even * simpler routines. * * Special consideration must be given to Windows hardcoded names like * CON, NULL, COM1, LPT1 etc. For these, we still need to do the * CreateFile as some may not exist (e.g. there is no CON in wish by * default). However the subsequent GetFileInformationByHandle will * fail. We do a WinIsReserved to see if it is one of the special names, * and if successful, mock up a BY_HANDLE_FILE_INFORMATION structure. */ fileHandle = CreateFile(nativePath, GENERIC_READ, FILE_SHARE_READ | FILE_SHARE_WRITE | FILE_SHARE_DELETE, NULL, OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS | FILE_FLAG_OPEN_REPARSE_POINT, NULL); if (fileHandle != INVALID_HANDLE_VALUE) { BY_HANDLE_FILE_INFORMATION data; if (GetFileInformationByHandle(fileHandle,&data) != TRUE) { fileType = GetFileType(fileHandle); CloseHandle(fileHandle); if (fileType != FILE_TYPE_CHAR && fileType != FILE_TYPE_DISK) { Tcl_SetErrno(ENOENT); return -1; } /* * Mock up the expected structure */ memset(&data, 0, sizeof(data)); statPtr->st_atime = 0; statPtr->st_mtime = 0; statPtr->st_ctime = 0; } else { CloseHandle(fileHandle); statPtr->st_atime = ToCTime(data.ftLastAccessTime); |
︙ | ︙ | |||
2291 2292 2293 2294 2295 2296 2297 | if (GetCurrentDirectory(MAX_PATH, buffer) == 0) { TclWinConvertError(GetLastError()); return NULL; } if (clientData != NULL) { | | | 2341 2342 2343 2344 2345 2346 2347 2348 2349 2350 2351 2352 2353 2354 2355 | if (GetCurrentDirectory(MAX_PATH, buffer) == 0) { TclWinConvertError(GetLastError()); return NULL; } if (clientData != NULL) { if (wcscmp((const WCHAR *) clientData, buffer) == 0) { return clientData; } } return TclNativeDupInternalRep(buffer); } |
︙ | ︙ | |||
2519 2520 2521 2522 2523 2524 2525 | } } Tcl_DStringAppend(&dsNorm, (const char *)nativePath, (int)(sizeof(WCHAR) * len)); lastValidPathEnd = currentPathEndPosition; } else if (nextCheckpoint == 0) { | > | | | > | | | | | < | | | 2569 2570 2571 2572 2573 2574 2575 2576 2577 2578 2579 2580 2581 2582 2583 2584 2585 2586 2587 2588 2589 2590 2591 2592 2593 2594 2595 2596 2597 2598 2599 2600 2601 2602 2603 2604 2605 2606 2607 2608 2609 2610 2611 2612 2613 2614 2615 2616 | } } Tcl_DStringAppend(&dsNorm, (const char *)nativePath, (int)(sizeof(WCHAR) * len)); lastValidPathEnd = currentPathEndPosition; } else if (nextCheckpoint == 0) { /* * Path starts with a drive designation that's not * actually on the system. We still must normalize up * past the first separator. [Bug 3603434] */ currentPathEndPosition++; } } Tcl_DStringFree(&ds); break; } /* * File 'nativePath' does exist if we get here. We now want to * check if it is a symlink and otherwise continue with the * rest of the path. */ /* * Check for symlinks, except at last component of path (we don't * follow final symlinks). Also a drive (C:/) for example, may * sometimes have the reparse flag set for some reason I don't * understand. We therefore don't perform this check for drives. */ if (cur != 0 && !isDrive && data.dwFileAttributes & FILE_ATTRIBUTE_REPARSE_POINT){ Tcl_Obj *to = WinReadLinkDirectory(nativePath); if (to != NULL) { /* * Read the reparse point ok. Now, reparse points need not * be normalized, otherwise we could use: * * Tcl_GetStringFromObj(to, &pathLen); * nextCheckpoint = pathLen; * * So, instead we have to start from the beginning. */ |
︙ | ︙ | |||
2591 2592 2593 2594 2595 2596 2597 | Tcl_DStringFree(&ds); continue; } } #ifndef TclNORM_LONG_PATH /* | | | | | 2642 2643 2644 2645 2646 2647 2648 2649 2650 2651 2652 2653 2654 2655 2656 2657 2658 | Tcl_DStringFree(&ds); continue; } } #ifndef TclNORM_LONG_PATH /* * Now we convert the tail of the current path to its 'long form', * and append it to 'dsNorm' which holds the current normalized * path */ if (isDrive) { WCHAR drive = ((WCHAR *) nativePath)[0]; if (drive >= L'a') { drive -= (L'a' - L'A'); |
︙ | ︙ | |||
2622 2623 2624 2625 2626 2627 2628 | checkDots++; } } if (checkDots != NULL) { int dotLen = currentPathEndPosition-lastValidPathEnd; /* | | | | | | < | 2673 2674 2675 2676 2677 2678 2679 2680 2681 2682 2683 2684 2685 2686 2687 2688 2689 2690 2691 2692 2693 2694 2695 2696 2697 2698 2699 2700 2701 2702 2703 2704 2705 2706 2707 2708 | checkDots++; } } if (checkDots != NULL) { int dotLen = currentPathEndPosition-lastValidPathEnd; /* * Path is just dots. We shouldn't really ever see a path * like that. However, to be nice we at least don't mangle * the path - we just add the dots as a path segment and * continue. */ Tcl_DStringAppend(&dsNorm, ((const char *)nativePath) + Tcl_DStringLength(&ds) - (dotLen * sizeof(WCHAR)), dotLen * sizeof(WCHAR)); } else { /* * Normal path. */ WIN32_FIND_DATAW fData; HANDLE handle; handle = FindFirstFileW((WCHAR *) nativePath, &fData); if (handle == INVALID_HANDLE_VALUE) { /* * This is usually the '/' in 'c:/' at end of string. */ Tcl_DStringAppend(&dsNorm, (const char *) L"/", sizeof(WCHAR)); } else { WCHAR *nativeName; |
︙ | ︙ | |||
2674 2675 2676 2677 2678 2679 2680 | Tcl_DStringFree(&ds); lastValidPathEnd = currentPathEndPosition; if (cur == 0) { break; } /* | | | | 2724 2725 2726 2727 2728 2729 2730 2731 2732 2733 2734 2735 2736 2737 2738 2739 | Tcl_DStringFree(&ds); lastValidPathEnd = currentPathEndPosition; if (cur == 0) { break; } /* * If we get here, we've got past one directory delimiter, so we * know it is no longer a drive. */ isDrive = 0; } currentPathEndPosition++; #ifdef TclNORM_LONG_PATH |
︙ | ︙ | |||
2969 2970 2971 2972 2973 2974 2975 | * shorter so the utf-to-external conversion will be somewhat faster). */ validPathPtr = Tcl_FSGetTranslatedPath(NULL, pathPtr); if (validPathPtr == NULL) { return NULL; } | > > | > > > > | > > > > | > > > > | > > > | | > > > > | > > | | > > | | | | > | > | | < | | | | > | | > | | > | | > | | | | | > | | | > < | 3019 3020 3021 3022 3023 3024 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 3102 3103 3104 3105 3106 3107 3108 3109 3110 3111 3112 3113 3114 3115 3116 3117 3118 3119 3120 3121 3122 3123 3124 3125 3126 3127 3128 3129 3130 3131 3132 3133 3134 3135 3136 3137 3138 3139 3140 3141 3142 3143 3144 3145 3146 3147 3148 3149 3150 | * shorter so the utf-to-external conversion will be somewhat faster). */ validPathPtr = Tcl_FSGetTranslatedPath(NULL, pathPtr); if (validPathPtr == NULL) { return NULL; } /* * refCount of validPathPtr was already incremented in * Tcl_FSGetTranslatedPath */ } else { /* * Make sure the normalized path is set. */ validPathPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr); if (validPathPtr == NULL) { return NULL; } /* * validPathPtr returned from Tcl_FSGetNormalizedPath is owned by Tcl, * so incr refCount here */ Tcl_IncrRefCount(validPathPtr); } str = TclGetStringFromObj(validPathPtr, &len); if (strlen(str) != len) { /* * String contains NUL-bytes. This is invalid. */ goto done; } /* * For a reserved device, strip a possible postfix ':' */ len = WinIsReserved(str); if (len == 0) { /* * Let MultiByteToWideChar check for other invalid sequences, like * 0xC0 0x80 (== overlong NUL). See bug [3118489]: NUL in filenames */ len = MultiByteToWideChar(CP_UTF8, MB_ERR_INVALID_CHARS, str, -1, 0, 0); if (len==0) { goto done; } } /* * Overallocate 6 chars, making some room for extended paths */ wp = nativePathPtr = Tcl_Alloc((len + 6) * sizeof(WCHAR)); if (nativePathPtr==0) { goto done; } MultiByteToWideChar(CP_UTF8, MB_ERR_INVALID_CHARS, str, -1, nativePathPtr, len + 1); /* * If path starts with "//?/" or "\\?\" (extended path), translate any * slashes to backslashes but leave the '?' intact */ if ((str[0] == '\\' || str[0] == '/') && (str[1] == '\\' || str[1] == '/') && str[2] == '?' && (str[3] == '\\' || str[3] == '/')) { wp[0] = wp[1] = wp[3] = '\\'; str += 4; wp += 4; } /* * If there is no "\\?\" prefix but there is a drive or UNC path prefix * and the path is larger than MAX_PATH chars, no Win32 API function can * handle that unless it is prefixed with the extended path prefix. See: * <http://msdn.microsoft.com/en-us/library/aa365247(VS.85).aspx#maxpath> */ if (((str[0] >= 'A' && str[0] <= 'Z') || (str[0] >= 'a' && str[0] <= 'z')) && str[1] == ':') { if (wp == nativePathPtr && len > MAX_PATH && (str[2] == '\\' || str[2] == '/')) { memmove(wp + 4, wp, len * sizeof(WCHAR)); memcpy(wp, L"\\\\?\\", 4 * sizeof(WCHAR)); wp += 4; } /* * If (remainder of) path starts with "<drive>:", leave the ':' * intact. */ wp += 2; } else if (wp == nativePathPtr && len > MAX_PATH && (str[0] == '\\' || str[0] == '/') && (str[1] == '\\' || str[1] == '/') && str[2] != '?') { memmove(wp + 6, wp, len * sizeof(WCHAR)); memcpy(wp, L"\\\\?\\UNC", 7 * sizeof(WCHAR)); wp += 7; } /* * In the remainder of the path, translate invalid characters to * characters in the Unicode private use area. */ while (*wp != '\0') { if ((*wp < ' ') || wcschr(L"\"*:<>?|", *wp)) { *wp |= 0xF000; } else if (*wp == '/') { *wp = '\\'; } ++wp; } done: TclDecrRefCount(validPathPtr); return nativePathPtr; } /* *--------------------------------------------------------------------------- * |
︙ | ︙ | |||
3181 3182 3183 3184 3185 3186 3187 | LPBYTE buf = NULL; DWORD bufsz; int owned = 0; native = Tcl_FSGetNativePath(pathPtr); if (GetNamedSecurityInfo((LPTSTR) native, SE_FILE_OBJECT, | | | > | | > > | | | | > > | > > > | > > | > | > | | 3262 3263 3264 3265 3266 3267 3268 3269 3270 3271 3272 3273 3274 3275 3276 3277 3278 3279 3280 3281 3282 3283 3284 3285 3286 3287 3288 3289 3290 3291 3292 3293 3294 3295 3296 3297 3298 3299 3300 3301 3302 3303 3304 3305 3306 3307 3308 3309 3310 3311 3312 3313 3314 3315 3316 3317 3318 3319 3320 3321 3322 | LPBYTE buf = NULL; DWORD bufsz; int owned = 0; native = Tcl_FSGetNativePath(pathPtr); if (GetNamedSecurityInfo((LPTSTR) native, SE_FILE_OBJECT, OWNER_SECURITY_INFORMATION, &ownerSid, NULL, NULL, NULL, &secd) != ERROR_SUCCESS) { /* * Either not a file, or we do not have access to it in which case we * are in all likelihood not the owner. */ return 0; } /* * Getting the current process SID is a multi-step process. We make the * assumption that if a call fails, this process is so underprivileged it * could not possibly own anything. Normally a process can *always* look * up its own token. */ if (OpenProcessToken(GetCurrentProcess(), TOKEN_QUERY, &token)) { /* * Find out how big the buffer needs to be. */ bufsz = 0; GetTokenInformation(token, TokenUser, NULL, 0, &bufsz); if (bufsz) { buf = Tcl_Alloc(bufsz); if (GetTokenInformation(token, TokenUser, buf, bufsz, &bufsz)) { owned = EqualSid(ownerSid, ((PTOKEN_USER) buf)->User.Sid); } } CloseHandle(token); } /* * Free allocations and be done. */ if (secd) { LocalFree(secd); /* Also frees ownerSid */ } if (buf) { Tcl_Free(buf); } return (owned != 0); /* Convert non-0 to 1 */ } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ |
Changes to win/tclWinPipe.c.
︙ | ︙ | |||
120 121 122 123 124 125 126 | HANDLE readable; /* Manual-reset event to signal when the * reader thread has finished waiting for * input. */ DWORD writeError; /* An error caused by the last background * write. Set to 0 if no error has been * detected. This word is shared with the * writer thread so access must be | | < | 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 | HANDLE readable; /* Manual-reset event to signal when the * reader thread has finished waiting for * input. */ DWORD writeError; /* An error caused by the last background * write. Set to 0 if no error has been * detected. This word is shared with the * writer thread so access must be * synchronized with the writable object. */ char *writeBuf; /* Current background output buffer. Access is * synchronized with the writable object. */ int writeBufLen; /* Size of write buffer. Access is * synchronized with the writable object. */ int toWrite; /* Current amount to be written. Access is * synchronized with the writable object. */ int readFlags; /* Flags that are shared with the reader |
︙ | ︙ | |||
214 215 216 217 218 219 220 | PipeGetHandleProc, /* Get an OS handle from channel. */ PipeClose2Proc, /* close2proc */ PipeBlockModeProc, /* Set blocking or non-blocking mode.*/ NULL, /* flush proc. */ NULL, /* handler proc. */ NULL, /* wide seek proc */ PipeThreadActionProc, /* thread action proc */ | | | 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 | PipeGetHandleProc, /* Get an OS handle from channel. */ PipeClose2Proc, /* close2proc */ PipeBlockModeProc, /* Set blocking or non-blocking mode.*/ NULL, /* flush proc. */ NULL, /* handler proc. */ NULL, /* wide seek proc */ PipeThreadActionProc, /* thread action proc */ NULL /* truncate */ }; /* *---------------------------------------------------------------------- * * PipeInit -- * |
︙ | ︙ | |||
1424 1425 1426 1427 1428 1429 1430 | * *---------------------------------------------------------------------- */ static const char * BuildCmdLineBypassBS( const char *current, | | < > > | > > | < > | | | < > > | > > > | > > > | | | | > > > | > > | > > > | > > > | > > > | | > | | < | > | | 1423 1424 1425 1426 1427 1428 1429 1430 1431 1432 1433 1434 1435 1436 1437 1438 1439 1440 1441 1442 1443 1444 1445 1446 1447 1448 1449 1450 1451 1452 1453 1454 1455 1456 1457 1458 1459 1460 1461 1462 1463 1464 1465 1466 1467 1468 1469 1470 1471 1472 1473 1474 1475 1476 1477 1478 1479 1480 1481 1482 1483 1484 1485 1486 1487 1488 1489 1490 1491 1492 1493 1494 1495 1496 1497 1498 1499 1500 1501 1502 1503 1504 1505 1506 1507 1508 1509 1510 1511 1512 1513 1514 1515 1516 1517 1518 1519 1520 1521 1522 1523 1524 1525 1526 1527 1528 1529 1530 1531 1532 1533 1534 1535 1536 1537 1538 1539 1540 1541 1542 1543 1544 1545 1546 1547 1548 1549 1550 1551 1552 1553 1554 1555 1556 1557 | * *---------------------------------------------------------------------- */ static const char * BuildCmdLineBypassBS( const char *current, const char **bspos) { /* * Mark first backslash position. */ if (!*bspos) { *bspos = current; } do { current++; } while (*current == '\\'); return current; } static void QuoteCmdLineBackslash( Tcl_DString *dsPtr, const char *start, const char *current, const char *bspos) { if (!bspos) { if (current > start) { /* part before current (special) */ Tcl_DStringAppend(dsPtr, start, (int) (current - start)); } } else { if (bspos > start) { /* part before first backslash */ Tcl_DStringAppend(dsPtr, start, (int) (bspos - start)); } while (bspos++ < current) { /* each backslash twice */ TclDStringAppendLiteral(dsPtr, "\\\\"); } } } static const char * QuoteCmdLinePart( Tcl_DString *dsPtr, const char *start, const char *special, const char *specMetaChars, const char **bspos) { if (!*bspos) { /* * Rest before special (before quote). */ QuoteCmdLineBackslash(dsPtr, start, special, NULL); start = special; } else { /* * Rest before first backslash and backslashes into new quoted block. */ QuoteCmdLineBackslash(dsPtr, start, *bspos, NULL); start = *bspos; } /* * escape all special chars enclosed in quotes like `"..."`, note that * here we don't must escape `\` (with `\`), because it's outside of the * main quotes, so `\` remains `\`, but important - not at end of part, * because results as before the quote, so `%\%\` should be escaped as * `"%\%"\\`). */ TclDStringAppendLiteral(dsPtr, "\""); /* opening escape quote-char */ do { *bspos = NULL; special++; if (*special == '\\') { /* * Bypass backslashes (and mark first backslash position). */ special = BuildCmdLineBypassBS(special, bspos); if (*special == '\0') { break; } } } while (*special && strchr(specMetaChars, *special)); if (!*bspos) { /* * Unescaped rest before quote. */ QuoteCmdLineBackslash(dsPtr, start, special, NULL); } else { /* * Unescaped rest before first backslash (rather belongs to the main * block). */ QuoteCmdLineBackslash(dsPtr, start, *bspos, NULL); } TclDStringAppendLiteral(dsPtr, "\""); /* closing escape quote-char */ return special; } static void BuildCommandLine( const char *executable, /* Full path of executable (including * extension). Replacement for argv[0]. */ int argc, /* Number of arguments. */ const char **argv, /* Argument strings in UTF. */ Tcl_DString *linePtr) /* Initialized Tcl_DString that receives the * command line (WCHAR). */ { const char *arg, *start, *special, *bspos; int quote = 0, i; Tcl_DString ds; static const char specMetaChars[] = "&|^<>!()%"; /* Characters to enclose in quotes if unpaired * quote flag set. */ static const char specMetaChars2[] = "%"; /* Character to enclose in quotes in any case * (regardless of unpaired-flag). */ /* * Quote flags: * CL_ESCAPE - escape argument; * CL_QUOTE - enclose in quotes; * CL_UNPAIRED - previous arguments chain contains unpaired quote-char; */ enum {CL_ESCAPE = 1, CL_QUOTE = 2, CL_UNPAIRED = 4}; Tcl_DStringInit(&ds); |
︙ | ︙ | |||
1551 1552 1553 1554 1555 1556 1557 | quote &= ~(CL_ESCAPE|CL_QUOTE); /* reset escape flags */ bspos = NULL; if (arg[0] == '\0') { quote = CL_QUOTE; } else { for (start = arg; | | | | < | > > | | | | | > | > > > | > > > | > > > > | > > | > > > > > > | > > | > > > > | > > > > | > > > | > > > | > > > > | > > > | > > > | > > > > | > > | > > > | > > > | > | > > | 1575 1576 1577 1578 1579 1580 1581 1582 1583 1584 1585 1586 1587 1588 1589 1590 1591 1592 1593 1594 1595 1596 1597 1598 1599 1600 1601 1602 1603 1604 1605 1606 1607 1608 1609 1610 1611 1612 1613 1614 1615 1616 1617 1618 1619 1620 1621 1622 1623 1624 1625 1626 1627 1628 1629 1630 1631 1632 1633 1634 1635 1636 1637 1638 1639 1640 1641 1642 1643 1644 1645 1646 1647 1648 1649 1650 1651 1652 1653 1654 1655 1656 1657 1658 1659 1660 1661 1662 1663 1664 1665 1666 1667 1668 1669 1670 1671 1672 1673 1674 1675 1676 1677 1678 1679 1680 1681 1682 1683 1684 1685 1686 1687 1688 1689 1690 1691 1692 1693 1694 1695 1696 1697 1698 1699 1700 1701 1702 1703 1704 1705 1706 1707 1708 1709 1710 1711 1712 1713 1714 1715 1716 1717 1718 1719 1720 1721 1722 1723 1724 1725 1726 1727 1728 1729 1730 1731 1732 | quote &= ~(CL_ESCAPE|CL_QUOTE); /* reset escape flags */ bspos = NULL; if (arg[0] == '\0') { quote = CL_QUOTE; } else { for (start = arg; *start != '\0' && (quote & (CL_ESCAPE|CL_QUOTE)) != (CL_ESCAPE|CL_QUOTE); start++) { if (*start & 0x80) { continue; } if (TclIsSpaceProc(*start)) { quote |= CL_QUOTE; /* quote only */ if (bspos) { /* if backslash found, escape & quote */ quote |= CL_ESCAPE; break; } continue; } if (strchr(specMetaChars, *start)) { quote |= (CL_ESCAPE|CL_QUOTE); /* escape & quote */ break; } if (*start == '"') { quote |= CL_ESCAPE; /* escape only */ continue; } if (*start == '\\') { bspos = start; if (quote & CL_QUOTE) { /* if quote, escape & quote */ quote |= CL_ESCAPE; break; } continue; } } bspos = NULL; } if (quote & CL_QUOTE) { /* * Start of argument (main opening quote-char). */ TclDStringAppendLiteral(&ds, "\""); } if (!(quote & CL_ESCAPE)) { /* * Nothing to escape. */ Tcl_DStringAppend(&ds, arg, -1); } else { start = arg; for (special = arg; *special != '\0'; ) { /* * Position of `\` is important before quote or at end (equal * `\"` because quoted). */ if (*special == '\\') { /* * Bypass backslashes (and mark first backslash position) */ special = BuildCmdLineBypassBS(special, &bspos); if (*special == '\0') { break; } } /* ["] */ if (*special == '"') { /* * Invert the unpaired flag - observe unpaired quotes */ quote ^= CL_UNPAIRED; /* * Add part before (and escape backslashes before quote). */ QuoteCmdLineBackslash(&ds, start, special, bspos); bspos = NULL; /* * Escape using backslash */ TclDStringAppendLiteral(&ds, "\\\""); start = ++special; continue; } /* * Unpaired (escaped) quote causes special handling on * meta-chars */ if ((quote & CL_UNPAIRED) && strchr(specMetaChars, *special)) { special = QuoteCmdLinePart(&ds, start, special, specMetaChars, &bspos); /* * Start to current or first backslash */ start = !bspos ? special : bspos; continue; } /* * Special case for % - should be enclosed always (paired * also) */ if (strchr(specMetaChars2, *special)) { special = QuoteCmdLinePart(&ds, start, special, specMetaChars2, &bspos); /* * Start to current or first backslash. */ start = !bspos ? special : bspos; continue; } /* * Other not special (and not meta) character */ bspos = NULL; /* reset last backslash position (not * interesting) */ special++; } /* * Rest of argument (and escape backslashes before closing main * quote) */ QuoteCmdLineBackslash(&ds, start, special, (quote & CL_QUOTE) ? bspos : NULL); } if (quote & CL_QUOTE) { /* * End of argument (main closing quote-char) */ TclDStringAppendLiteral(&ds, "\""); } } Tcl_DStringFree(linePtr); Tcl_WinUtfToTChar(Tcl_DStringValue(&ds), Tcl_DStringLength(&ds), linePtr); Tcl_DStringFree(&ds); } |
︙ | ︙ | |||
2171 2172 2173 2174 2175 2176 2177 | PipeInfo *infoPtr = (PipeInfo *) instanceData; WinFile *filePtr = (WinFile*) infoPtr->writeFile; DWORD bytesWritten, timeout; *errorCode = 0; /* avoid blocking if pipe-thread exited */ | | > | | 2256 2257 2258 2259 2260 2261 2262 2263 2264 2265 2266 2267 2268 2269 2270 2271 2272 | PipeInfo *infoPtr = (PipeInfo *) instanceData; WinFile *filePtr = (WinFile*) infoPtr->writeFile; DWORD bytesWritten, timeout; *errorCode = 0; /* avoid blocking if pipe-thread exited */ timeout = ((infoPtr->flags & PIPE_ASYNC) || !TclPipeThreadIsAlive(&infoPtr->writeTI) || TclInExit() || TclInThreadExit()) ? 0 : INFINITE; if (WaitForSingleObject(infoPtr->writable, timeout) == WAIT_TIMEOUT) { /* * The writer thread is blocked waiting for a write to complete and * the channel is in non-blocking mode. */ errno = EWOULDBLOCK; |
︙ | ︙ | |||
2358 2359 2360 2361 2362 2363 2364 2365 2366 2367 2368 2369 2370 2371 | * Since most of the work is handled by the background threads, we just * need to update the watchMask and then force the notifier to poll once. */ infoPtr->watchMask = mask & infoPtr->validMask; if (infoPtr->watchMask) { Tcl_Time blockTime = { 0, 0 }; if (!oldMask) { infoPtr->nextPtr = tsdPtr->firstPipePtr; tsdPtr->firstPipePtr = infoPtr; } Tcl_SetMaxBlockTime(&blockTime); } else { if (oldMask) { | > | 2444 2445 2446 2447 2448 2449 2450 2451 2452 2453 2454 2455 2456 2457 2458 | * Since most of the work is handled by the background threads, we just * need to update the watchMask and then force the notifier to poll once. */ infoPtr->watchMask = mask & infoPtr->validMask; if (infoPtr->watchMask) { Tcl_Time blockTime = { 0, 0 }; if (!oldMask) { infoPtr->nextPtr = tsdPtr->firstPipePtr; tsdPtr->firstPipePtr = infoPtr; } Tcl_SetMaxBlockTime(&blockTime); } else { if (oldMask) { |
︙ | ︙ | |||
2827 2828 2829 2830 2831 2832 2833 | *---------------------------------------------------------------------- */ static DWORD WINAPI PipeReaderThread( LPVOID arg) { | | > | | 2914 2915 2916 2917 2918 2919 2920 2921 2922 2923 2924 2925 2926 2927 2928 2929 2930 2931 2932 2933 2934 2935 2936 2937 2938 2939 2940 2941 2942 2943 2944 2945 2946 | *---------------------------------------------------------------------- */ static DWORD WINAPI PipeReaderThread( LPVOID arg) { TclPipeThreadInfo *pipeTI = (TclPipeThreadInfo *) arg; PipeInfo *infoPtr = NULL; /* access info only after success init/wait */ HANDLE handle = NULL; DWORD count, err; int done = 0; while (!done) { /* * Wait for the main thread to signal before attempting to wait on the * pipe becoming readable. */ if (!TclPipeThreadWaitForSignal(&pipeTI)) { /* exit */ break; } if (!infoPtr) { infoPtr = (PipeInfo *) pipeTI->clientData; handle = ((WinFile *) infoPtr->readFile)->handle; } /* * Try waiting for 0 bytes. This will block until some data is * available on NT, but will return immediately on Win 95. So, if no * data is available after the first read, we block until we can read |
︙ | ︙ | |||
3191 3192 3193 3194 3195 3196 3197 | HANDLE wakeEvent) { TclPipeThreadInfo *pipeTI; #ifndef _PTI_USE_CKALLOC pipeTI = malloc(sizeof(TclPipeThreadInfo)); #else pipeTI = Tcl_Alloc(sizeof(TclPipeThreadInfo)); | | | 3279 3280 3281 3282 3283 3284 3285 3286 3287 3288 3289 3290 3291 3292 3293 | HANDLE wakeEvent) { TclPipeThreadInfo *pipeTI; #ifndef _PTI_USE_CKALLOC pipeTI = malloc(sizeof(TclPipeThreadInfo)); #else pipeTI = Tcl_Alloc(sizeof(TclPipeThreadInfo)); #endif /* !_PTI_USE_CKALLOC */ pipeTI->evControl = CreateEvent(NULL, FALSE, FALSE, NULL); pipeTI->state = PTI_STATE_IDLE; pipeTI->clientData = clientData; pipeTI->evWakeUp = wakeEvent; return (*pipeTIPtr = pipeTI); } |
︙ | ︙ | |||
3230 3231 3232 3233 3234 3235 3236 3237 3238 3239 3240 | HANDLE wakeEvent; if (!pipeTI) { return 0; } wakeEvent = pipeTI->evWakeUp; /* * Wait for the main thread to signal before attempting to do the work. */ | > > | > > | > | > | > > > > | < > > < > > | > > | > | > | > > > | > > | > | > > | 3318 3319 3320 3321 3322 3323 3324 3325 3326 3327 3328 3329 3330 3331 3332 3333 3334 3335 3336 3337 3338 3339 3340 3341 3342 3343 3344 3345 3346 3347 3348 3349 3350 3351 3352 3353 3354 3355 3356 3357 3358 3359 3360 3361 3362 3363 3364 3365 3366 3367 3368 3369 3370 3371 3372 3373 3374 3375 3376 3377 3378 3379 3380 3381 3382 3383 3384 3385 3386 3387 3388 3389 | HANDLE wakeEvent; if (!pipeTI) { return 0; } wakeEvent = pipeTI->evWakeUp; /* * Wait for the main thread to signal before attempting to do the work. */ /* * Reset work state of thread (idle/waiting) */ state = InterlockedCompareExchange(&pipeTI->state, PTI_STATE_IDLE, PTI_STATE_WORK); if (state & (PTI_STATE_STOP|PTI_STATE_END)) { /* * End of work, check the owner of structure. */ goto end; } /* * Entering wait */ waitResult = WaitForSingleObject(pipeTI->evControl, INFINITE); if (waitResult != WAIT_OBJECT_0) { /* * The control event was not signaled, so end of work (unexpected * behaviour, main thread can be dead?). */ goto end; } /* * Try to set work state of thread */ state = InterlockedCompareExchange(&pipeTI->state, PTI_STATE_WORK, PTI_STATE_IDLE); if (state & (PTI_STATE_STOP|PTI_STATE_END)) { /* * End of work */ goto end; } /* * Signaled to work. */ return 1; end: /* * End of work, check the owner of the TI structure. */ if (state != PTI_STATE_STOP) { *pipeTIPtr = NULL; } else { pipeTI->evWakeUp = NULL; } if (wakeEvent) { SetEvent(wakeEvent); |
︙ | ︙ | |||
3293 3294 3295 3296 3297 3298 3299 | * 1 if signaled (or pipe-thread is down), 0 if pipe thread still working. * *---------------------------------------------------------------------- */ int TclPipeThreadStopSignal( | | > < | | | < | | | < > > | < | < | | | | > | > | | 3405 3406 3407 3408 3409 3410 3411 3412 3413 3414 3415 3416 3417 3418 3419 3420 3421 3422 3423 3424 3425 3426 3427 3428 3429 3430 3431 3432 3433 3434 3435 3436 3437 3438 3439 3440 3441 3442 3443 3444 3445 3446 3447 3448 3449 3450 3451 | * 1 if signaled (or pipe-thread is down), 0 if pipe thread still working. * *---------------------------------------------------------------------- */ int TclPipeThreadStopSignal( TclPipeThreadInfo **pipeTIPtr, HANDLE wakeEvent) { TclPipeThreadInfo *pipeTI = *pipeTIPtr; HANDLE evControl; int state; if (!pipeTI) { return 1; } evControl = pipeTI->evControl; pipeTI->evWakeUp = wakeEvent; state = InterlockedCompareExchange(&pipeTI->state, PTI_STATE_STOP, PTI_STATE_IDLE); switch (state) { case PTI_STATE_IDLE: /* * Thread was idle/waiting, notify it goes teardown */ SetEvent(evControl); *pipeTIPtr = NULL; case PTI_STATE_DOWN: return 1; default: /* * Thread works currently, we should try to end it, own the TI * structure (because of possible sharing the joint structures with * thread) */ InterlockedExchange(&pipeTI->state, PTI_STATE_END); break; } return 0; } /* |
︙ | ︙ | |||
3368 3369 3370 3371 3372 3373 3374 3375 3376 3377 | if (!pipeTI) { return; } pipeTI = *pipeTIPtr; evControl = pipeTI->evControl; pipeTI->evWakeUp = NULL; /* * Try to sane stop the pipe worker, corresponding its current state */ | > | | | | < | | | > > | > | > > > | | > | > > | | > | > > | > | | | | | > | > | | | > | > | < > < > > | | > | < > > | | | | | < | | | | | > | | | > | | | > | | > | > | | | < > | > > > < > | | | | 3480 3481 3482 3483 3484 3485 3486 3487 3488 3489 3490 3491 3492 3493 3494 3495 3496 3497 3498 3499 3500 3501 3502 3503 3504 3505 3506 3507 3508 3509 3510 3511 3512 3513 3514 3515 3516 3517 3518 3519 3520 3521 3522 3523 3524 3525 3526 3527 3528 3529 3530 3531 3532 3533 3534 3535 3536 3537 3538 3539 3540 3541 3542 3543 3544 3545 3546 3547 3548 3549 3550 3551 3552 3553 3554 3555 3556 3557 3558 3559 3560 3561 3562 3563 3564 3565 3566 3567 3568 3569 3570 3571 3572 3573 3574 3575 3576 3577 3578 3579 3580 3581 3582 3583 3584 3585 3586 3587 3588 3589 3590 3591 3592 3593 3594 3595 3596 3597 3598 3599 3600 3601 3602 3603 3604 3605 3606 3607 3608 3609 3610 3611 3612 3613 3614 3615 3616 3617 3618 3619 3620 3621 3622 3623 3624 3625 3626 3627 3628 3629 3630 3631 3632 3633 3634 3635 3636 3637 3638 3639 3640 3641 3642 3643 3644 3645 3646 3647 3648 3649 3650 3651 3652 3653 3654 3655 | if (!pipeTI) { return; } pipeTI = *pipeTIPtr; evControl = pipeTI->evControl; pipeTI->evWakeUp = NULL; /* * Try to sane stop the pipe worker, corresponding its current state */ state = InterlockedCompareExchange(&pipeTI->state, PTI_STATE_STOP, PTI_STATE_IDLE); switch (state) { case PTI_STATE_IDLE: /* * Thread was idle/waiting, notify it goes teardown */ SetEvent(evControl); /* * We don't need to wait for it at all, thread frees himself (owns the * TI structure) */ pipeTI = NULL; break; case PTI_STATE_STOP: /* * Already stopped, thread frees himself (owns the TI structure) */ pipeTI = NULL; break; case PTI_STATE_DOWN: /* * Thread already down (?), do nothing */ /* * We don't need to wait for it, but we should free pipeTI */ hThread = NULL; break; /* case PTI_STATE_WORK: */ default: /* * Thread works currently, we should try to end it, own the TI * structure (because of possible sharing the joint structures with * thread) */ state = InterlockedCompareExchange(&pipeTI->state, PTI_STATE_END, PTI_STATE_WORK); if (state == PTI_STATE_DOWN) { /* * We don't need to wait for it, but we should free pipeTI */ hThread = NULL; } break; } if (pipeTI && hThread) { DWORD exitCode; /* * The thread may already have closed on its own. Check its exit * code. */ GetExitCodeThread(hThread, &exitCode); if (exitCode == STILL_ACTIVE) { int inExit = (TclInExit() || TclInThreadExit()); /* * Set the stop event so that if the pipe thread is blocked * somewhere, it may hereafter sane exit cleanly. */ SetEvent(evControl); /* * Cancel all sync-IO of this thread (may be blocked there). */ if (tclWinProcs.cancelSynchronousIo) { tclWinProcs.cancelSynchronousIo(hThread); } /* * Wait at most 20 milliseconds for the reader thread to close * (regarding TIP#398-fast-exit). */ /* * If we want TIP#398-fast-exit. */ if (WaitForSingleObject(hThread, inExit ? 0 : 20) == WAIT_TIMEOUT) { /* * The thread must be blocked waiting for the pipe to become * readable in ReadFile(). There isn't a clean way to exit the * thread from this condition. We should terminate the child * process instead to get the reader thread to fall out of * ReadFile with a FALSE. (below) is not the correct way to do * this, but will stay here until a better solution is found. * * Note that we need to guard against terminating the thread * while it is in the middle of Tcl_ThreadAlert because it * won't be able to release the notifier lock. * * Also note that terminating threads during their * initialization or teardown phase may result in ntdll.dll's * LoaderLock to remain locked indefinitely. This causes * ntdll.dll's LdrpInitializeThread() to deadlock trying to * acquire LoaderLock. LdrpInitializeThread() is executed * within new threads to perform initialization and to execute * DllMain() of all loaded dlls. As a result, all new threads * are deadlocked in their initialization phase and never * execute, even though CreateThread() reports successful * thread creation. This results in a very weird process-wide * behavior, which is extremely hard to debug. * * THREADS SHOULD NEVER BE TERMINATED. Period. * * But for now, check if thread is exiting, and if so, let it * die peacefully. * * Also don't terminate if in exit (otherwise deadlocked in * ntdll.dll's). */ if (pipeTI->state != PTI_STATE_DOWN && WaitForSingleObject(hThread, inExit ? 50 : 5000) != WAIT_OBJECT_0) { /* BUG: this leaks memory */ if (inExit || !TerminateThread(hThread, 0)) { /* * in exit or terminate fails, just give thread a * chance to exit */ if (InterlockedExchange(&pipeTI->state, PTI_STATE_STOP) != PTI_STATE_DOWN) { pipeTI = NULL; } } } } } } *pipeTIPtr = NULL; if (pipeTI) { if (pipeTI->evWakeUp) { SetEvent(pipeTI->evWakeUp); } CloseHandle(pipeTI->evControl); #ifndef _PTI_USE_CKALLOC free(pipeTI); #else Tcl_Free(pipeTI); #endif /* !_PTI_USE_CKALLOC */ } } /* *---------------------------------------------------------------------- * * TclPipeThreadExit -- |
︙ | ︙ | |||
3531 3532 3533 3534 3535 3536 3537 3538 3539 3540 3541 3542 3543 3544 3545 3546 | void TclPipeThreadExit( TclPipeThreadInfo **pipeTIPtr) { LONG state; TclPipeThreadInfo *pipeTI = *pipeTIPtr; /* * If state of thread was set to stop (exactly), we can sane free its info * structure, otherwise it is shared with main thread, so main thread will * own it. */ if (!pipeTI) { return; } *pipeTIPtr = NULL; | > > | | | | | | 3670 3671 3672 3673 3674 3675 3676 3677 3678 3679 3680 3681 3682 3683 3684 3685 3686 3687 3688 3689 3690 3691 3692 3693 3694 3695 3696 3697 3698 3699 3700 3701 3702 3703 3704 3705 3706 3707 3708 3709 3710 | void TclPipeThreadExit( TclPipeThreadInfo **pipeTIPtr) { LONG state; TclPipeThreadInfo *pipeTI = *pipeTIPtr; /* * If state of thread was set to stop (exactly), we can sane free its info * structure, otherwise it is shared with main thread, so main thread will * own it. */ if (!pipeTI) { return; } *pipeTIPtr = NULL; state = InterlockedExchange(&pipeTI->state, PTI_STATE_DOWN); if (state == PTI_STATE_STOP) { CloseHandle(pipeTI->evControl); if (pipeTI->evWakeUp) { SetEvent(pipeTI->evWakeUp); } #ifndef _PTI_USE_CKALLOC free(pipeTI); #else Tcl_Free(pipeTI); /* be sure all subsystems used are finalized */ Tcl_FinalizeThread(); #endif /* !_PTI_USE_CKALLOC */ } } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ |