Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Changes In Branch tip-666 Excluding Merge-Ins
This is equivalent to a diff from 7ba77326d4 to 11af79f7e2
2023-09-11
| ||
14:43 | TIP #666 implementation: Change ptrdiff_t → Tcl_Size in Tcl 8.7 (and 9.0) check-in: 989de6a72a user: jan.nijtmans tags: core-8-branch | |
2023-09-02
| ||
22:00 | backport numeric white-space bug fix from 9.0 check-in: b9bb2ce39c user: griffin tags: core-8-branch | |
2023-08-31
| ||
14:46 | Rebase to 8.7 Closed-Leaf check-in: e580bbb75c user: jan.nijtmans tags: tip-665 | |
14:45 | Rebase to 8.7 Closed-Leaf check-in: 11af79f7e2 user: jan.nijtmans tags: tip-666 | |
13:47 | Rebase to 8.7 check-in: d67705af8d user: jan.nijtmans tags: tip-653 | |
13:14 | Merge 8.7 check-in: 595962964e user: jan.nijtmans tags: trunk, main | |
11:17 | Backport some test improvements from 9.0 check-in: 7ba77326d4 user: jan.nijtmans tags: core-8-branch | |
08:06 | Make Tcl_GetBytesFromObj signature match documentation (not really a change since Tcl_Size == int). ... check-in: 0d567acda3 user: jan.nijtmans tags: tip-666 | |
2023-08-30
| ||
10:37 | Merge 8.6 check-in: 02ecc768a8 user: jan.nijtmans tags: core-8-branch | |
Changes to doc/ByteArrObj.3.
︙ | ︙ | |||
39 40 41 42 43 44 45 | .AP Tcl_Obj *objPtr in/out For \fBTcl_SetByteArrayObj\fR, this points to an unshared value to be overwritten by a byte-array value. For \fBTcl_GetBytesFromObj\fR, \fBTcl_GetByteArrayFromObj\fR and \fBTcl_SetByteArrayLength\fR, this points to the value from which to extract an array of bytes. .AP Tcl_Interp *interp in Interpreter to use for error reporting. | | | 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 | .AP Tcl_Obj *objPtr in/out For \fBTcl_SetByteArrayObj\fR, this points to an unshared value to be overwritten by a byte-array value. For \fBTcl_GetBytesFromObj\fR, \fBTcl_GetByteArrayFromObj\fR and \fBTcl_SetByteArrayLength\fR, this points to the value from which to extract an array of bytes. .AP Tcl_Interp *interp in Interpreter to use for error reporting. .AP "Tcl_Size | int" *numBytesPtr out Points to space where the number of bytes in the array may be written. Caller may pass NULL when it does not need this information. .BE .SH DESCRIPTION .PP These routines are used to create, modify, store, transfer, and retrieve |
︙ | ︙ | |||
150 151 152 153 154 155 156 | has not been disturbed. The pointer may be used to overwrite the byte contents of the internal representation, so long as the value is unshared and any string representation is invalidated. .PP On success, both \fBTcl_GetBytesFromObj\fR and \fBTcl_GetByteArrayFromObj\fR write the number of bytes in the byte-array value of \fIobjPtr\fR to the space pointed to by \fInumBytesPtr\fR. This space may be of type | | | | 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 | has not been disturbed. The pointer may be used to overwrite the byte contents of the internal representation, so long as the value is unshared and any string representation is invalidated. .PP On success, both \fBTcl_GetBytesFromObj\fR and \fBTcl_GetByteArrayFromObj\fR write the number of bytes in the byte-array value of \fIobjPtr\fR to the space pointed to by \fInumBytesPtr\fR. This space may be of type \fBTcl_Size\fR or of type \fBint\fR. In Tcl 8, the largest number of bytes possible is \fBINT_MAX\fR, so either type can receive the value. In codebases meant to migrate to Tcl 9, the option to write to a space of type \fBTcl_Size\fR may aid in the migration. .PP \fBTcl_SetByteArrayLength\fR enables a caller to change the size of a byte-array in the internal representation of an unshared \fIobjPtr\fR to become \fInumBytes\fR bytes. This is most often useful after the bytes of the internal byte-array have been directly overwritten and it has been discovered that the required size differs from the first estimate used in the allocation. \fBTcl_SetByteArrayLength\fR returns |
︙ | ︙ |
Changes to doc/CrtObjCmd.3.
︙ | ︙ | |||
183 184 185 186 187 188 189 | \fBTcl_CreateObjCommand2\fR does the same as \fBTcl_CreateObjCommand\fR, except its \fIproc2\fR argument is of type \fBTcl_ObjCmdProc2\fR. .PP .CS typedef int \fBTcl_ObjCmdProc2\fR( ClientData \fIclientData\fR, Tcl_Interp *\fIinterp\fR, | | | 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 | \fBTcl_CreateObjCommand2\fR does the same as \fBTcl_CreateObjCommand\fR, except its \fIproc2\fR argument is of type \fBTcl_ObjCmdProc2\fR. .PP .CS typedef int \fBTcl_ObjCmdProc2\fR( ClientData \fIclientData\fR, Tcl_Interp *\fIinterp\fR, Tcl_Size \fIobjc\fR, Tcl_Obj *const \fIobjv\fR[]); .CE .PP \fBTcl_DeleteCommand\fR deletes a command from a command interpreter. Once the call completes, attempts to invoke \fIcmdName\fR in \fIinterp\fR will result in errors. If \fIcmdName\fR is not bound as a command in \fIinterp\fR then |
︙ | ︙ |
Changes to doc/CrtTrace.3.
︙ | ︙ | |||
84 85 86 87 88 89 90 | \fIobjProc2\fR should have arguments and result that match the type, \fBTcl_CmdObjTraceProc2\fR: .PP .CS typedef int \fBTcl_CmdObjTraceProc2\fR( \fBvoid *\fR \fIclientData\fR, \fBTcl_Interp\fR* \fIinterp\fR, | | | | 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 | \fIobjProc2\fR should have arguments and result that match the type, \fBTcl_CmdObjTraceProc2\fR: .PP .CS typedef int \fBTcl_CmdObjTraceProc2\fR( \fBvoid *\fR \fIclientData\fR, \fBTcl_Interp\fR* \fIinterp\fR, Tcl_Size \fIlevel\fR, const char *\fIcommand\fR, \fBTcl_Command\fR \fIcommandToken\fR, Tcl_Size \fIobjc\fR, \fBTcl_Obj\fR *const \fIobjv\fR[]); .CE .PP The \fIclientData\fR and \fIinterp\fR parameters are copies of the corresponding arguments given to \fBTcl_CreateTrace\fR. \fIClientData\fR typically points to an application-specific data structure that describes what to do when \fIobjProc\fR is invoked. The |
︙ | ︙ |
Changes to doc/Number.3.
︙ | ︙ | |||
23 24 25 26 27 28 29 | .SH ARGUMENTS .AS Tcl_Interp clientDataPtr out .AP Tcl_Interp *interp out When non-NULL, error information is recorded here when the value is not in any of the numeric formats recognized by Tcl. .AP "const char" *bytes in Points to first byte of the string value to be examined. | | | 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 | .SH ARGUMENTS .AS Tcl_Interp clientDataPtr out .AP Tcl_Interp *interp out When non-NULL, error information is recorded here when the value is not in any of the numeric formats recognized by Tcl. .AP "const char" *bytes in Points to first byte of the string value to be examined. .AP Tcl_Size numBytes in The number of bytes, starting at \fIbytes\fR, that should be examined. If the value \fBTCL_INDEX_NONE\fR is provided, then all bytes should be examined until the first \fBNUL\fR byte terminates examination. .AP "void *" *clientDataPtr out Points to space where a pointer value may be written through which a numeric value is available to read. .AP int *typePtr out |
︙ | ︙ |
Changes to generic/tcl.decls.
︙ | ︙ | |||
2404 2405 2406 2407 2408 2409 2410 | declare 648 { int *Tcl_UtfToUniCharDString(const char *src, Tcl_Size length, Tcl_DString *dsPtr) } # TIP #568 declare 649 { | < < < < | < < < < < < < < < < < < | 2404 2405 2406 2407 2408 2409 2410 2411 2412 2413 2414 2415 2416 2417 2418 2419 | declare 648 { int *Tcl_UtfToUniCharDString(const char *src, Tcl_Size length, Tcl_DString *dsPtr) } # TIP #568 declare 649 { unsigned char *Tcl_GetBytesFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, int *numBytesPtr) } # TIP #575 declare 654 { int Tcl_UtfCharComplete(const char *src, Tcl_Size length) } declare 655 { |
︙ | ︙ | |||
2455 2456 2457 2458 2459 2460 2461 | } # TIP #511 declare 660 { int Tcl_AsyncMarkFromSignal(Tcl_AsyncHandler async, int sigNumber) } | < < < < < < < < < < < < < < < < < < < < < < < < < < < | 2439 2440 2441 2442 2443 2444 2445 2446 2447 2448 2449 2450 2451 2452 | } # TIP #511 declare 660 { int Tcl_AsyncMarkFromSignal(Tcl_AsyncHandler async, int sigNumber) } # TIP #617 declare 668 { Tcl_Size Tcl_UniCharLen(const int *uniStr) } declare 669 { Tcl_Size TclNumUtfChars(const char *src, Tcl_Size length) } |
︙ | ︙ | |||
2510 2511 2512 2513 2514 2515 2516 | int Tcl_GetBool(Tcl_Interp *interp, const char *src, int flags, char *charPtr) } declare 675 { int Tcl_GetBoolFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, int flags, char *charPtr) } | < < < < < < < < < < < < < < < < < < < < < < | | 2467 2468 2469 2470 2471 2472 2473 2474 2475 2476 2477 2478 2479 2480 2481 2482 2483 2484 2485 2486 2487 | int Tcl_GetBool(Tcl_Interp *interp, const char *src, int flags, char *charPtr) } declare 675 { int Tcl_GetBoolFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, int flags, char *charPtr) } # TIP #638. declare 680 { int Tcl_GetNumberFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, void **clientDataPtr, int *typePtr) } declare 681 { int Tcl_GetNumber(Tcl_Interp *interp, const char *bytes, Tcl_Size numBytes, void **clientDataPtr, int *typePtr) } # TIP #220. declare 682 { int Tcl_RemoveChannelMode(Tcl_Interp *interp, Tcl_Channel chan, int mode) } |
︙ | ︙ |
Changes to generic/tcl.h.
︙ | ︙ | |||
702 703 704 705 706 707 708 | int argc, const char *argv[]); typedef void (Tcl_CmdTraceProc) (void *clientData, Tcl_Interp *interp, int level, char *command, Tcl_CmdProc *proc, void *cmdClientData, int argc, const char *argv[]); typedef int (Tcl_CmdObjTraceProc) (void *clientData, Tcl_Interp *interp, int level, const char *command, Tcl_Command commandInfo, int objc, struct Tcl_Obj *const *objv); | | < < | 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 | int argc, const char *argv[]); typedef void (Tcl_CmdTraceProc) (void *clientData, Tcl_Interp *interp, int level, char *command, Tcl_CmdProc *proc, void *cmdClientData, int argc, const char *argv[]); typedef int (Tcl_CmdObjTraceProc) (void *clientData, Tcl_Interp *interp, int level, const char *command, Tcl_Command commandInfo, int objc, struct Tcl_Obj *const *objv); #define Tcl_CmdObjTraceProc2 Tcl_CmdObjTraceProc typedef void (Tcl_CmdObjTraceDeleteProc) (void *clientData); typedef void (Tcl_DupInternalRepProc) (struct Tcl_Obj *srcPtr, struct Tcl_Obj *dupPtr); typedef int (Tcl_EncodingConvertProc) (void *clientData, const char *src, int srcLen, int flags, Tcl_EncodingState *statePtr, char *dst, int dstLen, int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr); typedef void (Tcl_EncodingFreeProc) (void *clientData); |
︙ | ︙ | |||
729 730 731 732 733 734 735 | typedef void (Tcl_InterpDeleteProc) (void *clientData, Tcl_Interp *interp); typedef int (Tcl_MathProc) (void *clientData, Tcl_Interp *interp, Tcl_Value *args, Tcl_Value *resultPtr); typedef void (Tcl_NamespaceDeleteProc) (void *clientData); typedef int (Tcl_ObjCmdProc) (void *clientData, Tcl_Interp *interp, int objc, struct Tcl_Obj *const *objv); | | < | 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 | typedef void (Tcl_InterpDeleteProc) (void *clientData, Tcl_Interp *interp); typedef int (Tcl_MathProc) (void *clientData, Tcl_Interp *interp, Tcl_Value *args, Tcl_Value *resultPtr); typedef void (Tcl_NamespaceDeleteProc) (void *clientData); typedef int (Tcl_ObjCmdProc) (void *clientData, Tcl_Interp *interp, int objc, struct Tcl_Obj *const *objv); #define Tcl_ObjCmdProc2 Tcl_ObjCmdProc typedef int (Tcl_LibraryInitProc) (Tcl_Interp *interp); typedef int (Tcl_LibraryUnloadProc) (Tcl_Interp *interp, int flags); typedef void (Tcl_PanicProc) (const char *format, ...); typedef void (Tcl_TcpAcceptProc) (void *callbackData, Tcl_Channel chan, char *address, int port); typedef void (Tcl_TimerProc) (void *clientData); typedef int (Tcl_SetFromAnyProc) (Tcl_Interp *interp, struct Tcl_Obj *objPtr); |
︙ | ︙ |
Changes to generic/tclBasic.c.
︙ | ︙ | |||
2683 2684 2685 2686 2687 2688 2689 | * Tcl_ObjCmdProc proc will be called. When the command is deleted from * the table, deleteProc will be called. See the manual entry for details * on the calling sequence. * *---------------------------------------------------------------------- */ | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | 2683 2684 2685 2686 2687 2688 2689 2690 2691 2692 2693 2694 2695 2696 | * Tcl_ObjCmdProc proc will be called. When the command is deleted from * the table, deleteProc will be called. See the manual entry for details * on the calling sequence. * *---------------------------------------------------------------------- */ Tcl_Command Tcl_CreateObjCommand( Tcl_Interp *interp, /* Token for command interpreter (returned by * previous call to Tcl_CreateInterp). */ const char *cmdName, /* Name of command. If it contains namespace * qualifiers, the new command is put in the * specified namespace; otherwise it is put in |
︙ | ︙ | |||
3376 3377 3378 3379 3380 3381 3382 | } else { if (infoPtr->objProc != cmdPtr->objProc) { cmdPtr->nreProc = NULL; cmdPtr->objProc = infoPtr->objProc; } cmdPtr->objClientData = infoPtr->objClientData; } | < < < < < | | < | 3316 3317 3318 3319 3320 3321 3322 3323 3324 3325 3326 3327 3328 3329 3330 3331 | } else { if (infoPtr->objProc != cmdPtr->objProc) { cmdPtr->nreProc = NULL; cmdPtr->objProc = infoPtr->objProc; } cmdPtr->objClientData = infoPtr->objClientData; } cmdPtr->deleteProc = infoPtr->deleteProc; cmdPtr->deleteData = infoPtr->deleteData; return 1; } /* *---------------------------------------------------------------------- * * Tcl_GetCommandInfo -- |
︙ | ︙ | |||
3460 3461 3462 3463 3464 3465 3466 | cmdPtr = (Command *) cmd; infoPtr->isNativeObjectProc = (cmdPtr->objProc != TclInvokeStringCommand); infoPtr->objProc = cmdPtr->objProc; infoPtr->objClientData = cmdPtr->objClientData; infoPtr->proc = cmdPtr->proc; infoPtr->clientData = cmdPtr->clientData; | < < < < < | | < | 3394 3395 3396 3397 3398 3399 3400 3401 3402 3403 3404 3405 3406 3407 3408 3409 | cmdPtr = (Command *) cmd; infoPtr->isNativeObjectProc = (cmdPtr->objProc != TclInvokeStringCommand); infoPtr->objProc = cmdPtr->objProc; infoPtr->objClientData = cmdPtr->objClientData; infoPtr->proc = cmdPtr->proc; infoPtr->clientData = cmdPtr->clientData; infoPtr->deleteProc = cmdPtr->deleteProc; infoPtr->deleteData = cmdPtr->deleteData; infoPtr->namespacePtr = (Tcl_Namespace *) cmdPtr->nsPtr; return 1; } /* *---------------------------------------------------------------------- * |
︙ | ︙ | |||
9166 9167 9168 9169 9170 9171 9172 | NRE_callback *rootPtr = TOP_CB(interp); TclNRAddCallback(interp, Dispatch, objProc, clientData, INT2PTR(objc), objv); return TclNRRunCallbacks(interp, TCL_OK, rootPtr); } | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | 9094 9095 9096 9097 9098 9099 9100 9101 9102 9103 9104 9105 9106 9107 | NRE_callback *rootPtr = TOP_CB(interp); TclNRAddCallback(interp, Dispatch, objProc, clientData, INT2PTR(objc), objv); return TclNRRunCallbacks(interp, TCL_OK, rootPtr); } /* *---------------------------------------------------------------------- * * Tcl_NRCreateCommand -- * * Define a new NRE-enabled object-based command in a command table. * |
︙ | ︙ | |||
9230 9231 9232 9233 9234 9235 9236 | * Tcl_ObjCmdProc proc will be called. When the command is deleted from * the table, deleteProc will be called. See the manual entry for details * on the calling sequence. * *---------------------------------------------------------------------- */ | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | 9122 9123 9124 9125 9126 9127 9128 9129 9130 9131 9132 9133 9134 9135 | * Tcl_ObjCmdProc proc will be called. When the command is deleted from * the table, deleteProc will be called. See the manual entry for details * on the calling sequence. * *---------------------------------------------------------------------- */ Tcl_Command Tcl_NRCreateCommand( Tcl_Interp *interp, /* Token for command interpreter (returned by * previous call to Tcl_CreateInterp). */ const char *cmdName, /* Name of command. If it contains namespace * qualifiers, the new command is put in the * specified namespace; otherwise it is put in |
︙ | ︙ |
Changes to generic/tclBinary.c.
︙ | ︙ | |||
396 397 398 399 400 401 402 | Tcl_StoreInternalRep(objPtr, &properByteArrayType, &ir); } /* *---------------------------------------------------------------------- * | | | | 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 | Tcl_StoreInternalRep(objPtr, &properByteArrayType, &ir); } /* *---------------------------------------------------------------------- * * Tcl_GetBytesFromObj -- * * Attempt to extract the value from objPtr in the representation * of a byte sequence. On success return the extracted byte sequence. * On failure, return NULL and record error message and code in * interp (if not NULL). * * Results: * NULL or pointer to array of bytes representing the ByteArray object. * Writes number of bytes in array to *numBytesPtr. * *---------------------------------------------------------------------- */ unsigned char * Tcl_GetBytesFromObj( Tcl_Interp *interp, /* For error reporting */ Tcl_Obj *objPtr, /* Value to extract from */ int *numBytesPtr) /* If non-NULL, write the number of bytes * in the array here */ { ByteArray *baPtr; const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(objPtr, &properByteArrayType); |
︙ | ︙ | |||
448 449 450 451 452 453 454 | baPtr = GET_BYTEARRAY(irPtr); if (numBytesPtr != NULL) { *numBytesPtr = baPtr->used; } return baPtr->bytes; } | < < < < < < < | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | | 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 | baPtr = GET_BYTEARRAY(irPtr); if (numBytesPtr != NULL) { *numBytesPtr = baPtr->used; } return baPtr->bytes; } /* *---------------------------------------------------------------------- * * Tcl_GetByteArrayFromObj -- * * Attempt to get the array of bytes from the Tcl object. If the object * is not already a ByteArray object, an attempt will be made to convert * it to one. * * Results: * Pointer to array of bytes representing the ByteArray object. |
︙ | ︙ | |||
515 516 517 518 519 520 521 | Tcl_GetByteArrayFromObj( Tcl_Obj *objPtr, /* The ByteArray object. */ int *numBytesPtr) /* If non-NULL, write the number of bytes * in the array here */ { ByteArray *baPtr; const Tcl_ObjInternalRep *irPtr; | | < < < < < < < < < < < < < < < < < < < < < < < < < < | 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 | Tcl_GetByteArrayFromObj( Tcl_Obj *objPtr, /* The ByteArray object. */ int *numBytesPtr) /* If non-NULL, write the number of bytes * in the array here */ { ByteArray *baPtr; const Tcl_ObjInternalRep *irPtr; unsigned char *result = Tcl_GetBytesFromObj(NULL, objPtr, numBytesPtr); if (result) { return result; } irPtr = TclFetchInternalRep(objPtr, &tclByteArrayType); assert(irPtr != NULL); baPtr = GET_BYTEARRAY(irPtr); if (numBytesPtr != NULL) { *numBytesPtr = baPtr->used; } return (unsigned char *) baPtr->bytes; } /* *---------------------------------------------------------------------- * * Tcl_SetByteArrayLength -- * * This procedure changes the length of the byte array for this object. |
︙ | ︙ | |||
2661 2662 2663 2664 2665 2666 2667 | case OPT_STRICT: strict = 1; break; } } TclNewObj(resultObj); | | | 2596 2597 2598 2599 2600 2601 2602 2603 2604 2605 2606 2607 2608 2609 2610 | case OPT_STRICT: strict = 1; break; } } TclNewObj(resultObj); data = Tcl_GetBytesFromObj(NULL, objv[objc - 1], &count); if (data == NULL) { pure = 0; data = (unsigned char *) TclGetStringFromObj(objv[objc - 1], &count); } datastart = data; dataend = data + count; size = (count + 1) / 2; |
︙ | ︙ | |||
2793 2794 2795 2796 2797 2798 2799 | "line length out of range", -1)); Tcl_SetErrorCode(interp, "TCL", "BINARY", "ENCODE", "LINE_LENGTH", NULL); return TCL_ERROR; } break; case OPT_WRAPCHAR: | | | 2728 2729 2730 2731 2732 2733 2734 2735 2736 2737 2738 2739 2740 2741 2742 | "line length out of range", -1)); Tcl_SetErrorCode(interp, "TCL", "BINARY", "ENCODE", "LINE_LENGTH", NULL); return TCL_ERROR; } break; case OPT_WRAPCHAR: wrapchar = (const char *)Tcl_GetBytesFromObj(NULL, objv[i + 1], &wrapcharlen); if (wrapchar == NULL) { purewrap = 0; wrapchar = TclGetStringFromObj(objv[i + 1], &wrapcharlen); } break; } |
︙ | ︙ | |||
3057 3058 3059 3060 3061 3062 3063 | case OPT_STRICT: strict = 1; break; } } TclNewObj(resultObj); | | | 2992 2993 2994 2995 2996 2997 2998 2999 3000 3001 3002 3003 3004 3005 3006 | case OPT_STRICT: strict = 1; break; } } TclNewObj(resultObj); data = Tcl_GetBytesFromObj(NULL, objv[objc - 1], &count); if (data == NULL) { pure = 0; data = (unsigned char *) TclGetStringFromObj(objv[objc - 1], &count); } datastart = data; dataend = data + count; size = ((count + 3) & ~3) * 3 / 4; |
︙ | ︙ | |||
3231 3232 3233 3234 3235 3236 3237 | case OPT_STRICT: strict = 1; break; } } TclNewObj(resultObj); | | | 3166 3167 3168 3169 3170 3171 3172 3173 3174 3175 3176 3177 3178 3179 3180 | case OPT_STRICT: strict = 1; break; } } TclNewObj(resultObj); data = Tcl_GetBytesFromObj(NULL, objv[objc - 1], &count); if (data == NULL) { pure = 0; data = (unsigned char *) TclGetStringFromObj(objv[objc - 1], &count); } datastart = data; dataend = data + count; size = ((count + 3) & ~3) * 3 / 4; |
︙ | ︙ |
Changes to generic/tclCmdAH.c.
︙ | ︙ | |||
675 676 677 678 679 680 681 | */ #if !defined(TCL_NO_DEPRECATED) && (TCL_MAJOR_VERSION < 9) if (ENCODING_PROFILE_GET(flags) == TCL_ENCODING_PROFILE_TCL8) { /* Permits high bits to be non-0 in byte array (Tcl 8 style) */ bytesPtr = (char *) Tcl_GetByteArrayFromObj(data, &length); } else #endif | | | 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 | */ #if !defined(TCL_NO_DEPRECATED) && (TCL_MAJOR_VERSION < 9) if (ENCODING_PROFILE_GET(flags) == TCL_ENCODING_PROFILE_TCL8) { /* Permits high bits to be non-0 in byte array (Tcl 8 style) */ bytesPtr = (char *) Tcl_GetByteArrayFromObj(data, &length); } else #endif bytesPtr = (char *) Tcl_GetBytesFromObj(interp, data, &length); if (bytesPtr == NULL) { return TCL_ERROR; } result = Tcl_ExternalToUtfDStringEx(interp, encoding, bytesPtr, length, flags, &ds, failVarObj ? &errorLocation : NULL); /* NOTE: ds must be freed beyond this point even on error */ |
︙ | ︙ | |||
2193 2194 2195 2196 2197 2198 2199 | { Tcl_Obj *res; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "name"); return TCL_ERROR; } | | | 2193 2194 2195 2196 2197 2198 2199 2200 2201 2202 2203 2204 2205 2206 2207 | { Tcl_Obj *res; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "name"); return TCL_ERROR; } res = Tcl_FSSplitPath(objv[1], NULL); if (res == NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "could not read \"%s\": no such file or directory", TclGetString(objv[1]))); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PATHSPLIT", "NONESUCH", NULL); return TCL_ERROR; |
︙ | ︙ |
Changes to generic/tclDecls.h.
︙ | ︙ | |||
1928 1929 1930 1931 1932 1933 1934 | /* 647 */ EXTERN char * Tcl_UniCharToUtfDString(const int *uniStr, Tcl_Size uniLength, Tcl_DString *dsPtr); /* 648 */ EXTERN int * Tcl_UtfToUniCharDString(const char *src, Tcl_Size length, Tcl_DString *dsPtr); /* 649 */ | | | < < | < | < < | < < | 1928 1929 1930 1931 1932 1933 1934 1935 1936 1937 1938 1939 1940 1941 1942 1943 1944 1945 1946 1947 | /* 647 */ EXTERN char * Tcl_UniCharToUtfDString(const int *uniStr, Tcl_Size uniLength, Tcl_DString *dsPtr); /* 648 */ EXTERN int * Tcl_UtfToUniCharDString(const char *src, Tcl_Size length, Tcl_DString *dsPtr); /* 649 */ EXTERN unsigned char * Tcl_GetBytesFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, int *numBytesPtr); /* Slot 650 is reserved */ /* Slot 651 is reserved */ /* Slot 652 is reserved */ /* Slot 653 is reserved */ /* 654 */ EXTERN int Tcl_UtfCharComplete(const char *src, Tcl_Size length); /* 655 */ EXTERN const char * Tcl_UtfNext(const char *src); /* 656 */ EXTERN const char * Tcl_UtfPrev(const char *src, const char *start); /* 657 */ |
︙ | ︙ | |||
1964 1965 1966 1967 1968 1969 1970 | Tcl_Encoding encoding, const char *src, Tcl_Size srcLen, int flags, Tcl_DString *dsPtr, Tcl_Size *errorLocationPtr); /* 660 */ EXTERN int Tcl_AsyncMarkFromSignal(Tcl_AsyncHandler async, int sigNumber); | | < < < | < < | < < | < < | < < | < | < < < | < < < < | < < < < < | < < < < | < < < | | 1957 1958 1959 1960 1961 1962 1963 1964 1965 1966 1967 1968 1969 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 1982 1983 1984 1985 1986 1987 1988 1989 1990 1991 1992 1993 1994 1995 1996 1997 1998 1999 2000 2001 2002 2003 2004 2005 2006 2007 | Tcl_Encoding encoding, const char *src, Tcl_Size srcLen, int flags, Tcl_DString *dsPtr, Tcl_Size *errorLocationPtr); /* 660 */ EXTERN int Tcl_AsyncMarkFromSignal(Tcl_AsyncHandler async, int sigNumber); /* Slot 661 is reserved */ /* Slot 662 is reserved */ /* Slot 663 is reserved */ /* Slot 664 is reserved */ /* Slot 665 is reserved */ /* Slot 666 is reserved */ /* Slot 667 is reserved */ /* 668 */ EXTERN Tcl_Size Tcl_UniCharLen(const int *uniStr); /* 669 */ EXTERN Tcl_Size TclNumUtfChars(const char *src, Tcl_Size length); /* 670 */ EXTERN Tcl_Size TclGetCharLength(Tcl_Obj *objPtr); /* 671 */ EXTERN const char * TclUtfAtIndex(const char *src, Tcl_Size index); /* 672 */ EXTERN Tcl_Obj * TclGetRange(Tcl_Obj *objPtr, Tcl_Size first, Tcl_Size last); /* 673 */ EXTERN int TclGetUniChar(Tcl_Obj *objPtr, Tcl_Size index); /* 674 */ EXTERN int Tcl_GetBool(Tcl_Interp *interp, const char *src, int flags, char *charPtr); /* 675 */ EXTERN int Tcl_GetBoolFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, int flags, char *charPtr); /* Slot 676 is reserved */ /* Slot 677 is reserved */ /* Slot 678 is reserved */ /* Slot 679 is reserved */ /* 680 */ EXTERN int Tcl_GetNumberFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, void **clientDataPtr, int *typePtr); /* 681 */ EXTERN int Tcl_GetNumber(Tcl_Interp *interp, const char *bytes, Tcl_Size numBytes, void **clientDataPtr, int *typePtr); /* 682 */ EXTERN int Tcl_RemoveChannelMode(Tcl_Interp *interp, Tcl_Channel chan, int mode); /* 683 */ EXTERN Tcl_Size Tcl_GetEncodingNulLength(Tcl_Encoding encoding); /* 684 */ |
︙ | ︙ | |||
2731 2732 2733 2734 2735 2736 2737 | void (*tcl_DecrRefCount) (Tcl_Obj *objPtr); /* 642 */ int (*tcl_IsShared) (Tcl_Obj *objPtr); /* 643 */ int (*tcl_LinkArray) (Tcl_Interp *interp, const char *varName, void *addr, int type, Tcl_Size size); /* 644 */ int (*tcl_GetIntForIndex) (Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Size endValue, Tcl_Size *indexPtr); /* 645 */ Tcl_Size (*tcl_UtfToUniChar) (const char *src, int *chPtr); /* 646 */ char * (*tcl_UniCharToUtfDString) (const int *uniStr, Tcl_Size uniLength, Tcl_DString *dsPtr); /* 647 */ int * (*tcl_UtfToUniCharDString) (const char *src, Tcl_Size length, Tcl_DString *dsPtr); /* 648 */ | < | | > | | | | | | | | | | | | | | | 2693 2694 2695 2696 2697 2698 2699 2700 2701 2702 2703 2704 2705 2706 2707 2708 2709 2710 2711 2712 2713 2714 2715 2716 2717 2718 2719 2720 2721 2722 2723 2724 2725 2726 2727 2728 2729 2730 2731 2732 2733 2734 2735 2736 2737 2738 2739 | void (*tcl_DecrRefCount) (Tcl_Obj *objPtr); /* 642 */ int (*tcl_IsShared) (Tcl_Obj *objPtr); /* 643 */ int (*tcl_LinkArray) (Tcl_Interp *interp, const char *varName, void *addr, int type, Tcl_Size size); /* 644 */ int (*tcl_GetIntForIndex) (Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Size endValue, Tcl_Size *indexPtr); /* 645 */ Tcl_Size (*tcl_UtfToUniChar) (const char *src, int *chPtr); /* 646 */ char * (*tcl_UniCharToUtfDString) (const int *uniStr, Tcl_Size uniLength, Tcl_DString *dsPtr); /* 647 */ int * (*tcl_UtfToUniCharDString) (const char *src, Tcl_Size length, Tcl_DString *dsPtr); /* 648 */ unsigned char * (*tcl_GetBytesFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int *numBytesPtr); /* 649 */ void (*reserved650)(void); void (*reserved651)(void); void (*reserved652)(void); void (*reserved653)(void); int (*tcl_UtfCharComplete) (const char *src, Tcl_Size length); /* 654 */ const char * (*tcl_UtfNext) (const char *src); /* 655 */ const char * (*tcl_UtfPrev) (const char *src, const char *start); /* 656 */ int (*tcl_UniCharIsUnicode) (int ch); /* 657 */ int (*tcl_ExternalToUtfDStringEx) (Tcl_Interp *interp, Tcl_Encoding encoding, const char *src, Tcl_Size srcLen, int flags, Tcl_DString *dsPtr, Tcl_Size *errorLocationPtr); /* 658 */ int (*tcl_UtfToExternalDStringEx) (Tcl_Interp *interp, Tcl_Encoding encoding, const char *src, Tcl_Size srcLen, int flags, Tcl_DString *dsPtr, Tcl_Size *errorLocationPtr); /* 659 */ int (*tcl_AsyncMarkFromSignal) (Tcl_AsyncHandler async, int sigNumber); /* 660 */ void (*reserved661)(void); void (*reserved662)(void); void (*reserved663)(void); void (*reserved664)(void); void (*reserved665)(void); void (*reserved666)(void); void (*reserved667)(void); Tcl_Size (*tcl_UniCharLen) (const int *uniStr); /* 668 */ Tcl_Size (*tclNumUtfChars) (const char *src, Tcl_Size length); /* 669 */ Tcl_Size (*tclGetCharLength) (Tcl_Obj *objPtr); /* 670 */ const char * (*tclUtfAtIndex) (const char *src, Tcl_Size index); /* 671 */ Tcl_Obj * (*tclGetRange) (Tcl_Obj *objPtr, Tcl_Size first, Tcl_Size last); /* 672 */ int (*tclGetUniChar) (Tcl_Obj *objPtr, Tcl_Size index); /* 673 */ int (*tcl_GetBool) (Tcl_Interp *interp, const char *src, int flags, char *charPtr); /* 674 */ int (*tcl_GetBoolFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int flags, char *charPtr); /* 675 */ void (*reserved676)(void); void (*reserved677)(void); void (*reserved678)(void); void (*reserved679)(void); int (*tcl_GetNumberFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, void **clientDataPtr, int *typePtr); /* 680 */ int (*tcl_GetNumber) (Tcl_Interp *interp, const char *bytes, Tcl_Size numBytes, void **clientDataPtr, int *typePtr); /* 681 */ int (*tcl_RemoveChannelMode) (Tcl_Interp *interp, Tcl_Channel chan, int mode); /* 682 */ Tcl_Size (*tcl_GetEncodingNulLength) (Tcl_Encoding encoding); /* 683 */ int (*tcl_GetWideUIntFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_WideUInt *uwidePtr); /* 684 */ Tcl_Obj * (*tcl_DStringToObj) (Tcl_DString *dsPtr); /* 685 */ void (*reserved686)(void); void (*reserved687)(void); void (*tclUnusedStubEntry) (void); /* 688 */ |
︙ | ︙ | |||
4099 4100 4101 4102 4103 4104 4105 | (tclStubsPtr->tcl_GetIntForIndex) /* 645 */ #define Tcl_UtfToUniChar \ (tclStubsPtr->tcl_UtfToUniChar) /* 646 */ #define Tcl_UniCharToUtfDString \ (tclStubsPtr->tcl_UniCharToUtfDString) /* 647 */ #define Tcl_UtfToUniCharDString \ (tclStubsPtr->tcl_UtfToUniCharDString) /* 648 */ | < < | < > | < | < | < | < | < | < | < | < | < | < | < | < | < | | 4061 4062 4063 4064 4065 4066 4067 4068 4069 4070 4071 4072 4073 4074 4075 4076 4077 4078 4079 4080 4081 4082 4083 4084 4085 4086 4087 4088 4089 4090 4091 4092 4093 4094 4095 4096 4097 4098 4099 4100 4101 4102 4103 4104 4105 4106 4107 4108 4109 4110 4111 4112 4113 4114 4115 4116 4117 4118 4119 4120 4121 | (tclStubsPtr->tcl_GetIntForIndex) /* 645 */ #define Tcl_UtfToUniChar \ (tclStubsPtr->tcl_UtfToUniChar) /* 646 */ #define Tcl_UniCharToUtfDString \ (tclStubsPtr->tcl_UniCharToUtfDString) /* 647 */ #define Tcl_UtfToUniCharDString \ (tclStubsPtr->tcl_UtfToUniCharDString) /* 648 */ #define Tcl_GetBytesFromObj \ (tclStubsPtr->tcl_GetBytesFromObj) /* 649 */ /* Slot 650 is reserved */ /* Slot 651 is reserved */ /* Slot 652 is reserved */ /* Slot 653 is reserved */ #define Tcl_UtfCharComplete \ (tclStubsPtr->tcl_UtfCharComplete) /* 654 */ #define Tcl_UtfNext \ (tclStubsPtr->tcl_UtfNext) /* 655 */ #define Tcl_UtfPrev \ (tclStubsPtr->tcl_UtfPrev) /* 656 */ #define Tcl_UniCharIsUnicode \ (tclStubsPtr->tcl_UniCharIsUnicode) /* 657 */ #define Tcl_ExternalToUtfDStringEx \ (tclStubsPtr->tcl_ExternalToUtfDStringEx) /* 658 */ #define Tcl_UtfToExternalDStringEx \ (tclStubsPtr->tcl_UtfToExternalDStringEx) /* 659 */ #define Tcl_AsyncMarkFromSignal \ (tclStubsPtr->tcl_AsyncMarkFromSignal) /* 660 */ /* Slot 661 is reserved */ /* Slot 662 is reserved */ /* Slot 663 is reserved */ /* Slot 664 is reserved */ /* Slot 665 is reserved */ /* Slot 666 is reserved */ /* Slot 667 is reserved */ #define Tcl_UniCharLen \ (tclStubsPtr->tcl_UniCharLen) /* 668 */ #define TclNumUtfChars \ (tclStubsPtr->tclNumUtfChars) /* 669 */ #define TclGetCharLength \ (tclStubsPtr->tclGetCharLength) /* 670 */ #define TclUtfAtIndex \ (tclStubsPtr->tclUtfAtIndex) /* 671 */ #define TclGetRange \ (tclStubsPtr->tclGetRange) /* 672 */ #define TclGetUniChar \ (tclStubsPtr->tclGetUniChar) /* 673 */ #define Tcl_GetBool \ (tclStubsPtr->tcl_GetBool) /* 674 */ #define Tcl_GetBoolFromObj \ (tclStubsPtr->tcl_GetBoolFromObj) /* 675 */ /* Slot 676 is reserved */ /* Slot 677 is reserved */ /* Slot 678 is reserved */ /* Slot 679 is reserved */ #define Tcl_GetNumberFromObj \ (tclStubsPtr->tcl_GetNumberFromObj) /* 680 */ #define Tcl_GetNumber \ (tclStubsPtr->tcl_GetNumber) /* 681 */ #define Tcl_RemoveChannelMode \ (tclStubsPtr->tcl_RemoveChannelMode) /* 682 */ #define Tcl_GetEncodingNulLength \ |
︙ | ︙ | |||
4374 4375 4376 4377 4378 4379 4380 | ((int(*)(const Tcl_UniChar*,const Tcl_UniChar*,unsigned int))(void *)tclStubsPtr->tcl_UniCharNcasecmp)(ucs,uct,(unsigned int)(n)) # endif #endif #undef Tcl_GetString #undef Tcl_GetUnicode #define Tcl_GetString(objPtr) \ | | | < < < < < < < < < < < < < < < < < < < < < < < < < < | 4321 4322 4323 4324 4325 4326 4327 4328 4329 4330 4331 4332 4333 4334 4335 4336 4337 4338 4339 4340 4341 4342 4343 4344 4345 4346 4347 4348 4349 4350 4351 4352 4353 4354 4355 4356 4357 4358 | ((int(*)(const Tcl_UniChar*,const Tcl_UniChar*,unsigned int))(void *)tclStubsPtr->tcl_UniCharNcasecmp)(ucs,uct,(unsigned int)(n)) # endif #endif #undef Tcl_GetString #undef Tcl_GetUnicode #define Tcl_GetString(objPtr) \ Tcl_GetStringFromObj(objPtr, NULL) #define Tcl_GetUnicode(objPtr) \ Tcl_GetUnicodeFromObj(objPtr, NULL) #undef Tcl_GetIndexFromObjStruct #undef Tcl_GetBooleanFromObj #undef Tcl_GetBoolean #if defined(USE_TCL_STUBS) #define Tcl_GetIndexFromObjStruct(interp, objPtr, tablePtr, offset, msg, flags, indexPtr) \ (tclStubsPtr->tcl_GetIndexFromObjStruct((interp), (objPtr), (tablePtr), (offset), (msg), (flags)|(int)(sizeof(*(indexPtr))<<1), (indexPtr))) #define Tcl_GetBooleanFromObj(interp, objPtr, boolPtr) \ (sizeof(*(boolPtr)) == sizeof(int) ? tclStubsPtr->tcl_GetBooleanFromObj(interp, objPtr, (int *)(boolPtr)) : \ Tcl_GetBoolFromObj(interp, objPtr, (TCL_NULL_OK-2)&(int)sizeof((*(boolPtr))), (char *)(boolPtr))) #define Tcl_GetBoolean(interp, src, boolPtr) \ (sizeof(*(boolPtr)) == sizeof(int) ? tclStubsPtr->tcl_GetBoolean(interp, src, (int *)(boolPtr)) : \ Tcl_GetBool(interp, src, (TCL_NULL_OK-2)&(int)sizeof((*(boolPtr))), (char *)(boolPtr))) #else #define Tcl_GetIndexFromObjStruct(interp, objPtr, tablePtr, offset, msg, flags, indexPtr) \ ((Tcl_GetIndexFromObjStruct)((interp), (objPtr), (tablePtr), (offset), (msg), (flags)|(int)(sizeof(*(indexPtr))<<1), (indexPtr))) #define Tcl_GetBooleanFromObj(interp, objPtr, boolPtr) \ (sizeof(*(boolPtr)) == sizeof(int) ? Tcl_GetBooleanFromObj(interp, objPtr, (int *)(boolPtr)) : \ Tcl_GetBoolFromObj(interp, objPtr, (TCL_NULL_OK-2)&(int)sizeof((*(boolPtr))), (char *)(boolPtr))) #define Tcl_GetBoolean(interp, src, boolPtr) \ (sizeof(*(boolPtr)) == sizeof(int) ? Tcl_GetBoolean(interp, src, (int *)(boolPtr)) : \ Tcl_GetBool(interp, src, (TCL_NULL_OK-2)&(int)sizeof((*(boolPtr))), (char *)(boolPtr))) #endif #undef Tcl_NewLongObj #define Tcl_NewLongObj(value) Tcl_NewWideIntObj((long)(value)) #undef Tcl_NewIntObj #define Tcl_NewIntObj(value) Tcl_NewWideIntObj((int)(value)) #undef Tcl_DbNewLongObj |
︙ | ︙ | |||
4475 4476 4477 4478 4479 4480 4481 | : (wchar_t *(*)(const char *, Tcl_Size, Tcl_DString *))Tcl_UtfToChar16DString) # define Tcl_UtfToWChar (sizeof(wchar_t) != sizeof(short) \ ? (int (*)(const char *, wchar_t *))tclStubsPtr->tcl_UtfToUniChar \ : (int (*)(const char *, wchar_t *))Tcl_UtfToChar16) # define Tcl_WCharLen (sizeof(wchar_t) != sizeof(short) \ ? (Tcl_Size (*)(wchar_t *))tclStubsPtr->tcl_UniCharLen \ : (Tcl_Size (*)(wchar_t *))Tcl_Char16Len) | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | 4396 4397 4398 4399 4400 4401 4402 4403 4404 4405 4406 4407 4408 4409 4410 4411 4412 4413 4414 4415 4416 4417 4418 4419 4420 4421 4422 | : (wchar_t *(*)(const char *, Tcl_Size, Tcl_DString *))Tcl_UtfToChar16DString) # define Tcl_UtfToWChar (sizeof(wchar_t) != sizeof(short) \ ? (int (*)(const char *, wchar_t *))tclStubsPtr->tcl_UtfToUniChar \ : (int (*)(const char *, wchar_t *))Tcl_UtfToChar16) # define Tcl_WCharLen (sizeof(wchar_t) != sizeof(short) \ ? (Tcl_Size (*)(wchar_t *))tclStubsPtr->tcl_UniCharLen \ : (Tcl_Size (*)(wchar_t *))Tcl_Char16Len) #else /* !defined(USE_TCL_STUBS) */ # define Tcl_WCharToUtfDString (sizeof(wchar_t) != sizeof(short) \ ? (char *(*)(const wchar_t *, Tcl_Size, Tcl_DString *))Tcl_UniCharToUtfDString \ : (char *(*)(const wchar_t *, Tcl_Size, Tcl_DString *))Tcl_Char16ToUtfDString) # define Tcl_UtfToWCharDString (sizeof(wchar_t) != sizeof(short) \ ? (wchar_t *(*)(const char *, Tcl_Size, Tcl_DString *))Tcl_UtfToUniCharDString \ : (wchar_t *(*)(const char *, Tcl_Size, Tcl_DString *))Tcl_UtfToChar16DString) # define Tcl_UtfToWChar (sizeof(wchar_t) != sizeof(short) \ ? (int (*)(const char *, wchar_t *))Tcl_UtfToUniChar \ : (int (*)(const char *, wchar_t *))Tcl_UtfToChar16) # define Tcl_WCharLen (sizeof(wchar_t) != sizeof(short) \ ? (Tcl_Size (*)(wchar_t *))Tcl_UniCharLen \ : (Tcl_Size (*)(wchar_t *))Tcl_Char16Len) #endif /* defined(USE_TCL_STUBS) */ /* * Deprecated Tcl procedures: */ #ifdef TCL_NO_DEPRECATED |
︙ | ︙ | |||
4577 4578 4579 4580 4581 4582 4583 4584 4585 4586 4587 | # define Tcl_UtfNext (tclStubsPtr->tclUtfNext) # define Tcl_UtfPrev (tclStubsPtr->tclUtfPrev) #endif #define Tcl_CreateSlave Tcl_CreateChild #define Tcl_GetSlave Tcl_GetChild #define Tcl_GetMaster Tcl_GetParent /* TIP #660 */ #define Tcl_GetSizeIntFromObj Tcl_GetIntFromObj #endif /* _TCLDECLS */ | > > > > > | 4445 4446 4447 4448 4449 4450 4451 4452 4453 4454 4455 4456 4457 4458 4459 4460 | # define Tcl_UtfNext (tclStubsPtr->tclUtfNext) # define Tcl_UtfPrev (tclStubsPtr->tclUtfPrev) #endif #define Tcl_CreateSlave Tcl_CreateChild #define Tcl_GetSlave Tcl_GetChild #define Tcl_GetMaster Tcl_GetParent #define Tcl_NRCallObjProc2 Tcl_NRCallObjProc #define Tcl_CreateObjCommand2 Tcl_CreateObjCommand #define Tcl_CreateObjTrace2 Tcl_CreateObjTrace #define Tcl_NRCreateCommand2 Tcl_NRCreateCommand /* TIP #660 */ #define Tcl_GetSizeIntFromObj Tcl_GetIntFromObj #endif /* _TCLDECLS */ |
Changes to generic/tclExecute.c.
︙ | ︙ | |||
4784 4785 4786 4787 4788 4789 4790 | oPtr->flags &= ~FILTER_HANDLING; } { Method *const mPtr = contextPtr->callPtr->chain[newDepth].mPtr; | < | < < < | 4784 4785 4786 4787 4788 4789 4790 4791 4792 4793 4794 4795 4796 4797 4798 | oPtr->flags &= ~FILTER_HANDLING; } { Method *const mPtr = contextPtr->callPtr->chain[newDepth].mPtr; return mPtr->typePtr->callProc(mPtr->clientData, interp, (Tcl_ObjectContext) contextPtr, opnd, objv); } case INST_TCLOO_IS_OBJECT: oPtr = (Object *) Tcl_GetObjectFromObj(interp, OBJ_AT_TOS); objResultPtr = TCONST(oPtr != NULL ? 1 : 0); TRACE_WITH_OBJ(("%.30s => ", O2S(OBJ_AT_TOS)), objResultPtr); |
︙ | ︙ | |||
5476 5477 5478 5479 5480 5481 5482 | } CACHE_STACK_INFO(); if ((index < 0) || (index >= length)) { TclNewObj(objResultPtr); } else if (TclIsPureByteArray(valuePtr)) { objResultPtr = Tcl_NewByteArrayObj( | | | 5472 5473 5474 5475 5476 5477 5478 5479 5480 5481 5482 5483 5484 5485 5486 | } CACHE_STACK_INFO(); if ((index < 0) || (index >= length)) { TclNewObj(objResultPtr); } else if (TclIsPureByteArray(valuePtr)) { objResultPtr = Tcl_NewByteArrayObj( Tcl_GetByteArrayFromObj(valuePtr, NULL)+index, 1); } else if (valuePtr->bytes && length == valuePtr->length) { objResultPtr = Tcl_NewStringObj((const char *) valuePtr->bytes+index, 1); } else { char buf[4] = ""; int ch = TclGetUniChar(valuePtr, index); |
︙ | ︙ |
Changes to generic/tclIO.c.
︙ | ︙ | |||
6029 6030 6031 6032 6033 6034 6035 | TclChannelPreserve((Tcl_Channel)chanPtr); binaryMode = (encoding == NULL) && (statePtr->inputTranslation == TCL_TRANSLATE_LF) && (statePtr->inEofChar == '\0'); if (appendFlag) { | | | 6029 6030 6031 6032 6033 6034 6035 6036 6037 6038 6039 6040 6041 6042 6043 | TclChannelPreserve((Tcl_Channel)chanPtr); binaryMode = (encoding == NULL) && (statePtr->inputTranslation == TCL_TRANSLATE_LF) && (statePtr->inEofChar == '\0'); if (appendFlag) { if (binaryMode && (NULL == Tcl_GetBytesFromObj(NULL, objPtr, NULL))) { binaryMode = 0; } } else { if (binaryMode) { Tcl_SetByteArrayLength(objPtr, 0); } else { Tcl_SetObjLength(objPtr, 0); |
︙ | ︙ |
Changes to generic/tclInt.decls.
︙ | ︙ | |||
111 112 113 114 115 116 117 | } declare 41 { Tcl_Command TclGetOriginalCommand(Tcl_Command command) } declare 42 { const char *TclpGetUserHome(const char *name, Tcl_DString *bufferPtr) } | < < < | 111 112 113 114 115 116 117 118 119 120 121 122 123 124 | } declare 41 { Tcl_Command TclGetOriginalCommand(Tcl_Command command) } declare 42 { const char *TclpGetUserHome(const char *name, Tcl_DString *bufferPtr) } declare 44 { int TclGuessPackageName(const char *fileName, Tcl_DString *bufPtr) } declare 45 { int TclHideUnsafeCommands(Tcl_Interp *interp) } declare 46 { |
︙ | ︙ |
Changes to generic/tclInt.h.
︙ | ︙ | |||
4547 4548 4549 4550 4551 4552 4553 | * MODULE_SCOPE char * TclGetString(Tcl_Obj *objPtr); *---------------------------------------------------------------- */ #define TclGetString(objPtr) \ ((objPtr)->bytes? (objPtr)->bytes : Tcl_GetString(objPtr)) | < | 4547 4548 4549 4550 4551 4552 4553 4554 4555 4556 4557 4558 4559 4560 | * MODULE_SCOPE char * TclGetString(Tcl_Obj *objPtr); *---------------------------------------------------------------- */ #define TclGetString(objPtr) \ ((objPtr)->bytes? (objPtr)->bytes : Tcl_GetString(objPtr)) #define TclGetStringFromObj(objPtr, lenPtr) \ ((objPtr)->bytes \ ? (*(lenPtr) = (objPtr)->length, (objPtr)->bytes) \ : (Tcl_GetStringFromObj)((objPtr), (lenPtr))) /* *---------------------------------------------------------------- |
︙ | ︙ |
Changes to generic/tclIntDecls.h.
︙ | ︙ | |||
152 153 154 155 156 157 158 | EXTERN int TclGetOpenMode(Tcl_Interp *interp, const char *str, int *seekFlagPtr); /* 41 */ EXTERN Tcl_Command TclGetOriginalCommand(Tcl_Command command); /* 42 */ EXTERN const char * TclpGetUserHome(const char *name, Tcl_DString *bufferPtr); | | < | 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 | EXTERN int TclGetOpenMode(Tcl_Interp *interp, const char *str, int *seekFlagPtr); /* 41 */ EXTERN Tcl_Command TclGetOriginalCommand(Tcl_Command command); /* 42 */ EXTERN const char * TclpGetUserHome(const char *name, Tcl_DString *bufferPtr); /* Slot 43 is reserved */ /* 44 */ EXTERN int TclGuessPackageName(const char *fileName, Tcl_DString *bufPtr); /* 45 */ EXTERN int TclHideUnsafeCommands(Tcl_Interp *interp); /* 46 */ EXTERN int TclInExit(void); |
︙ | ︙ | |||
711 712 713 714 715 716 717 | void (*reserved36)(void); int (*tclGetLoadedPackages) (Tcl_Interp *interp, const char *targetName); /* 37 */ int (*tclGetNamespaceForQualName) (Tcl_Interp *interp, const char *qualName, Namespace *cxtNsPtr, int flags, Namespace **nsPtrPtr, Namespace **altNsPtrPtr, Namespace **actualCxtPtrPtr, const char **simpleNamePtr); /* 38 */ Tcl_ObjCmdProc * (*tclGetObjInterpProc) (void); /* 39 */ int (*tclGetOpenMode) (Tcl_Interp *interp, const char *str, int *seekFlagPtr); /* 40 */ Tcl_Command (*tclGetOriginalCommand) (Tcl_Command command); /* 41 */ const char * (*tclpGetUserHome) (const char *name, Tcl_DString *bufferPtr); /* 42 */ | | | 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 | void (*reserved36)(void); int (*tclGetLoadedPackages) (Tcl_Interp *interp, const char *targetName); /* 37 */ int (*tclGetNamespaceForQualName) (Tcl_Interp *interp, const char *qualName, Namespace *cxtNsPtr, int flags, Namespace **nsPtrPtr, Namespace **altNsPtrPtr, Namespace **actualCxtPtrPtr, const char **simpleNamePtr); /* 38 */ Tcl_ObjCmdProc * (*tclGetObjInterpProc) (void); /* 39 */ int (*tclGetOpenMode) (Tcl_Interp *interp, const char *str, int *seekFlagPtr); /* 40 */ Tcl_Command (*tclGetOriginalCommand) (Tcl_Command command); /* 41 */ const char * (*tclpGetUserHome) (const char *name, Tcl_DString *bufferPtr); /* 42 */ void (*reserved43)(void); int (*tclGuessPackageName) (const char *fileName, Tcl_DString *bufPtr); /* 44 */ int (*tclHideUnsafeCommands) (Tcl_Interp *interp); /* 45 */ int (*tclInExit) (void); /* 46 */ void (*reserved47)(void); void (*reserved48)(void); void (*reserved49)(void); void (*tclInitCompiledLocals) (Tcl_Interp *interp, CallFrame *framePtr, Namespace *nsPtr); /* 50 */ |
︙ | ︙ | |||
1012 1013 1014 1015 1016 1017 1018 | (tclIntStubsPtr->tclGetObjInterpProc) /* 39 */ #define TclGetOpenMode \ (tclIntStubsPtr->tclGetOpenMode) /* 40 */ #define TclGetOriginalCommand \ (tclIntStubsPtr->tclGetOriginalCommand) /* 41 */ #define TclpGetUserHome \ (tclIntStubsPtr->tclpGetUserHome) /* 42 */ | | < | 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 | (tclIntStubsPtr->tclGetObjInterpProc) /* 39 */ #define TclGetOpenMode \ (tclIntStubsPtr->tclGetOpenMode) /* 40 */ #define TclGetOriginalCommand \ (tclIntStubsPtr->tclGetOriginalCommand) /* 41 */ #define TclpGetUserHome \ (tclIntStubsPtr->tclpGetUserHome) /* 42 */ /* Slot 43 is reserved */ #define TclGuessPackageName \ (tclIntStubsPtr->tclGuessPackageName) /* 44 */ #define TclHideUnsafeCommands \ (tclIntStubsPtr->tclHideUnsafeCommands) /* 45 */ #define TclInExit \ (tclIntStubsPtr->tclInExit) /* 46 */ /* Slot 47 is reserved */ |
︙ | ︙ | |||
1421 1422 1423 1424 1425 1426 1427 | #endif #undef TclGuessPackageName #undef TclUnusedStubEntry #undef TclSetPreInitScript #undef TclObjInterpProc #define TclObjInterpProc TclGetObjInterpProc() | | > | 1419 1420 1421 1422 1423 1424 1425 1426 1427 1428 1429 1430 1431 1432 1433 | #endif #undef TclGuessPackageName #undef TclUnusedStubEntry #undef TclSetPreInitScript #undef TclObjInterpProc #define TclObjInterpProc TclGetObjInterpProc() #define TclObjInterpProc2 TclObjInterpProc #ifndef TCL_NO_DEPRECATED # define TclSetPreInitScript Tcl_SetPreInitScript # define TclGuessPackageName(fileName, pkgName) ((void)fileName,(void)pkgName,0) #endif #endif /* _TCLINTDECLS */ |
Changes to generic/tclOO.c.
︙ | ︙ | |||
388 389 390 391 392 393 394 | /* * 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"); | | | | 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 | /* * 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. */ |
︙ | ︙ | |||
2289 2290 2291 2292 2293 2294 2295 | CloneObjectMethod( Tcl_Interp *interp, Object *oPtr, Method *mPtr, Tcl_Obj *namePtr) { if (mPtr->typePtr == NULL) { | | | | | | | | 2289 2290 2291 2292 2293 2294 2295 2296 2297 2298 2299 2300 2301 2302 2303 2304 2305 2306 2307 2308 2309 2310 2311 2312 2313 2314 2315 2316 2317 2318 2319 2320 2321 2322 2323 2324 2325 2326 2327 2328 2329 2330 2331 2332 2333 2334 2335 2336 2337 2338 2339 2340 2341 2342 2343 2344 2345 | CloneObjectMethod( Tcl_Interp *interp, Object *oPtr, Method *mPtr, Tcl_Obj *namePtr) { if (mPtr->typePtr == NULL) { Tcl_NewInstanceMethod(interp, (Tcl_Object) oPtr, namePtr, mPtr->flags & PUBLIC_METHOD, NULL, NULL); } else if (mPtr->typePtr->cloneProc) { ClientData newClientData; if (mPtr->typePtr->cloneProc(interp, mPtr->clientData, &newClientData) != TCL_OK) { return TCL_ERROR; } Tcl_NewInstanceMethod(interp, (Tcl_Object) oPtr, namePtr, mPtr->flags & PUBLIC_METHOD, mPtr->typePtr, newClientData); } else { Tcl_NewInstanceMethod(interp, (Tcl_Object) oPtr, namePtr, mPtr->flags & PUBLIC_METHOD, mPtr->typePtr, mPtr->clientData); } return TCL_OK; } static int CloneClassMethod( Tcl_Interp *interp, Class *clsPtr, Method *mPtr, Tcl_Obj *namePtr, Method **m2PtrPtr) { Method *m2Ptr; if (mPtr->typePtr == NULL) { m2Ptr = (Method *) Tcl_NewMethod(interp, (Tcl_Class) clsPtr, namePtr, mPtr->flags & PUBLIC_METHOD, NULL, NULL); } else if (mPtr->typePtr->cloneProc) { ClientData newClientData; if (mPtr->typePtr->cloneProc(interp, mPtr->clientData, &newClientData) != TCL_OK) { return TCL_ERROR; } m2Ptr = (Method *) Tcl_NewMethod(interp, (Tcl_Class) clsPtr, namePtr, mPtr->flags & PUBLIC_METHOD, mPtr->typePtr, newClientData); } else { m2Ptr = (Method *) Tcl_NewMethod(interp, (Tcl_Class) clsPtr, namePtr, mPtr->flags & PUBLIC_METHOD, mPtr->typePtr, mPtr->clientData); } if (m2PtrPtr != NULL) { *m2PtrPtr = m2Ptr; } return TCL_OK; |
︙ | ︙ |
Changes to generic/tclOO.decls.
︙ | ︙ | |||
64 65 66 67 68 69 70 | declare 12 { Tcl_Method Tcl_NewMethod(Tcl_Interp *interp, Tcl_Class cls, Tcl_Obj *nameObj, int flags, const Tcl_MethodType *typePtr, void *clientData) } declare 13 { Tcl_Object Tcl_NewObjectInstance(Tcl_Interp *interp, Tcl_Class cls, | | | | | | | 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 | declare 12 { Tcl_Method Tcl_NewMethod(Tcl_Interp *interp, Tcl_Class cls, Tcl_Obj *nameObj, int flags, const Tcl_MethodType *typePtr, void *clientData) } declare 13 { Tcl_Object Tcl_NewObjectInstance(Tcl_Interp *interp, Tcl_Class cls, const char *nameStr, const char *nsNameStr, Tcl_Size objc, Tcl_Obj *const *objv, Tcl_Size skip) } declare 14 { int Tcl_ObjectDeleted(Tcl_Object object) } declare 15 { int Tcl_ObjectContextIsFiltering(Tcl_ObjectContext context) } declare 16 { Tcl_Method Tcl_ObjectContextMethod(Tcl_ObjectContext context) } declare 17 { Tcl_Object Tcl_ObjectContextObject(Tcl_ObjectContext context) } declare 18 { Tcl_Size Tcl_ObjectContextSkippedArgs(Tcl_ObjectContext context) } declare 19 { void *Tcl_ClassGetMetadata(Tcl_Class clazz, const Tcl_ObjectMetadataType *typePtr) } declare 20 { void Tcl_ClassSetMetadata(Tcl_Class clazz, const Tcl_ObjectMetadataType *typePtr, void *metadata) } declare 21 { void *Tcl_ObjectGetMetadata(Tcl_Object object, const Tcl_ObjectMetadataType *typePtr) } declare 22 { void Tcl_ObjectSetMetadata(Tcl_Object object, const Tcl_ObjectMetadataType *typePtr, void *metadata) } declare 23 { int Tcl_ObjectContextInvokeNext(Tcl_Interp *interp, Tcl_ObjectContext context, Tcl_Size objc, Tcl_Obj *const *objv, Tcl_Size skip) } declare 24 { Tcl_ObjectMapMethodNameProc *Tcl_ObjectGetMethodNameMapper( Tcl_Object object) } declare 25 { void Tcl_ObjectSetMethodNameMapper(Tcl_Object object, |
︙ | ︙ | |||
131 132 133 134 135 136 137 | } declare 30 { Tcl_Class Tcl_GetClassOfObject(Tcl_Object object) } declare 31 { Tcl_Obj *Tcl_GetObjectClassName(Tcl_Interp *interp, Tcl_Object object) } | < < < < < < < < < < < < < < | 131 132 133 134 135 136 137 138 139 140 141 142 143 144 | } declare 30 { Tcl_Class Tcl_GetClassOfObject(Tcl_Object object) } declare 31 { Tcl_Obj *Tcl_GetObjectClassName(Tcl_Interp *interp, Tcl_Object object) } ###################################################################### # Private API, exposed to support advanced OO systems that plug in on top of # TclOO; not intended for general use and does not have any commitment to # long-term support. # |
︙ | ︙ | |||
180 181 182 183 184 185 186 | } declare 4 { Method *TclOONewProcMethod(Tcl_Interp *interp, Class *clsPtr, int flags, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, ProcedureMethod **pmPtrPtr) } declare 5 { | | | 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 | } declare 4 { Method *TclOONewProcMethod(Tcl_Interp *interp, Class *clsPtr, int flags, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, ProcedureMethod **pmPtrPtr) } declare 5 { int TclOOObjectCmdCore(Object *oPtr, Tcl_Interp *interp, Tcl_Size objc, Tcl_Obj *const *objv, int publicOnly, Class *startCls) } declare 6 { int TclOOIsReachable(Class *targetPtr, Class *startPtr) } declare 7 { Method *TclOONewForwardMethod(Tcl_Interp *interp, Class *clsPtr, |
︙ | ︙ | |||
210 211 212 213 214 215 216 | TclOO_PreCallProc *preCallPtr, TclOO_PostCallProc *postCallPtr, ProcErrorProc *errProc, void *clientData, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, int flags, void **internalTokenPtr) } declare 11 { int TclOOInvokeObject(Tcl_Interp *interp, Tcl_Object object, | | | | | | | 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 | TclOO_PreCallProc *preCallPtr, TclOO_PostCallProc *postCallPtr, ProcErrorProc *errProc, void *clientData, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, int flags, void **internalTokenPtr) } declare 11 { int TclOOInvokeObject(Tcl_Interp *interp, Tcl_Object object, Tcl_Class startCls, int publicPrivate, Tcl_Size objc, Tcl_Obj *const *objv) } declare 12 { void TclOOObjectSetFilters(Object *oPtr, Tcl_Size numFilters, Tcl_Obj *const *filters) } declare 13 { void TclOOClassSetFilters(Tcl_Interp *interp, Class *classPtr, Tcl_Size numFilters, Tcl_Obj *const *filters) } declare 14 { void TclOOObjectSetMixins(Object *oPtr, Tcl_Size numMixins, Class *const *mixins) } declare 15 { void TclOOClassSetMixins(Tcl_Interp *interp, Class *classPtr, Tcl_Size numMixins, Class *const *mixins) } return # Local Variables: # mode: tcl # End: |
Changes to generic/tclOO.h.
︙ | ︙ | |||
58 59 60 61 62 63 64 | * Public datatypes for callbacks and structures used in the TIP#257 (OO) * implementation. These are used to implement custom types of method calls * and to allow the attachment of arbitrary data to objects and classes. */ typedef int (Tcl_MethodCallProc)(void *clientData, Tcl_Interp *interp, Tcl_ObjectContext objectContext, int objc, Tcl_Obj *const *objv); | | < | 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 | * Public datatypes for callbacks and structures used in the TIP#257 (OO) * implementation. These are used to implement custom types of method calls * and to allow the attachment of arbitrary data to objects and classes. */ typedef int (Tcl_MethodCallProc)(void *clientData, Tcl_Interp *interp, Tcl_ObjectContext objectContext, int objc, Tcl_Obj *const *objv); #define Tcl_MethodCallProc2 Tcl_MethodCallProc typedef void (Tcl_MethodDeleteProc)(void *clientData); typedef int (Tcl_CloneProc)(Tcl_Interp *interp, void *oldClientData, void **newClientData); typedef void (Tcl_ObjectMetadataDeleteProc)(void *clientData); typedef int (Tcl_ObjectMapMethodNameProc)(Tcl_Interp *interp, Tcl_Object object, Tcl_Class *startClsPtr, Tcl_Obj *methodNameObj); |
︙ | ︙ | |||
90 91 92 93 94 95 96 | * data, or NULL if the type-specific data * does not need deleting. */ Tcl_CloneProc *cloneProc; /* How to copy this method's type-specific * data, or NULL if the type-specific data can * be copied directly. */ } Tcl_MethodType; | < < < < < < < < < < < < < < < | | 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 | * data, or NULL if the type-specific data * does not need deleting. */ Tcl_CloneProc *cloneProc; /* How to copy this method's type-specific * data, or NULL if the type-specific data can * be copied directly. */ } Tcl_MethodType; #define Tcl_MethodType2 Tcl_MethodType /* * The correct value for the version field of the Tcl_MethodType structure. * This allows new versions of the structure to be introduced without breaking * binary compatibility. */ |
︙ | ︙ |
Changes to generic/tclOOCall.c.
︙ | ︙ | |||
367 368 369 370 371 372 373 | contextPtr->oPtr->flags &= ~FILTER_HANDLING; } /* * Run the method implementation. */ | < | < < < | 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 | contextPtr->oPtr->flags &= ~FILTER_HANDLING; } /* * Run the method implementation. */ return (mPtr->typePtr->callProc)(mPtr->clientData, interp, (Tcl_ObjectContext) contextPtr, objc, objv); } static int SetFilterFlags( void *data[], TCL_UNUSED(Tcl_Interp *), |
︙ | ︙ |
Changes to generic/tclOODecls.h.
︙ | ︙ | |||
65 66 67 68 69 70 71 | TCLAPI Tcl_Method Tcl_NewMethod(Tcl_Interp *interp, Tcl_Class cls, Tcl_Obj *nameObj, int flags, const Tcl_MethodType *typePtr, void *clientData); /* 13 */ TCLAPI Tcl_Object Tcl_NewObjectInstance(Tcl_Interp *interp, Tcl_Class cls, const char *nameStr, | | | | | | | 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 | TCLAPI Tcl_Method Tcl_NewMethod(Tcl_Interp *interp, Tcl_Class cls, Tcl_Obj *nameObj, int flags, const Tcl_MethodType *typePtr, void *clientData); /* 13 */ TCLAPI Tcl_Object Tcl_NewObjectInstance(Tcl_Interp *interp, Tcl_Class cls, const char *nameStr, const char *nsNameStr, Tcl_Size objc, Tcl_Obj *const *objv, Tcl_Size skip); /* 14 */ TCLAPI int Tcl_ObjectDeleted(Tcl_Object object); /* 15 */ TCLAPI int Tcl_ObjectContextIsFiltering( Tcl_ObjectContext context); /* 16 */ TCLAPI Tcl_Method Tcl_ObjectContextMethod(Tcl_ObjectContext context); /* 17 */ TCLAPI Tcl_Object Tcl_ObjectContextObject(Tcl_ObjectContext context); /* 18 */ TCLAPI Tcl_Size Tcl_ObjectContextSkippedArgs( Tcl_ObjectContext context); /* 19 */ TCLAPI void * Tcl_ClassGetMetadata(Tcl_Class clazz, const Tcl_ObjectMetadataType *typePtr); /* 20 */ TCLAPI void Tcl_ClassSetMetadata(Tcl_Class clazz, const Tcl_ObjectMetadataType *typePtr, void *metadata); /* 21 */ TCLAPI void * Tcl_ObjectGetMetadata(Tcl_Object object, const Tcl_ObjectMetadataType *typePtr); /* 22 */ TCLAPI void Tcl_ObjectSetMetadata(Tcl_Object object, const Tcl_ObjectMetadataType *typePtr, void *metadata); /* 23 */ TCLAPI int Tcl_ObjectContextInvokeNext(Tcl_Interp *interp, Tcl_ObjectContext context, Tcl_Size objc, Tcl_Obj *const *objv, Tcl_Size skip); /* 24 */ TCLAPI Tcl_ObjectMapMethodNameProc * Tcl_ObjectGetMethodNameMapper( Tcl_Object object); /* 25 */ TCLAPI void Tcl_ObjectSetMethodNameMapper(Tcl_Object object, Tcl_ObjectMapMethodNameProc *mapMethodNameProc); /* 26 */ |
︙ | ︙ | |||
119 120 121 122 123 124 125 | /* 29 */ TCLAPI int Tcl_MethodIsPrivate(Tcl_Method method); /* 30 */ TCLAPI Tcl_Class Tcl_GetClassOfObject(Tcl_Object object); /* 31 */ TCLAPI Tcl_Obj * Tcl_GetObjectClassName(Tcl_Interp *interp, Tcl_Object object); | < < < < < < < < < < < < < < | 119 120 121 122 123 124 125 126 127 128 129 130 131 132 | /* 29 */ TCLAPI int Tcl_MethodIsPrivate(Tcl_Method method); /* 30 */ TCLAPI Tcl_Class Tcl_GetClassOfObject(Tcl_Object object); /* 31 */ TCLAPI Tcl_Obj * Tcl_GetObjectClassName(Tcl_Interp *interp, Tcl_Object object); typedef struct { const struct TclOOIntStubs *tclOOIntStubs; } TclOOStubHooks; typedef struct TclOOStubs { int magic; |
︙ | ︙ | |||
155 156 157 158 159 160 161 | Tcl_Class (*tcl_MethodDeclarerClass) (Tcl_Method method); /* 6 */ Tcl_Object (*tcl_MethodDeclarerObject) (Tcl_Method method); /* 7 */ int (*tcl_MethodIsPublic) (Tcl_Method method); /* 8 */ int (*tcl_MethodIsType) (Tcl_Method method, const Tcl_MethodType *typePtr, void **clientDataPtr); /* 9 */ Tcl_Obj * (*tcl_MethodName) (Tcl_Method method); /* 10 */ Tcl_Method (*tcl_NewInstanceMethod) (Tcl_Interp *interp, Tcl_Object object, Tcl_Obj *nameObj, int flags, const Tcl_MethodType *typePtr, void *clientData); /* 11 */ Tcl_Method (*tcl_NewMethod) (Tcl_Interp *interp, Tcl_Class cls, Tcl_Obj *nameObj, int flags, const Tcl_MethodType *typePtr, void *clientData); /* 12 */ | | | | < < < | 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 | Tcl_Class (*tcl_MethodDeclarerClass) (Tcl_Method method); /* 6 */ Tcl_Object (*tcl_MethodDeclarerObject) (Tcl_Method method); /* 7 */ int (*tcl_MethodIsPublic) (Tcl_Method method); /* 8 */ int (*tcl_MethodIsType) (Tcl_Method method, const Tcl_MethodType *typePtr, void **clientDataPtr); /* 9 */ Tcl_Obj * (*tcl_MethodName) (Tcl_Method method); /* 10 */ Tcl_Method (*tcl_NewInstanceMethod) (Tcl_Interp *interp, Tcl_Object object, Tcl_Obj *nameObj, int flags, const Tcl_MethodType *typePtr, void *clientData); /* 11 */ Tcl_Method (*tcl_NewMethod) (Tcl_Interp *interp, Tcl_Class cls, Tcl_Obj *nameObj, int flags, const Tcl_MethodType *typePtr, void *clientData); /* 12 */ Tcl_Object (*tcl_NewObjectInstance) (Tcl_Interp *interp, Tcl_Class cls, const char *nameStr, const char *nsNameStr, Tcl_Size objc, Tcl_Obj *const *objv, Tcl_Size skip); /* 13 */ int (*tcl_ObjectDeleted) (Tcl_Object object); /* 14 */ int (*tcl_ObjectContextIsFiltering) (Tcl_ObjectContext context); /* 15 */ Tcl_Method (*tcl_ObjectContextMethod) (Tcl_ObjectContext context); /* 16 */ Tcl_Object (*tcl_ObjectContextObject) (Tcl_ObjectContext context); /* 17 */ Tcl_Size (*tcl_ObjectContextSkippedArgs) (Tcl_ObjectContext context); /* 18 */ void * (*tcl_ClassGetMetadata) (Tcl_Class clazz, const Tcl_ObjectMetadataType *typePtr); /* 19 */ void (*tcl_ClassSetMetadata) (Tcl_Class clazz, const Tcl_ObjectMetadataType *typePtr, void *metadata); /* 20 */ void * (*tcl_ObjectGetMetadata) (Tcl_Object object, const Tcl_ObjectMetadataType *typePtr); /* 21 */ void (*tcl_ObjectSetMetadata) (Tcl_Object object, const Tcl_ObjectMetadataType *typePtr, void *metadata); /* 22 */ int (*tcl_ObjectContextInvokeNext) (Tcl_Interp *interp, Tcl_ObjectContext context, Tcl_Size objc, Tcl_Obj *const *objv, Tcl_Size skip); /* 23 */ Tcl_ObjectMapMethodNameProc * (*tcl_ObjectGetMethodNameMapper) (Tcl_Object object); /* 24 */ void (*tcl_ObjectSetMethodNameMapper) (Tcl_Object object, Tcl_ObjectMapMethodNameProc *mapMethodNameProc); /* 25 */ void (*tcl_ClassSetConstructor) (Tcl_Interp *interp, Tcl_Class clazz, Tcl_Method method); /* 26 */ void (*tcl_ClassSetDestructor) (Tcl_Interp *interp, Tcl_Class clazz, Tcl_Method method); /* 27 */ Tcl_Obj * (*tcl_GetObjectName) (Tcl_Interp *interp, Tcl_Object object); /* 28 */ int (*tcl_MethodIsPrivate) (Tcl_Method method); /* 29 */ Tcl_Class (*tcl_GetClassOfObject) (Tcl_Object object); /* 30 */ Tcl_Obj * (*tcl_GetObjectClassName) (Tcl_Interp *interp, Tcl_Object object); /* 31 */ } TclOOStubs; extern const TclOOStubs *tclOOStubsPtr; #ifdef __cplusplus } #endif |
︙ | ︙ | |||
255 256 257 258 259 260 261 | (tclOOStubsPtr->tcl_GetObjectName) /* 28 */ #define Tcl_MethodIsPrivate \ (tclOOStubsPtr->tcl_MethodIsPrivate) /* 29 */ #define Tcl_GetClassOfObject \ (tclOOStubsPtr->tcl_GetClassOfObject) /* 30 */ #define Tcl_GetObjectClassName \ (tclOOStubsPtr->tcl_GetObjectClassName) /* 31 */ | < < < < < < > > > > > | 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 | (tclOOStubsPtr->tcl_GetObjectName) /* 28 */ #define Tcl_MethodIsPrivate \ (tclOOStubsPtr->tcl_MethodIsPrivate) /* 29 */ #define Tcl_GetClassOfObject \ (tclOOStubsPtr->tcl_GetClassOfObject) /* 30 */ #define Tcl_GetObjectClassName \ (tclOOStubsPtr->tcl_GetObjectClassName) /* 31 */ #endif /* defined(USE_TCLOO_STUBS) */ /* !END!: Do not edit above this line. */ #define Tcl_MethodIsType2 Tcl_MethodIsType #define Tcl_NewInstanceMethod2 Tcl_NewInstanceMethod #define Tcl_NewMethod2 Tcl_NewMethod #endif /* _TCLOODECLS */ |
Changes to generic/tclOODefineCmds.c.
︙ | ︙ | |||
2299 2300 2301 2302 2303 2304 2305 | for (slotInfoPtr = slots ; slotInfoPtr->name ; slotInfoPtr++) { Tcl_Object slotObject = Tcl_NewObjectInstance(fPtr->interp, (Tcl_Class) slotCls, slotInfoPtr->name, NULL, -1, NULL, 0); if (slotObject == NULL) { continue; } | | | | | 2299 2300 2301 2302 2303 2304 2305 2306 2307 2308 2309 2310 2311 2312 2313 2314 2315 2316 2317 2318 | for (slotInfoPtr = slots ; slotInfoPtr->name ; slotInfoPtr++) { Tcl_Object slotObject = Tcl_NewObjectInstance(fPtr->interp, (Tcl_Class) slotCls, slotInfoPtr->name, NULL, -1, NULL, 0); if (slotObject == NULL) { continue; } Tcl_NewInstanceMethod(fPtr->interp, slotObject, getName, 0, &slotInfoPtr->getterType, NULL); Tcl_NewInstanceMethod(fPtr->interp, slotObject, setName, 0, &slotInfoPtr->setterType, NULL); if (slotInfoPtr->resolverType.callProc) { Tcl_NewInstanceMethod(fPtr->interp, slotObject, resolveName, 0, &slotInfoPtr->resolverType, NULL); } } Tcl_DecrRefCount(getName); Tcl_DecrRefCount(setName); Tcl_DecrRefCount(resolveName); return TCL_OK; |
︙ | ︙ |
Changes to generic/tclOOInt.h.
︙ | ︙ | |||
514 515 516 517 518 519 520 | */ MODULE_SCOPE void TclOOAddToInstances(Object *oPtr, Class *clsPtr); MODULE_SCOPE void TclOOAddToMixinSubs(Class *subPtr, Class *mixinPtr); MODULE_SCOPE void TclOOAddToSubclasses(Class *subPtr, Class *superPtr); MODULE_SCOPE Class * TclOOAllocClass(Tcl_Interp *interp, Object *useThisObj); | < < < < < < < < < < < | 514 515 516 517 518 519 520 521 522 523 524 525 526 527 | */ MODULE_SCOPE void TclOOAddToInstances(Object *oPtr, Class *clsPtr); MODULE_SCOPE void TclOOAddToMixinSubs(Class *subPtr, Class *mixinPtr); MODULE_SCOPE void TclOOAddToSubclasses(Class *subPtr, Class *superPtr); MODULE_SCOPE Class * TclOOAllocClass(Tcl_Interp *interp, Object *useThisObj); MODULE_SCOPE int TclNRNewObjectInstance(Tcl_Interp *interp, Tcl_Class cls, const char *nameStr, const char *nsNameStr, int objc, Tcl_Obj *const *objv, int skip, Tcl_Object *objectPtr); MODULE_SCOPE Object * TclNewObjectInstanceCommon(Tcl_Interp *interp, Class *classPtr, |
︙ | ︙ |
Changes to generic/tclOOIntDecls.h.
︙ | ︙ | |||
38 39 40 41 42 43 44 | /* 4 */ TCLAPI Method * TclOONewProcMethod(Tcl_Interp *interp, Class *clsPtr, int flags, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, ProcedureMethod **pmPtrPtr); /* 5 */ TCLAPI int TclOOObjectCmdCore(Object *oPtr, Tcl_Interp *interp, | | | 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 | /* 4 */ TCLAPI Method * TclOONewProcMethod(Tcl_Interp *interp, Class *clsPtr, int flags, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, ProcedureMethod **pmPtrPtr); /* 5 */ TCLAPI int TclOOObjectCmdCore(Object *oPtr, Tcl_Interp *interp, Tcl_Size objc, Tcl_Obj *const *objv, int publicOnly, Class *startCls); /* 6 */ TCLAPI int TclOOIsReachable(Class *targetPtr, Class *startPtr); /* 7 */ TCLAPI Method * TclOONewForwardMethod(Tcl_Interp *interp, Class *clsPtr, int isPublic, Tcl_Obj *nameObj, Tcl_Obj *prefixObj); |
︙ | ︙ | |||
71 72 73 74 75 76 77 | ProcErrorProc *errProc, void *clientData, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, int flags, void **internalTokenPtr); /* 11 */ TCLAPI int TclOOInvokeObject(Tcl_Interp *interp, Tcl_Object object, Tcl_Class startCls, | | | | | | | | | | | | | | | 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 | ProcErrorProc *errProc, void *clientData, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, int flags, void **internalTokenPtr); /* 11 */ TCLAPI int TclOOInvokeObject(Tcl_Interp *interp, Tcl_Object object, Tcl_Class startCls, int publicPrivate, Tcl_Size objc, Tcl_Obj *const *objv); /* 12 */ TCLAPI void TclOOObjectSetFilters(Object *oPtr, Tcl_Size numFilters, Tcl_Obj *const *filters); /* 13 */ TCLAPI void TclOOClassSetFilters(Tcl_Interp *interp, Class *classPtr, Tcl_Size numFilters, Tcl_Obj *const *filters); /* 14 */ TCLAPI void TclOOObjectSetMixins(Object *oPtr, Tcl_Size numMixins, Class *const *mixins); /* 15 */ TCLAPI void TclOOClassSetMixins(Tcl_Interp *interp, Class *classPtr, Tcl_Size numMixins, Class *const *mixins); typedef struct TclOOIntStubs { int magic; void *hooks; Tcl_Object (*tclOOGetDefineCmdContext) (Tcl_Interp *interp); /* 0 */ Tcl_Method (*tclOOMakeProcInstanceMethod) (Tcl_Interp *interp, Object *oPtr, int flags, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, const Tcl_MethodType *typePtr, void *clientData, Proc **procPtrPtr); /* 1 */ Tcl_Method (*tclOOMakeProcMethod) (Tcl_Interp *interp, Class *clsPtr, int flags, Tcl_Obj *nameObj, const char *namePtr, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, const Tcl_MethodType *typePtr, void *clientData, Proc **procPtrPtr); /* 2 */ Method * (*tclOONewProcInstanceMethod) (Tcl_Interp *interp, Object *oPtr, int flags, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, ProcedureMethod **pmPtrPtr); /* 3 */ Method * (*tclOONewProcMethod) (Tcl_Interp *interp, Class *clsPtr, int flags, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, ProcedureMethod **pmPtrPtr); /* 4 */ int (*tclOOObjectCmdCore) (Object *oPtr, Tcl_Interp *interp, Tcl_Size objc, Tcl_Obj *const *objv, int publicOnly, Class *startCls); /* 5 */ int (*tclOOIsReachable) (Class *targetPtr, Class *startPtr); /* 6 */ Method * (*tclOONewForwardMethod) (Tcl_Interp *interp, Class *clsPtr, int isPublic, Tcl_Obj *nameObj, Tcl_Obj *prefixObj); /* 7 */ Method * (*tclOONewForwardInstanceMethod) (Tcl_Interp *interp, Object *oPtr, int isPublic, Tcl_Obj *nameObj, Tcl_Obj *prefixObj); /* 8 */ Tcl_Method (*tclOONewProcInstanceMethodEx) (Tcl_Interp *interp, Tcl_Object oPtr, TclOO_PreCallProc *preCallPtr, TclOO_PostCallProc *postCallPtr, ProcErrorProc *errProc, void *clientData, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, int flags, void **internalTokenPtr); /* 9 */ Tcl_Method (*tclOONewProcMethodEx) (Tcl_Interp *interp, Tcl_Class clsPtr, TclOO_PreCallProc *preCallPtr, TclOO_PostCallProc *postCallPtr, ProcErrorProc *errProc, void *clientData, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, int flags, void **internalTokenPtr); /* 10 */ int (*tclOOInvokeObject) (Tcl_Interp *interp, Tcl_Object object, Tcl_Class startCls, int publicPrivate, Tcl_Size objc, Tcl_Obj *const *objv); /* 11 */ void (*tclOOObjectSetFilters) (Object *oPtr, Tcl_Size numFilters, Tcl_Obj *const *filters); /* 12 */ void (*tclOOClassSetFilters) (Tcl_Interp *interp, Class *classPtr, Tcl_Size numFilters, Tcl_Obj *const *filters); /* 13 */ void (*tclOOObjectSetMixins) (Object *oPtr, Tcl_Size numMixins, Class *const *mixins); /* 14 */ void (*tclOOClassSetMixins) (Tcl_Interp *interp, Class *classPtr, Tcl_Size numMixins, Class *const *mixins); /* 15 */ } TclOOIntStubs; extern const TclOOIntStubs *tclOOIntStubsPtr; #ifdef __cplusplus } #endif |
︙ | ︙ |
Changes to generic/tclOOMethod.c.
︙ | ︙ | |||
122 123 124 125 126 127 128 | * * Attach a method to an object instance. * * ---------------------------------------------------------------------- */ Tcl_Method | | | 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 | * * Attach a method to an object instance. * * ---------------------------------------------------------------------- */ Tcl_Method Tcl_NewInstanceMethod( TCL_UNUSED(Tcl_Interp *), Tcl_Object object, /* The object that has the method attached to * it. */ Tcl_Obj *nameObj, /* The name of the method. May be NULL; if so, * up to caller to manage storage (e.g., when * it is a constructor or destructor). */ int flags, /* Whether this is a public method. */ |
︙ | ︙ | |||
183 184 185 186 187 188 189 | if (flags & TRUE_PRIVATE_METHOD) { oPtr->flags |= HAS_PRIVATE_METHODS; } } oPtr->epoch++; return (Tcl_Method) mPtr; } | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | | 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 | if (flags & TRUE_PRIVATE_METHOD) { oPtr->flags |= HAS_PRIVATE_METHODS; } } oPtr->epoch++; return (Tcl_Method) mPtr; } /* * ---------------------------------------------------------------------- * * Tcl_NewMethod -- * * Attach a method to a class. * * ---------------------------------------------------------------------- */ Tcl_Method Tcl_NewMethod( TCL_UNUSED(Tcl_Interp *), Tcl_Class cls, /* The class to attach the method to. */ Tcl_Obj *nameObj, /* The name of the object. May be NULL (e.g., * for constructors or destructors); if so, up * to caller to manage storage. */ int flags, /* Whether this is a public method. */ const Tcl_MethodType *typePtr, |
︙ | ︙ | |||
295 296 297 298 299 300 301 | if (flags & TRUE_PRIVATE_METHOD) { clsPtr->flags |= HAS_PRIVATE_METHODS; } } return (Tcl_Method) mPtr; } | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | 251 252 253 254 255 256 257 258 259 260 261 262 263 264 | if (flags & TRUE_PRIVATE_METHOD) { clsPtr->flags |= HAS_PRIVATE_METHODS; } } return (Tcl_Method) mPtr; } /* * ---------------------------------------------------------------------- * * TclOODelMethodRef -- * * How to delete a method. |
︙ | ︙ | |||
386 387 388 389 390 391 392 | const DeclaredClassMethod *dcm) /* Name of the method, whether it is public, * and the function to implement it. */ { Tcl_Obj *namePtr = Tcl_NewStringObj(dcm->name, -1); Tcl_IncrRefCount(namePtr); | | | 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 | const DeclaredClassMethod *dcm) /* Name of the method, whether it is public, * and the function to implement it. */ { Tcl_Obj *namePtr = Tcl_NewStringObj(dcm->name, -1); Tcl_IncrRefCount(namePtr); Tcl_NewMethod(interp, (Tcl_Class) clsPtr, namePtr, (dcm->isPublic ? PUBLIC_METHOD : 0), &dcm->definition, NULL); Tcl_DecrRefCount(namePtr); } /* * ---------------------------------------------------------------------- * |
︙ | ︙ | |||
611 612 613 614 615 616 617 | */ Tcl_DecrRefCount(context.data.eval.path); context.data.eval.path = NULL; } } | | | 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 | */ Tcl_DecrRefCount(context.data.eval.path); context.data.eval.path = NULL; } } return Tcl_NewInstanceMethod(interp, (Tcl_Object) oPtr, nameObj, flags, typePtr, clientData); } /* * ---------------------------------------------------------------------- * * TclOOMakeProcMethod -- |
︙ | ︙ | |||
724 725 726 727 728 729 730 | */ Tcl_DecrRefCount(context.data.eval.path); context.data.eval.path = NULL; } } | | | 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 | */ Tcl_DecrRefCount(context.data.eval.path); context.data.eval.path = NULL; } } return Tcl_NewMethod(interp, (Tcl_Class) clsPtr, nameObj, flags, typePtr, clientData); } /* * ---------------------------------------------------------------------- * * InvokeProcedureMethod, PushMethodCallFrame -- |
︙ | ︙ | |||
1484 1485 1486 1487 1488 1489 1490 | Tcl_SetErrorCode(interp, "TCL", "OO", "BAD_FORWARD", NULL); return NULL; } fmPtr = (ForwardMethod *)ckalloc(sizeof(ForwardMethod)); fmPtr->prefixObj = prefixObj; Tcl_IncrRefCount(prefixObj); | | | 1398 1399 1400 1401 1402 1403 1404 1405 1406 1407 1408 1409 1410 1411 1412 | Tcl_SetErrorCode(interp, "TCL", "OO", "BAD_FORWARD", NULL); return NULL; } fmPtr = (ForwardMethod *)ckalloc(sizeof(ForwardMethod)); fmPtr->prefixObj = prefixObj; Tcl_IncrRefCount(prefixObj); return (Method *) Tcl_NewInstanceMethod(interp, (Tcl_Object) oPtr, nameObj, flags, &fwdMethodType, fmPtr); } /* * ---------------------------------------------------------------------- * * TclOONewForwardMethod -- |
︙ | ︙ | |||
1523 1524 1525 1526 1527 1528 1529 | Tcl_SetErrorCode(interp, "TCL", "OO", "BAD_FORWARD", NULL); return NULL; } fmPtr = (ForwardMethod *)ckalloc(sizeof(ForwardMethod)); fmPtr->prefixObj = prefixObj; Tcl_IncrRefCount(prefixObj); | | | 1437 1438 1439 1440 1441 1442 1443 1444 1445 1446 1447 1448 1449 1450 1451 | Tcl_SetErrorCode(interp, "TCL", "OO", "BAD_FORWARD", NULL); return NULL; } fmPtr = (ForwardMethod *)ckalloc(sizeof(ForwardMethod)); fmPtr->prefixObj = prefixObj; Tcl_IncrRefCount(prefixObj); return (Method *) Tcl_NewMethod(interp, (Tcl_Class) clsPtr, nameObj, flags, &fwdMethodType, fmPtr); } /* * ---------------------------------------------------------------------- * * InvokeForwardMethod -- |
︙ | ︙ | |||
1754 1755 1756 1757 1758 1759 1760 | Tcl_MethodName( Tcl_Method method) { return ((Method *) method)->namePtr; } int | | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | 1668 1669 1670 1671 1672 1673 1674 1675 1676 1677 1678 1679 1680 1681 1682 1683 1684 1685 1686 1687 1688 1689 1690 | Tcl_MethodName( Tcl_Method method) { return ((Method *) method)->namePtr; } int Tcl_MethodIsType( Tcl_Method method, const Tcl_MethodType *typePtr, void **clientDataPtr) { Method *mPtr = (Method *) method; if (mPtr->typePtr == typePtr) { if (clientDataPtr != NULL) { *clientDataPtr = mPtr->clientData; } return 1; } return 0; } |
︙ | ︙ |
Changes to generic/tclOOStubInit.c.
︙ | ︙ | |||
72 73 74 75 76 77 78 | Tcl_ObjectSetMethodNameMapper, /* 25 */ Tcl_ClassSetConstructor, /* 26 */ Tcl_ClassSetDestructor, /* 27 */ Tcl_GetObjectName, /* 28 */ Tcl_MethodIsPrivate, /* 29 */ Tcl_GetClassOfObject, /* 30 */ Tcl_GetObjectClassName, /* 31 */ | < < < | 72 73 74 75 76 77 78 79 80 81 | Tcl_ObjectSetMethodNameMapper, /* 25 */ Tcl_ClassSetConstructor, /* 26 */ Tcl_ClassSetDestructor, /* 27 */ Tcl_GetObjectName, /* 28 */ Tcl_MethodIsPrivate, /* 29 */ Tcl_GetClassOfObject, /* 30 */ Tcl_GetObjectClassName, /* 31 */ }; /* !END!: Do not edit above this line. */ |
Changes to generic/tclObj.c.
︙ | ︙ | |||
1660 1661 1662 1663 1664 1665 1666 | } return objPtr->bytes; } /* *---------------------------------------------------------------------- * | | < | 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 | } return objPtr->bytes; } /* *---------------------------------------------------------------------- * * Tcl_GetStringFromObj -- * * Returns the string representation's byte array pointer and length for * an object. * * Results: * Returns a pointer to the string representation of objPtr. If lengthPtr * isn't NULL, the length of the string representation is stored at * *lengthPtr. The byte array referenced by the returned pointer must not * be modified by the caller. Furthermore, the caller must copy the bytes * if they need to retain them since the object's string rep can change * as a result of other operations. * * Side effects: * May call the object's updateStringProc to update the string * representation from the internal representation. * *---------------------------------------------------------------------- */ char * Tcl_GetStringFromObj( Tcl_Obj *objPtr, /* Object whose string rep byte pointer should * be returned. */ int *lengthPtr) /* If non-NULL, the location where the string * rep's byte array length should * be stored. * If NULL, no length is stored. */ |
︙ | ︙ | |||
1719 1720 1721 1722 1723 1724 1725 | } } if (lengthPtr != NULL) { *lengthPtr = objPtr->length; } return objPtr->bytes; } | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | 1718 1719 1720 1721 1722 1723 1724 1725 1726 1727 1728 1729 1730 1731 | } } if (lengthPtr != NULL) { *lengthPtr = objPtr->length; } return objPtr->bytes; } /* *---------------------------------------------------------------------- * * Tcl_InitStringRep -- * * This function is called in several configurations to provide all |
︙ | ︙ | |||
4041 4042 4043 4044 4045 4046 4047 | return TCL_ERROR; } int Tcl_GetNumber( Tcl_Interp *interp, const char *bytes, | | | < < < < < < < < | 3999 4000 4001 4002 4003 4004 4005 4006 4007 4008 4009 4010 4011 4012 4013 4014 4015 4016 4017 4018 4019 4020 4021 4022 4023 4024 4025 4026 4027 4028 | return TCL_ERROR; } int Tcl_GetNumber( Tcl_Interp *interp, const char *bytes, int numBytes, void **clientDataPtr, int *typePtr) { static Tcl_ThreadDataKey numberCacheKey; Tcl_Obj *objPtr = (Tcl_Obj *)Tcl_GetThreadData(&numberCacheKey, sizeof(Tcl_Obj)); Tcl_FreeInternalRep(objPtr); if (bytes == NULL) { bytes = &tclEmptyString; numBytes = 0; } if (numBytes < 0) { numBytes = (int)strlen(bytes); } objPtr->bytes = (char *) bytes; objPtr->length = numBytes; return Tcl_GetNumberFromObj(interp, objPtr, clientDataPtr, typePtr); } |
︙ | ︙ |
Changes to generic/tclProc.c.
︙ | ︙ | |||
1679 1680 1681 1682 1683 1684 1685 | /*isLambda*/ 0); if (result != TCL_OK) { return TCL_ERROR; } return TclNRInterpProcCore(interp, objv[0], 1, &MakeProcError); } | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | 1679 1680 1681 1682 1683 1684 1685 1686 1687 1688 1689 1690 1691 1692 | /*isLambda*/ 0); if (result != TCL_OK) { return TCL_ERROR; } return TclNRInterpProcCore(interp, objv[0], 1, &MakeProcError); } /* *---------------------------------------------------------------------- * * TclNRInterpProcCore -- * * When a Tcl procedure, lambda term or anything else that works like a |
︙ | ︙ | |||
2308 2309 2310 2311 2312 2313 2314 | } return code; } /* *---------------------------------------------------------------------- * | | | | < < < < < < | 2271 2272 2273 2274 2275 2276 2277 2278 2279 2280 2281 2282 2283 2284 2285 2286 2287 2288 2289 2290 2291 2292 2293 2294 2295 2296 2297 2298 2299 2300 2301 2302 2303 2304 2305 2306 | } return code; } /* *---------------------------------------------------------------------- * * TclGetObjInterpProc -- * * Returns a pointer to the TclObjInterpProc functions; * this is different from the value obtained from the TclObjInterpProc * reference on systems like Windows where import and export versions * of a function exported by a DLL exist. * * Results: * Returns the internal address of the TclObjInterpProc * functions. * * Side effects: * None. * *---------------------------------------------------------------------- */ Tcl_ObjCmdProc * TclGetObjInterpProc(void) { return TclObjInterpProc; } /* *---------------------------------------------------------------------- * * TclNewProcBodyObj -- * * Creates a new object, of type "procbody", whose internal |
︙ | ︙ |
Changes to generic/tclStringObj.c.
︙ | ︙ | |||
907 908 909 910 911 912 913 | * * Side effects: * Converts the object to have the String internal rep. * *---------------------------------------------------------------------- */ | < | | | 907 908 909 910 911 912 913 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 930 931 932 933 934 935 | * * Side effects: * Converts the object to have the String internal rep. * *---------------------------------------------------------------------- */ #ifndef TCL_NO_DEPRECATED #undef Tcl_GetUnicode unsigned short * Tcl_GetUnicode( Tcl_Obj *objPtr) /* The object to find the Unicode string * for. */ { return Tcl_GetUnicodeFromObj(objPtr, NULL); } #endif /* TCL_NO_DEPRECATED */ /* *---------------------------------------------------------------------- * * Tcl_GetUnicodeFromObj -- * * Get the Unicode form of the String object with length. If the object * is not already a String object, it will be converted to one. If the * String object does not have a Unicode rep, then one is create from the * UTF string format. * * Results: |
︙ | ︙ | |||
979 980 981 982 983 984 985 | SetUTF16StringFromAny(NULL, objPtr); stringPtr = GET_STRING(objPtr); if (lengthPtr != NULL) { *lengthPtr = stringPtr->numChars; } | < < < < < < < < < < < < < < < < < < < < < < < < < | 978 979 980 981 982 983 984 985 986 987 988 989 990 991 | SetUTF16StringFromAny(NULL, objPtr); stringPtr = GET_STRING(objPtr); if (lengthPtr != NULL) { *lengthPtr = stringPtr->numChars; } return stringPtr->unicode; } #endif /* *---------------------------------------------------------------------- * |
︙ | ︙ | |||
1841 1842 1843 1844 1845 1846 1847 | /* * Now do the append knowing that buffer growth cannot cause any * trouble. */ TclAppendBytesToByteArray(objPtr, | | | 1815 1816 1817 1818 1819 1820 1821 1822 1823 1824 1825 1826 1827 1828 1829 | /* * Now do the append knowing that buffer growth cannot cause any * trouble. */ TclAppendBytesToByteArray(objPtr, Tcl_GetByteArrayFromObj(appendObjPtr, NULL), lengthSrc); return; } /* * Must append as strings. */ |
︙ | ︙ | |||
3419 3420 3421 3422 3423 3424 3425 | Tcl_SetByteArrayLength(objResultPtr, count*length); /* PANIC? */ Tcl_SetByteArrayLength(objResultPtr, length); while (count - done > done) { Tcl_AppendObjToObj(objResultPtr, objResultPtr); done *= 2; } TclAppendBytesToByteArray(objResultPtr, | | | 3393 3394 3395 3396 3397 3398 3399 3400 3401 3402 3403 3404 3405 3406 3407 | Tcl_SetByteArrayLength(objResultPtr, count*length); /* PANIC? */ Tcl_SetByteArrayLength(objResultPtr, length); while (count - done > done) { Tcl_AppendObjToObj(objResultPtr, objResultPtr); done *= 2; } TclAppendBytesToByteArray(objResultPtr, Tcl_GetByteArrayFromObj(objResultPtr, NULL), (count - done) * length); } else if (unichar) { /* * Efficiently produce a pure Tcl_UniChar array result. */ if (!inPlace || Tcl_IsShared(objPtr)) { |
︙ | ︙ | |||
4318 4319 4320 4321 4322 4323 4324 | if (TclIsPureByteArray(objPtr)) { Tcl_Size numBytes; unsigned char *from = Tcl_GetByteArrayFromObj(objPtr, &numBytes); if (!inPlace || Tcl_IsShared(objPtr)) { objPtr = Tcl_NewByteArrayObj(NULL, numBytes); } | | | 4292 4293 4294 4295 4296 4297 4298 4299 4300 4301 4302 4303 4304 4305 4306 | if (TclIsPureByteArray(objPtr)) { Tcl_Size numBytes; unsigned char *from = Tcl_GetByteArrayFromObj(objPtr, &numBytes); if (!inPlace || Tcl_IsShared(objPtr)) { objPtr = Tcl_NewByteArrayObj(NULL, numBytes); } ReverseBytes(Tcl_GetByteArrayFromObj(objPtr, NULL), from, numBytes); return objPtr; } SetStringFromAny(NULL, objPtr); stringPtr = GET_UNICHAR_STRING(objPtr); if (stringPtr->hasUnicode) { |
︙ | ︙ |
Changes to generic/tclStubInit.c.
︙ | ︙ | |||
95 96 97 98 99 100 101 | #if TCL_UTF_MAX > 3 && defined(TCL_NO_DEPRECATED) static void uniCodePanic(void) { Tcl_Panic("Tcl is compiled without the the UTF16 compatibility layer (-DTCL_NO_DEPRECATED)"); } # define Tcl_GetUnicode (unsigned short *(*)(Tcl_Obj *))(void *)uniCodePanic # define Tcl_GetUnicodeFromObj (unsigned short *(*)(Tcl_Obj *, int *))(void *)uniCodePanic | < | 95 96 97 98 99 100 101 102 103 104 105 106 107 108 | #if TCL_UTF_MAX > 3 && defined(TCL_NO_DEPRECATED) static void uniCodePanic(void) { Tcl_Panic("Tcl is compiled without the the UTF16 compatibility layer (-DTCL_NO_DEPRECATED)"); } # define Tcl_GetUnicode (unsigned short *(*)(Tcl_Obj *))(void *)uniCodePanic # define Tcl_GetUnicodeFromObj (unsigned short *(*)(Tcl_Obj *, int *))(void *)uniCodePanic # define Tcl_NewUnicodeObj (Tcl_Obj *(*)(const unsigned short *, int))(void *)uniCodePanic # define Tcl_SetUnicodeObj (void(*)(Tcl_Obj *, const unsigned short *, int))(void *)uniCodePanic # define Tcl_AppendUnicodeToObj (void(*)(Tcl_Obj *, const unsigned short *, int))(void *)uniCodePanic # define Tcl_UtfAtIndex (const char *(*)(const char *, int))(void *)uniCodePanic # define Tcl_GetCharLength (int(*)(Tcl_Obj *))(void *)uniCodePanic # define Tcl_UniCharNcmp (int(*)(const unsigned short *, const unsigned short *, unsigned long))(void *)uniCodePanic # define Tcl_UniCharNcasecmp (int(*)(const unsigned short *, const unsigned short *, unsigned long))(void *)uniCodePanic |
︙ | ︙ | |||
135 136 137 138 139 140 141 | if ((src >= start + 3) && ((src[-1] & 0xC0) == 0x80) && ((src[-2] & 0xC0) == 0x80) && ((src[-3] & 0xC0) == 0x80)) { return src - 3; } return Tcl_UtfPrev(src, start); } | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | 134 135 136 137 138 139 140 141 142 143 144 145 146 147 | if ((src >= start + 3) && ((src[-1] & 0xC0) == 0x80) && ((src[-2] & 0xC0) == 0x80) && ((src[-3] & 0xC0) == 0x80)) { return src - 3; } return Tcl_UtfPrev(src, start); } #define TclBN_mp_add mp_add #define TclBN_mp_and mp_and #define TclBN_mp_clamp mp_clamp #define TclBN_mp_clear mp_clear #define TclBN_mp_clear_multi mp_clear_multi #define TclBN_mp_cmp mp_cmp #define TclBN_mp_cmp_mag mp_cmp_mag |
︙ | ︙ | |||
909 910 911 912 913 914 915 | 0, /* 36 */ TclGetLoadedPackages, /* 37 */ TclGetNamespaceForQualName, /* 38 */ TclGetObjInterpProc, /* 39 */ TclGetOpenMode, /* 40 */ TclGetOriginalCommand, /* 41 */ TclpGetUserHome, /* 42 */ | | | 843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 | 0, /* 36 */ TclGetLoadedPackages, /* 37 */ TclGetNamespaceForQualName, /* 38 */ TclGetObjInterpProc, /* 39 */ TclGetOpenMode, /* 40 */ TclGetOriginalCommand, /* 41 */ TclpGetUserHome, /* 42 */ 0, /* 43 */ TclGuessPackageName, /* 44 */ TclHideUnsafeCommands, /* 45 */ TclInExit, /* 46 */ 0, /* 47 */ 0, /* 48 */ 0, /* 49 */ TclInitCompiledLocals, /* 50 */ |
︙ | ︙ | |||
2018 2019 2020 2021 2022 2023 2024 | Tcl_DecrRefCount, /* 642 */ Tcl_IsShared, /* 643 */ Tcl_LinkArray, /* 644 */ Tcl_GetIntForIndex, /* 645 */ Tcl_UtfToUniChar, /* 646 */ Tcl_UniCharToUtfDString, /* 647 */ Tcl_UtfToUniCharDString, /* 648 */ | | | | | | | | | | | | | | | | | | 1952 1953 1954 1955 1956 1957 1958 1959 1960 1961 1962 1963 1964 1965 1966 1967 1968 1969 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 1982 1983 1984 1985 1986 1987 1988 1989 1990 1991 1992 1993 1994 1995 1996 1997 1998 1999 2000 2001 | Tcl_DecrRefCount, /* 642 */ Tcl_IsShared, /* 643 */ Tcl_LinkArray, /* 644 */ Tcl_GetIntForIndex, /* 645 */ Tcl_UtfToUniChar, /* 646 */ Tcl_UniCharToUtfDString, /* 647 */ Tcl_UtfToUniCharDString, /* 648 */ Tcl_GetBytesFromObj, /* 649 */ 0, /* 650 */ 0, /* 651 */ 0, /* 652 */ 0, /* 653 */ Tcl_UtfCharComplete, /* 654 */ Tcl_UtfNext, /* 655 */ Tcl_UtfPrev, /* 656 */ Tcl_UniCharIsUnicode, /* 657 */ Tcl_ExternalToUtfDStringEx, /* 658 */ Tcl_UtfToExternalDStringEx, /* 659 */ Tcl_AsyncMarkFromSignal, /* 660 */ 0, /* 661 */ 0, /* 662 */ 0, /* 663 */ 0, /* 664 */ 0, /* 665 */ 0, /* 666 */ 0, /* 667 */ Tcl_UniCharLen, /* 668 */ TclNumUtfChars, /* 669 */ TclGetCharLength, /* 670 */ TclUtfAtIndex, /* 671 */ TclGetRange, /* 672 */ TclGetUniChar, /* 673 */ Tcl_GetBool, /* 674 */ Tcl_GetBoolFromObj, /* 675 */ 0, /* 676 */ 0, /* 677 */ 0, /* 678 */ 0, /* 679 */ Tcl_GetNumberFromObj, /* 680 */ Tcl_GetNumber, /* 681 */ Tcl_RemoveChannelMode, /* 682 */ Tcl_GetEncodingNulLength, /* 683 */ Tcl_GetWideUIntFromObj, /* 684 */ Tcl_DStringToObj, /* 685 */ 0, /* 686 */ 0, /* 687 */ TclUnusedStubEntry, /* 688 */ }; /* !END!: Do not edit above this line. */ |
Changes to generic/tclTest.c.
︙ | ︙ | |||
232 233 234 235 236 237 238 | static void ExitProcEven(void *clientData); static void ExitProcOdd(void *clientData); static Tcl_ObjCmdProc GetTimesObjCmd; static Tcl_ResolveCompiledVarProc InterpCompiledVarResolver; static void MainLoop(void); static Tcl_CmdProc NoopCmd; static Tcl_ObjCmdProc NoopObjCmd; | | | 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 | static void ExitProcEven(void *clientData); static void ExitProcOdd(void *clientData); static Tcl_ObjCmdProc GetTimesObjCmd; static Tcl_ResolveCompiledVarProc InterpCompiledVarResolver; static void MainLoop(void); static Tcl_CmdProc NoopCmd; static Tcl_ObjCmdProc NoopObjCmd; static Tcl_CmdObjTraceProc2 ObjTraceProc; static void ObjTraceDeleteProc(void *clientData); static void PrintParse(Tcl_Interp *interp, Tcl_Parse *parsePtr); static void SpecialFree(char *blockPtr); static int StaticInitProc(Tcl_Interp *interp); static Tcl_CmdProc TestasyncCmd; static Tcl_ObjCmdProc TestbumpinterpepochObjCmd; static Tcl_ObjCmdProc TestbytestringObjCmd; |
︙ | ︙ | |||
308 309 310 311 312 313 314 | static Tcl_CmdProc Testset2Cmd; static Tcl_CmdProc TestseterrorcodeCmd; static Tcl_ObjCmdProc TestsetobjerrorcodeCmd; static Tcl_CmdProc TestsetplatformCmd; static Tcl_CmdProc TeststaticlibraryCmd; static Tcl_CmdProc TesttranslatefilenameCmd; static Tcl_CmdProc TestupvarCmd; | | | 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 | static Tcl_CmdProc Testset2Cmd; static Tcl_CmdProc TestseterrorcodeCmd; static Tcl_ObjCmdProc TestsetobjerrorcodeCmd; static Tcl_CmdProc TestsetplatformCmd; static Tcl_CmdProc TeststaticlibraryCmd; static Tcl_CmdProc TesttranslatefilenameCmd; static Tcl_CmdProc TestupvarCmd; static Tcl_ObjCmdProc2 TestWrongNumArgsObjCmd; static Tcl_ObjCmdProc TestGetIndexFromObjStructObjCmd; static Tcl_CmdProc TestChannelCmd; static Tcl_CmdProc TestChannelEventCmd; static Tcl_CmdProc TestSocketCmd; static Tcl_ObjCmdProc TestFilesystemObjCmd; static Tcl_ObjCmdProc TestSimpleFilesystemObjCmd; static void TestReport(const char *cmd, Tcl_Obj *arg1, |
︙ | ︙ | |||
593 594 595 596 597 598 599 | Tcl_CreateCommand(interp, "noop", NoopCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "noop", NoopObjCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testpurebytesobj", TestpurebytesobjObjCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testsetbytearraylength", TestsetbytearraylengthObjCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testbytestring", TestbytestringObjCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "teststringbytes", TeststringbytesObjCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testutf16string", Testutf16stringObjCmd, NULL, NULL); | | | 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 | Tcl_CreateCommand(interp, "noop", NoopCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "noop", NoopObjCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testpurebytesobj", TestpurebytesobjObjCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testsetbytearraylength", TestsetbytearraylengthObjCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testbytestring", TestbytestringObjCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "teststringbytes", TeststringbytesObjCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testutf16string", Testutf16stringObjCmd, NULL, NULL); Tcl_CreateObjCommand2(interp, "testwrongnumargs", TestWrongNumArgsObjCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testfilesystem", TestFilesystemObjCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testsimplefilesystem", TestSimpleFilesystemObjCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testgetindexfromobjstruct", TestGetIndexFromObjStructObjCmd, NULL, NULL); |
︙ | ︙ | |||
1421 1422 1423 1424 1425 1426 1427 | /* Create an object-based trace, then eval a script. This is used * to test return codes other than TCL_OK from the trace engine. */ static int deleteCalled; deleteCalled = 0; | | | 1421 1422 1423 1424 1425 1426 1427 1428 1429 1430 1431 1432 1433 1434 1435 | /* Create an object-based trace, then eval a script. This is used * to test return codes other than TCL_OK from the trace engine. */ static int deleteCalled; deleteCalled = 0; cmdTrace = Tcl_CreateObjTrace2(interp, 50000, TCL_ALLOW_INLINE_COMPILATION, ObjTraceProc, &deleteCalled, ObjTraceDeleteProc); result = Tcl_EvalEx(interp, argv[2], TCL_INDEX_NONE, 0); Tcl_DeleteTrace(interp, cmdTrace); if (!deleteCalled) { Tcl_AppendResult(interp, "Delete wasn't called", NULL); return TCL_ERROR; |
︙ | ︙ | |||
1504 1505 1506 1507 1508 1509 1510 | Tcl_DeleteTrace(interp, cmdTrace); } static int ObjTraceProc( TCL_UNUSED(void *), Tcl_Interp *interp, /* Tcl interpreter */ | | | | 1504 1505 1506 1507 1508 1509 1510 1511 1512 1513 1514 1515 1516 1517 1518 1519 1520 1521 | Tcl_DeleteTrace(interp, cmdTrace); } static int ObjTraceProc( TCL_UNUSED(void *), Tcl_Interp *interp, /* Tcl interpreter */ TCL_UNUSED(Tcl_Size) /* level */, const char *command, TCL_UNUSED(Tcl_Command), TCL_UNUSED(Tcl_Size) /*objc*/, Tcl_Obj *const objv[]) /* Argument objects. */ { const char *word = Tcl_GetString(objv[0]); if (!strcmp(word, "Error")) { Tcl_SetObjResult(interp, Tcl_NewStringObj(command, -1)); return TCL_ERROR; |
︙ | ︙ | |||
2021 2022 2023 2024 2025 2026 2027 | * The procedure below is used as a special freeProc to test how well * Tcl_DStringGetResult handles freeProc's other than free. */ static void SpecialFree( char *blockPtr /* Block to free. */ ) { | | | 2021 2022 2023 2024 2025 2026 2027 2028 2029 2030 2031 2032 2033 2034 2035 | * The procedure below is used as a special freeProc to test how well * Tcl_DStringGetResult handles freeProc's other than free. */ static void SpecialFree( char *blockPtr /* Block to free. */ ) { ckfree((char *)blockPtr - 16); } /* *------------------------------------------------------------------------ * * UtfTransformFn -- * |
︙ | ︙ | |||
4589 4590 4591 4592 4593 4594 4595 | Tcl_RegExpGetInfo(regExpr, &info); for (i = 0; i < objc; i++) { Tcl_Size start, end; Tcl_Obj *newPtr, *varPtr, *valuePtr; varPtr = objv[i]; | | | 4589 4590 4591 4592 4593 4594 4595 4596 4597 4598 4599 4600 4601 4602 4603 | Tcl_RegExpGetInfo(regExpr, &info); for (i = 0; i < objc; i++) { Tcl_Size start, end; Tcl_Obj *newPtr, *varPtr, *valuePtr; varPtr = objv[i]; ii = ((cflags®_EXPECT) && i == objc-1) ? TCL_INDEX_NONE : (Tcl_Size)i; if (indices) { Tcl_Obj *objs[2]; if (ii == TCL_INDEX_NONE) { TclRegExpRangeUniChar(regExpr, ii, &start, &end); } else if (ii > info.nsubs) { start = TCL_INDEX_NONE; |
︙ | ︙ | |||
7919 7920 7921 7922 7923 7924 7925 | Tcl_AppendToObj(Tcl_GetObjResult(interp)," creation problem", -1); Tcl_DeleteHashTable(&hash); return TCL_ERROR; } Tcl_SetHashValue(hPtr, INT2PTR(i+42)); } | | | 7919 7920 7921 7922 7923 7924 7925 7926 7927 7928 7929 7930 7931 7932 7933 | Tcl_AppendToObj(Tcl_GetObjResult(interp)," creation problem", -1); Tcl_DeleteHashTable(&hash); return TCL_ERROR; } Tcl_SetHashValue(hPtr, INT2PTR(i+42)); } if (hash.numEntries != (Tcl_Size)limit) { Tcl_AppendResult(interp, "unexpected maximal size", NULL); Tcl_DeleteHashTable(&hash); return TCL_ERROR; } for (i=0 ; i<limit ; i++) { hPtr = Tcl_FindHashEntry(&hash, (char *) INT2PTR(i)); |
︙ | ︙ |
Changes to generic/tclTestObj.c.
︙ | ︙ | |||
980 981 982 983 984 985 986 987 988 989 990 991 992 993 | } if (objP->refCount <= 0) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "Tcl_ListObjIndex returned object with ref count <= 0", TCL_INDEX_NONE)); /* Keep looping since we are also looping for leaks */ } } break; case LISTOBJ_GETELEMENTSMEMCHECK: if (objc != 3) { Tcl_WrongNumArgs(interp, 2, objv, "varIndex"); return TCL_ERROR; | > | 980 981 982 983 984 985 986 987 988 989 990 991 992 993 994 | } if (objP->refCount <= 0) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "Tcl_ListObjIndex returned object with ref count <= 0", TCL_INDEX_NONE)); /* Keep looping since we are also looping for leaks */ } Tcl_DecrRefCount(objP); } break; case LISTOBJ_GETELEMENTSMEMCHECK: if (objc != 3) { Tcl_WrongNumArgs(interp, 2, objv, "varIndex"); return TCL_ERROR; |
︙ | ︙ |
Changes to generic/tclTrace.c.
︙ | ︙ | |||
2133 2134 2135 2136 2137 2138 2139 | * * When the trace is deleted, the 'delProc' function will be invoked, * passing it the original client data. * *---------------------------------------------------------------------- */ | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | 2133 2134 2135 2136 2137 2138 2139 2140 2141 2142 2143 2144 2145 2146 | * * When the trace is deleted, the 'delProc' function will be invoked, * passing it the original client data. * *---------------------------------------------------------------------- */ Tcl_Trace Tcl_CreateObjTrace( Tcl_Interp *interp, /* Tcl interpreter */ Tcl_Size level, /* Maximum nesting level */ int flags, /* Flags, see above */ Tcl_CmdObjTraceProc *proc, /* Trace callback */ void *clientData, /* Client data for the callback */ |
︙ | ︙ |
Changes to generic/tclZipfs.c.
︙ | ︙ | |||
2309 2310 2311 2312 2313 2314 2315 | if (objc < 3) { ReadLock(); DescribeMounted(interp, mountPoint); Unlock(); return TCL_OK; } | | | 2309 2310 2311 2312 2313 2314 2315 2316 2317 2318 2319 2320 2321 2322 2323 | if (objc < 3) { ReadLock(); DescribeMounted(interp, mountPoint); Unlock(); return TCL_OK; } data = Tcl_GetBytesFromObj(interp, objv[2], &length); if (data == NULL) { return TCL_ERROR; } return TclZipfs_MountBuffer(interp, mountPoint, data, length, 1); } /* |
︙ | ︙ |
Changes to generic/tclZlib.c.
︙ | ︙ | |||
1179 1180 1181 1182 1183 1184 1185 | void Tcl_ZlibStreamSetCompressionDictionary( Tcl_ZlibStream zshandle, Tcl_Obj *compressionDictionaryObj) { ZlibStreamHandle *zshPtr = (ZlibStreamHandle *) zshandle; | | | | 1179 1180 1181 1182 1183 1184 1185 1186 1187 1188 1189 1190 1191 1192 1193 1194 | void Tcl_ZlibStreamSetCompressionDictionary( Tcl_ZlibStream zshandle, Tcl_Obj *compressionDictionaryObj) { ZlibStreamHandle *zshPtr = (ZlibStreamHandle *) zshandle; if (compressionDictionaryObj && (NULL == Tcl_GetBytesFromObj(NULL, compressionDictionaryObj, NULL))) { /* Missing or invalid compression dictionary */ compressionDictionaryObj = NULL; } if (compressionDictionaryObj != NULL) { if (Tcl_IsShared(compressionDictionaryObj)) { compressionDictionaryObj = Tcl_DuplicateObj(compressionDictionaryObj); |
︙ | ︙ | |||
1235 1236 1237 1238 1239 1240 1241 | Tcl_SetObjResult(zshPtr->interp, Tcl_NewStringObj( "already past compressed stream end", -1)); Tcl_SetErrorCode(zshPtr->interp, "TCL", "ZIP", "CLOSED", NULL); } return TCL_ERROR; } | | | 1235 1236 1237 1238 1239 1240 1241 1242 1243 1244 1245 1246 1247 1248 1249 | Tcl_SetObjResult(zshPtr->interp, Tcl_NewStringObj( "already past compressed stream end", -1)); Tcl_SetErrorCode(zshPtr->interp, "TCL", "ZIP", "CLOSED", NULL); } return TCL_ERROR; } bytes = Tcl_GetBytesFromObj(zshPtr->interp, data, &size); if (bytes == NULL) { return TCL_ERROR; } if (zshPtr->mode == TCL_ZLIB_STREAM_DEFLATE) { zshPtr->stream.next_in = bytes; zshPtr->stream.avail_in = size; |
︙ | ︙ | |||
1366 1367 1368 1369 1370 1371 1372 | * Getting beyond the of stream, just return empty string. */ if (zshPtr->streamEnd) { return TCL_OK; } | | | 1366 1367 1368 1369 1370 1371 1372 1373 1374 1375 1376 1377 1378 1379 1380 | * Getting beyond the of stream, just return empty string. */ if (zshPtr->streamEnd) { return TCL_OK; } if (NULL == Tcl_GetBytesFromObj(zshPtr->interp, data, &existing)) { return TCL_ERROR; } if (zshPtr->mode == TCL_ZLIB_STREAM_INFLATE) { if (count == -1) { /* * The only safe thing to do is restict to 65k. We might cause a |
︙ | ︙ | |||
1621 1622 1623 1624 1625 1626 1627 | } /* * Obtain the pointer to the byte array, we'll pass this pointer straight * to the deflate command. */ | | | 1621 1622 1623 1624 1625 1626 1627 1628 1629 1630 1631 1632 1633 1634 1635 | } /* * Obtain the pointer to the byte array, we'll pass this pointer straight * to the deflate command. */ inData = Tcl_GetBytesFromObj(interp, data, &inLen); if (inData == NULL) { return TCL_ERROR; } /* * Compressed format is specified by the wbits parameter. See zlib.h for * details. |
︙ | ︙ | |||
1771 1772 1773 1774 1775 1776 1777 | Tcl_Obj *obj; char *nameBuf = NULL, *commentBuf = NULL; if (!interp) { return TCL_ERROR; } | | | 1771 1772 1773 1774 1775 1776 1777 1778 1779 1780 1781 1782 1783 1784 1785 | Tcl_Obj *obj; char *nameBuf = NULL, *commentBuf = NULL; if (!interp) { return TCL_ERROR; } inData = Tcl_GetBytesFromObj(interp, data, &inLen); if (inData == NULL) { return TCL_ERROR; } /* * Compressed format is specified by the wbits parameter. See zlib.h for * details. |
︙ | ︙ | |||
2008 2009 2010 2011 2012 2013 2014 | switch ((enum zlibCommands) command) { case CMD_ADLER: /* adler32 str ?startvalue? * -> checksum */ if (objc < 3 || objc > 4) { Tcl_WrongNumArgs(interp, 2, objv, "data ?startValue?"); return TCL_ERROR; } | | | | 2008 2009 2010 2011 2012 2013 2014 2015 2016 2017 2018 2019 2020 2021 2022 2023 2024 2025 2026 2027 2028 2029 2030 2031 2032 2033 2034 2035 2036 2037 2038 2039 2040 2041 2042 | switch ((enum zlibCommands) command) { case CMD_ADLER: /* adler32 str ?startvalue? * -> checksum */ if (objc < 3 || objc > 4) { Tcl_WrongNumArgs(interp, 2, objv, "data ?startValue?"); return TCL_ERROR; } data = Tcl_GetBytesFromObj(interp, objv[2], &dlen); if (data == NULL) { return TCL_ERROR; } if (objc>3 && Tcl_GetIntFromObj(interp, objv[3], (int *) &start) != TCL_OK) { return TCL_ERROR; } if (objc < 4) { start = Tcl_ZlibAdler32(0, NULL, 0); } Tcl_SetObjResult(interp, Tcl_NewWideIntObj((Tcl_WideInt) (uLong) Tcl_ZlibAdler32(start, data, dlen))); return TCL_OK; case CMD_CRC: /* crc32 str ?startvalue? * -> checksum */ if (objc < 3 || objc > 4) { Tcl_WrongNumArgs(interp, 2, objv, "data ?startValue?"); return TCL_ERROR; } data = Tcl_GetBytesFromObj(interp, objv[2], &dlen); if (data == NULL) { return TCL_ERROR; } if (objc>3 && Tcl_GetIntFromObj(interp, objv[3], (int *) &start) != TCL_OK) { return TCL_ERROR; } |
︙ | ︙ | |||
2372 2373 2374 2375 2376 2377 2378 | Tcl_SetObjResult(interp, Tcl_NewStringObj("level must be 0 to 9",-1)); Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMPRESSIONLEVEL", NULL); Tcl_AddErrorInfo(interp, "\n (in -level option)"); return TCL_ERROR; } if (compDictObj) { | | | 2372 2373 2374 2375 2376 2377 2378 2379 2380 2381 2382 2383 2384 2385 2386 | Tcl_SetObjResult(interp, Tcl_NewStringObj("level must be 0 to 9",-1)); Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMPRESSIONLEVEL", NULL); Tcl_AddErrorInfo(interp, "\n (in -level option)"); return TCL_ERROR; } if (compDictObj) { if (NULL == Tcl_GetBytesFromObj(interp, compDictObj, NULL)) { return TCL_ERROR; } } /* * Construct the stream now we know its configuration. */ |
︙ | ︙ | |||
2555 2556 2557 2558 2559 2560 2561 | goto genericOptionError; } compDictObj = objv[i]; break; } } | | | 2555 2556 2557 2558 2559 2560 2561 2562 2563 2564 2565 2566 2567 2568 2569 | goto genericOptionError; } compDictObj = objv[i]; break; } } if (compDictObj && (NULL == Tcl_GetBytesFromObj(interp, compDictObj, NULL))) { return TCL_ERROR; } if (ZlibStackChannelTransform(interp, mode, format, level, limit, chan, headerObj, compDictObj) == NULL) { return TCL_ERROR; } |
︙ | ︙ | |||
2804 2805 2806 2807 2808 2809 2810 | /* * Set the compression dictionary if requested. */ if (compDictObj != NULL) { int len; | | | 2804 2805 2806 2807 2808 2809 2810 2811 2812 2813 2814 2815 2816 2817 2818 | /* * Set the compression dictionary if requested. */ if (compDictObj != NULL) { int len; if (NULL == Tcl_GetBytesFromObj(interp, compDictObj, &len)) { return TCL_ERROR; } if (len == 0) { compDictObj = NULL; } Tcl_ZlibStreamSetCompressionDictionary(zstream, compDictObj); |
︙ | ︙ | |||
2911 2912 2913 2914 2915 2916 2917 | /* * Set the compression dictionary if requested. */ if (compDictObj != NULL) { int len; | | | 2911 2912 2913 2914 2915 2916 2917 2918 2919 2920 2921 2922 2923 2924 2925 | /* * Set the compression dictionary if requested. */ if (compDictObj != NULL) { int len; if (NULL == Tcl_GetBytesFromObj(interp, compDictObj, &len)) { return TCL_ERROR; } if (len == 0) { compDictObj = NULL; } Tcl_ZlibStreamSetCompressionDictionary(zstream, compDictObj); } |
︙ | ︙ | |||
3350 3351 3352 3353 3354 3355 3356 | if (optionName && (strcmp(optionName, "-dictionary") == 0) && (cd->format != TCL_ZLIB_FORMAT_GZIP)) { Tcl_Obj *compDictObj; int code; TclNewStringObj(compDictObj, value, strlen(value)); Tcl_IncrRefCount(compDictObj); | | | 3350 3351 3352 3353 3354 3355 3356 3357 3358 3359 3360 3361 3362 3363 3364 | if (optionName && (strcmp(optionName, "-dictionary") == 0) && (cd->format != TCL_ZLIB_FORMAT_GZIP)) { Tcl_Obj *compDictObj; int code; TclNewStringObj(compDictObj, value, strlen(value)); Tcl_IncrRefCount(compDictObj); if (NULL == Tcl_GetBytesFromObj(interp, compDictObj, NULL)) { Tcl_DecrRefCount(compDictObj); return TCL_ERROR; } if (cd->compDictObj) { TclDecrRefCount(cd->compDictObj); } cd->compDictObj = compDictObj; |
︙ | ︙ | |||
3741 3742 3743 3744 3745 3746 3747 | cd->inHeader.header.comm_max = MAX_COMMENT_LEN - 1; } } if (compDictObj != NULL) { cd->compDictObj = Tcl_DuplicateObj(compDictObj); Tcl_IncrRefCount(cd->compDictObj); | | | 3741 3742 3743 3744 3745 3746 3747 3748 3749 3750 3751 3752 3753 3754 3755 | cd->inHeader.header.comm_max = MAX_COMMENT_LEN - 1; } } if (compDictObj != NULL) { cd->compDictObj = Tcl_DuplicateObj(compDictObj); Tcl_IncrRefCount(cd->compDictObj); Tcl_GetByteArrayFromObj(cd->compDictObj, NULL); } if (format == TCL_ZLIB_FORMAT_RAW) { wbits = WBITS_RAW; } else if (format == TCL_ZLIB_FORMAT_ZLIB) { wbits = WBITS_ZLIB; } else if (format == TCL_ZLIB_FORMAT_GZIP) { |
︙ | ︙ |
Changes to tests/binary.test.
︙ | ︙ | |||
3011 3012 3013 3014 3015 3016 3017 | test binary-79.1 {Tcl_SetByteArrayLength} testsetbytearraylength { testsetbytearraylength [string cat A B C] 1 } A test binary-79.2 {Tcl_SetByteArrayLength} testsetbytearraylength { testsetbytearraylength [string cat Ł B C] 1 } A | | | | | | 3011 3012 3013 3014 3015 3016 3017 3018 3019 3020 3021 3022 3023 3024 3025 3026 3027 3028 3029 3030 3031 3032 3033 3034 | test binary-79.1 {Tcl_SetByteArrayLength} testsetbytearraylength { testsetbytearraylength [string cat A B C] 1 } A test binary-79.2 {Tcl_SetByteArrayLength} testsetbytearraylength { testsetbytearraylength [string cat Ł B C] 1 } A test binary-80.1 {Tcl_GetBytesFromObj} -constraints testbytestring -returnCodes 1 -body { testbytestring "乎" } -result "expected byte sequence but character 0 was '乎' (U+004E4E)" test binary-80.2 {Tcl_GetBytesFromObj} -constraints testbytestring -returnCodes 1 -body { testbytestring [testbytestring "\x00\xA0\xA0\xA0\xE4\xB9\x8E"] } -result "expected byte sequence but character 4 was '乎' (U+004E4E)" test binary-80.3 {Tcl_GetBytesFromObj} -constraints testbytestring -returnCodes 1 -body { testbytestring [testbytestring "\xC0\x80\xA0\xA0\xA0\xE4\xB9\x8E"] } -result "expected byte sequence but character 4 was '乎' (U+004E4E)" test binary-80.4 {Tcl_GetBytesFromObj} -constraints testbytestring -returnCodes 1 -body { testbytestring [testbytestring "\xC0\x80\xA0\xA0\xA0\xF0\x9F\x98\x81"] } -result "expected byte sequence but character 4 was '\U01F601' (U+01F601)" # ---------------------------------------------------------------------- # cleanup ::tcltest::cleanupTests |
︙ | ︙ |
Changes to unix/dltest/pkgooa.c.
︙ | ︙ | |||
90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 | #endif #ifdef Tcl_GetClassOfObject ,NULL #endif #ifdef Tcl_GetObjectClassName ,NULL #endif #ifdef Tcl_MethodIsType2 ,NULL #endif #ifdef Tcl_NewInstanceMethod2 ,NULL #endif #ifdef Tcl_NewMethod2 ,NULL #endif }; DLLEXPORT int Pkgooa_Init( Tcl_Interp *interp) /* Interpreter in which the package is to be * made available. */ | > > | 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 | #endif #ifdef Tcl_GetClassOfObject ,NULL #endif #ifdef Tcl_GetObjectClassName ,NULL #endif #if TCL_MAJOR_VERSION > 8 #ifdef Tcl_MethodIsType2 ,NULL #endif #ifdef Tcl_NewInstanceMethod2 ,NULL #endif #ifdef Tcl_NewMethod2 ,NULL #endif #endif }; DLLEXPORT int Pkgooa_Init( Tcl_Interp *interp) /* Interpreter in which the package is to be * made available. */ |
︙ | ︙ |
Changes to unix/dltest/pkgt.c.
︙ | ︙ | |||
12 13 14 15 16 17 18 | #undef STATIC_BUILD #include "tcl.h" static int TraceProc2 ( void *clientData, Tcl_Interp *interp, | | | | 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 | #undef STATIC_BUILD #include "tcl.h" static int TraceProc2 ( void *clientData, Tcl_Interp *interp, Tcl_Size level, const char *command, Tcl_Command commandInfo, Tcl_Size objc, struct Tcl_Obj *const *objv) { (void)clientData; (void)interp; (void)level; (void)command; (void)commandInfo; |
︙ | ︙ | |||
51 52 53 54 55 56 57 | *---------------------------------------------------------------------- */ static int Pkgt_EqObjCmd2( void *dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ | | | | 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 | *---------------------------------------------------------------------- */ static int Pkgt_EqObjCmd2( void *dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ Tcl_Size objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_WideInt result; const char *str1, *str2; Tcl_Size len1, len2; (void)dummy; if (objc != 3) { Tcl_WrongNumArgs(interp, 1, objv, "string1 string2"); return TCL_ERROR; } |
︙ | ︙ |