Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Changes In Branch tip-626 Excluding Merge-Ins
This is equivalent to a diff from eaa3effcb7 to e3617a764d
|
2025-12-12
| ||
| 12:09 | TIP #626 implementation: Command arguments > 2^31 elements check-in: 39b32d697e user: jan.nijtmans tags: trunk, main | |
| 08:36 | use more 'bool' internally check-in: 70d5d98cf8 user: jan.nijtmans tags: trunk, main | |
|
2025-12-11
| ||
| 17:15 | Use bool in various internal TclOO APIs. No change to public API. check-in: 91768dd3b8 user: dkf tags: oo-internal-bool | |
| 09:29 | merged from trunk check-in: 78018f50d5 user: cmacleod tags: cgm-equals-command | |
|
2025-12-10
| ||
| 06:51 | Merge trunk Closed-Leaf check-in: 5897187104 user: apnadkarni tags: tip-737 | |
|
2025-12-09
| ||
| 12:48 | Merge main check-in: 2fee836011 user: oehhar tags: tip-723-timer-wall-monotonic | |
| 12:31 | Rebase to trunk Closed-Leaf check-in: e3617a764d user: jan.nijtmans tags: tip-626 | |
| 12:29 | Testcase binary-17.4 only works on 64-bit machines. check-in: eaa3effcb7 user: jan.nijtmans tags: trunk, main | |
|
2025-12-08
| ||
| 21:49 | Merge trunk check-in: dae372fabe user: jan.nijtmans tags: tip-626 | |
| 21:37 | Use more Tcl_Size in 'binary format'. Add testcase (thanks, Ashok\!) check-in: bacb941b12 user: jan.nijtmans tags: trunk, main | |
Changes to changes.md.
| ︙ | ︙ | |||
23 24 25 26 27 28 29 30 31 32 33 | - [Tcl\_ListObjRange, Tcl\_ListObjRepeat, Tcl\_TclListObjReverse - C API for new list operations](https://core.tcl-lang.org/tips/doc/trunk/tip/649.md) - [Tcl\_UtfToNormalized, Tcl\_UtfToNormalizedDString - C API for Unicode normalization](https://core.tcl-lang.org/tips/doc/trunk/tip/726.md) # Performance - [Memory efficient internal representations](https://core.tcl-lang.org/tcl/wiki?name=New+abstract+list+representations) for list operations on large lists. # Bug fixes - [tclEpollNotfy PlatformEventsControl panics if websocket disconnected](https://core.tcl-lang.org/tcl/tktview/010d8f38) | > | 23 24 25 26 27 28 29 30 31 32 33 34 | - [Tcl\_ListObjRange, Tcl\_ListObjRepeat, Tcl\_TclListObjReverse - C API for new list operations](https://core.tcl-lang.org/tips/doc/trunk/tip/649.md) - [Tcl\_UtfToNormalized, Tcl\_UtfToNormalizedDString - C API for Unicode normalization](https://core.tcl-lang.org/tips/doc/trunk/tip/726.md) # Performance - [Memory efficient internal representations](https://core.tcl-lang.org/tcl/wiki?name=New+abstract+list+representations) for list operations on large lists. - [Continued 64-bit capacity: Command line arguments larger than 2Gb](https://core.tcl-lang.org/tips/doc/trunk/tip/626.md) # Bug fixes - [tclEpollNotfy PlatformEventsControl panics if websocket disconnected](https://core.tcl-lang.org/tcl/tktview/010d8f38) |
Changes to doc/NRE.3.
| ︙ | ︙ | |||
158 159 160 161 162 163 164 |
stack, to evaluate a script:
.PP
.CS
int
\fITheCmdOldObjProc\fR(
void *clientData,
Tcl_Interp *interp,
| | | | | | | 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 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 210 211 212 213 214 215 216 |
stack, to evaluate a script:
.PP
.CS
int
\fITheCmdOldObjProc\fR(
void *clientData,
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const objv[])
{
int result;
Tcl_Obj *objPtr;
\fI... preparation ...\fR
result = \fBTcl_EvalObjEx\fR(interp, objPtr, 0);
\fI... postprocessing ...\fR
return result;
}
\fBTcl_CreateObjCommand2\fR(interp, "theCommand",
\fITheCmdOldObjProc\fR, clientData, TheCmdDeleteProc);
.CE
.PP
To avoid consuming space on the C stack, \fITheCmdOldObjProc\fR is renamed to
\fITheCmdNRObjProc\fR and the postprocessing step is split into a separate
function, \fITheCmdPostProc\fR, which is pushed onto the function stack.
\fITcl_EvalObjEx\fR is replaced with \fITcl_NREvalObj\fR, which uses a
trampoline instead of consuming space on the C stack. A new version of
\fITheCmdOldObjProc\fR is just a a wrapper that uses \fBTcl_NRCallObjProc\fR to
call \fITheCmdNRObjProc\fR:
.PP
.CS
int
\fITheCmdOldObjProc\fR(
void *clientData,
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const objv[])
{
return \fBTcl_NRCallObjProc2\fR(interp, \fITheCmdNRObjProc\fR,
clientData, objc, objv);
}
.CE
.PP
.CS
int
\fITheCmdNRObjProc\fR
void *clientData,
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const objv[])
{
Tcl_Obj *objPtr;
\fI... preparation ...\fR
\fBTcl_NRAddCallback\fR(interp, \fITheCmdPostProc\fR,
|
| ︙ | ︙ |
Changes to doc/load.n.
| ︙ | ︙ | |||
146 147 148 149 150 151 152 | .PP The following is a minimal extension: .PP .CS #include <tcl.h> #include <stdio.h> static int fooCmd(void *clientData, | | | | 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 |
.PP
The following is a minimal extension:
.PP
.CS
#include <tcl.h>
#include <stdio.h>
static int fooCmd(void *clientData,
Tcl_Interp *interp, Tcl_Size objc, Tcl_Obj *const objv[]) {
printf("called with %d arguments\en", objc);
return TCL_OK;
}
int Foo_Init(Tcl_Interp *interp) {
if (Tcl_InitStubs(interp, "8.1", 0) == NULL) {
return TCL_ERROR;
}
printf("creating foo command");
Tcl_CreateObjCommand2(interp, "foo", fooCmd, NULL, NULL);
return TCL_OK;
}
.CE
.PP
When built into a shared/dynamic library with a suitable name
(e.g. \fBfoo.dll\fR on Windows, \fBlibfoo.so\fR on Solaris and Linux)
it can then be loaded into Tcl with the following:
|
| ︙ | ︙ |
Changes to generic/tcl.h.
| ︙ | ︙ | |||
531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 | typedef int (Tcl_AsyncProc) (void *clientData, Tcl_Interp *interp, int code); typedef void (Tcl_ChannelProc) (void *clientData, int mask); typedef void (Tcl_CloseProc) (void *data); typedef void (Tcl_CmdDeleteProc) (void *clientData); typedef int (Tcl_CmdProc) (void *clientData, Tcl_Interp *interp, 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); 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); typedef int (Tcl_EventProc) (Tcl_Event *evPtr, int flags); typedef void (Tcl_EventCheckProc) (void *clientData, int flags); typedef int (Tcl_EventDeleteProc) (Tcl_Event *evPtr, void *clientData); typedef void (Tcl_EventSetupProc) (void *clientData, int flags); typedef void (Tcl_ExitProc) (void *clientData); typedef void (Tcl_FileProc) (void *clientData, int mask); typedef void (Tcl_FileFreeProc) (void *clientData); typedef void (Tcl_FreeInternalRepProc) (struct Tcl_Obj *objPtr); typedef void (Tcl_IdleProc) (void *clientData); typedef void (Tcl_InterpDeleteProc) (void *clientData, Tcl_Interp *interp); typedef void (Tcl_NamespaceDeleteProc) (void *clientData); typedef int (Tcl_ObjCmdProc) (void *clientData, Tcl_Interp *interp, int objc, struct Tcl_Obj *const *objv); typedef int (Tcl_ObjCmdProc2) (void *clientData, Tcl_Interp *interp, Tcl_Size objc, struct Tcl_Obj *const *objv); typedef int (Tcl_CmdObjTraceProc2) (void *clientData, Tcl_Interp *interp, Tcl_Size level, const char *command, Tcl_Command commandInfo, Tcl_Size objc, struct Tcl_Obj *const *objv); typedef void (Tcl_FreeProc) (void *blockPtr); #define Tcl_ExitProc Tcl_FreeProc | > > > > | 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 | typedef int (Tcl_AsyncProc) (void *clientData, Tcl_Interp *interp, int code); typedef void (Tcl_ChannelProc) (void *clientData, int mask); typedef void (Tcl_CloseProc) (void *data); typedef void (Tcl_CmdDeleteProc) (void *clientData); typedef int (Tcl_CmdProc) (void *clientData, Tcl_Interp *interp, int argc, const char *argv[]); #ifndef TCL_NO_DEPRECATED 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); #endif /* TCL_NO_DEPRECATED */ 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); typedef int (Tcl_EventProc) (Tcl_Event *evPtr, int flags); typedef void (Tcl_EventCheckProc) (void *clientData, int flags); typedef int (Tcl_EventDeleteProc) (Tcl_Event *evPtr, void *clientData); typedef void (Tcl_EventSetupProc) (void *clientData, int flags); typedef void (Tcl_ExitProc) (void *clientData); typedef void (Tcl_FileProc) (void *clientData, int mask); typedef void (Tcl_FileFreeProc) (void *clientData); typedef void (Tcl_FreeInternalRepProc) (struct Tcl_Obj *objPtr); typedef void (Tcl_IdleProc) (void *clientData); typedef void (Tcl_InterpDeleteProc) (void *clientData, Tcl_Interp *interp); typedef void (Tcl_NamespaceDeleteProc) (void *clientData); #ifndef TCL_NO_DEPRECATED typedef int (Tcl_ObjCmdProc) (void *clientData, Tcl_Interp *interp, int objc, struct Tcl_Obj *const *objv); #endif /* TCL_NO_DEPRECATED */ typedef int (Tcl_ObjCmdProc2) (void *clientData, Tcl_Interp *interp, Tcl_Size objc, struct Tcl_Obj *const *objv); typedef int (Tcl_CmdObjTraceProc2) (void *clientData, Tcl_Interp *interp, Tcl_Size level, const char *command, Tcl_Command commandInfo, Tcl_Size objc, struct Tcl_Obj *const *objv); typedef void (Tcl_FreeProc) (void *blockPtr); #define Tcl_ExitProc Tcl_FreeProc |
| ︙ | ︙ | |||
809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 |
*/
typedef struct {
int isNativeObjectProc; /* 1 if objProc was registered by a call to
* Tcl_CreateObjCommand; 2 if objProc was registered by
* a call to Tcl_CreateObjCommand2; 0 otherwise.
* Tcl_SetCmdInfo does not modify this field. */
Tcl_ObjCmdProc *objProc; /* Command's object-based function. */
void *objClientData; /* ClientData for object proc. */
Tcl_CmdProc *proc; /* Command's string-based function. */
void *clientData; /* ClientData for string proc. */
Tcl_CmdDeleteProc *deleteProc;
/* Function to call when command is
* deleted. */
void *deleteData; /* Value to pass to deleteProc (usually the
* same as clientData). */
| > > > > > | 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 |
*/
typedef struct {
int isNativeObjectProc; /* 1 if objProc was registered by a call to
* Tcl_CreateObjCommand; 2 if objProc was registered by
* a call to Tcl_CreateObjCommand2; 0 otherwise.
* Tcl_SetCmdInfo does not modify this field. */
#ifdef TCL_NO_DEPRECATED
void *objProcNotUsed; /* Command's object-based function. */
void *objClientDataNotUsed; /* ClientData for object proc. */
#else
Tcl_ObjCmdProc *objProc; /* Command's object-based function. */
void *objClientData; /* ClientData for object proc. */
#endif
Tcl_CmdProc *proc; /* Command's string-based function. */
void *clientData; /* ClientData for string proc. */
Tcl_CmdDeleteProc *deleteProc;
/* Function to call when command is
* deleted. */
void *deleteData; /* Value to pass to deleteProc (usually the
* same as clientData). */
|
| ︙ | ︙ |
Changes to generic/tclAssembly.c.
| ︙ | ︙ | |||
60 61 62 63 64 65 66 |
*/
typedef struct BasicBlock {
int startOffset; /* Instruction offset of the start of the
* block */
int startLine; /* Line number in the input script of the
* instruction at the start of the block */
| | | 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 |
*/
typedef struct BasicBlock {
int startOffset; /* Instruction offset of the start of the
* block */
int startLine; /* Line number in the input script of the
* instruction at the start of the block */
Tcl_Size jumpOffset; /* Bytecode offset of the 'jump' instruction
* that ends the block, or -1 if there is no
* jump. */
int jumpLine; /* Line number in the input script of the
* 'jump' instruction that ends the block, or
* -1 if there is no jump */
struct BasicBlock* prevPtr; /* Immediate predecessor of this block */
struct BasicBlock* predecessor;
|
| ︙ | ︙ | |||
730 731 732 733 734 735 736 |
*-----------------------------------------------------------------------------
*/
int
Tcl_AssembleObjCmd(
void *clientData, /* clientData */
Tcl_Interp *interp, /* Current interpreter. */
| | | | | 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 |
*-----------------------------------------------------------------------------
*/
int
Tcl_AssembleObjCmd(
void *clientData, /* clientData */
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
/*
* Boilerplate - make sure that there is an NRE trampoline on the C stack
* because there needs to be one in place to execute bytecode.
*/
return Tcl_NRCallObjProc2(interp, TclNRAssembleObjCmd, clientData,
objc, objv);
}
int
TclNRAssembleObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
ByteCode *codePtr; /* Pointer to the bytecode to execute */
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "bytecodeList");
return TCL_ERROR;
|
| ︙ | ︙ |
Changes to generic/tclBasic.c.
| ︙ | ︙ | |||
162 163 164 165 166 167 168 |
iPtr->cmdFramePtr = (context).cmdFramePtr; \
iPtr->lineLABCPtr = (context).lineLABCPtr
/*
* Static functions in this file:
*/
| | | | | | | | | | | | | | | | | | | | | | | | | | | | 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 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 210 211 212 213 214 215 216 |
iPtr->cmdFramePtr = (context).cmdFramePtr; \
iPtr->lineLABCPtr = (context).lineLABCPtr
/*
* Static functions in this file:
*/
static Tcl_ObjCmdProc2 BadEnsembleSubcommand;
static Tcl_CmdDeleteProc BadEnsembleSubcommandCleanup;
static char * CallCommandTraces(Interp *iPtr, Command *cmdPtr,
const char *oldName, const char *newName,
int flags);
static int CancelEvalProc(void *clientData,
Tcl_Interp *interp, int code);
static int CheckDoubleResult(Tcl_Interp *interp, double dResult);
static void DeleteCoroutine(void *clientData);
static Tcl_FreeProc DeleteInterpProc;
static void DeleteOpCmdClientData(void *clientData);
#ifdef USE_DTRACE
static Tcl_ObjCmdProc2 DTraceObjCmd;
static Tcl_NRPostProc DTraceCmdReturn;
#else
# define DTraceCmdReturn NULL
#endif /* USE_DTRACE */
static Tcl_ObjCmdProc2 InvokeStringCommand;
static Tcl_ObjCmdProc2 ExprAbsFunc;
static Tcl_ObjCmdProc2 ExprBinaryFunc;
static Tcl_ObjCmdProc2 ExprBoolFunc;
static Tcl_ObjCmdProc2 ExprCeilFunc;
static Tcl_ObjCmdProc2 ExprDoubleFunc;
static Tcl_ObjCmdProc2 ExprFloorFunc;
static Tcl_ObjCmdProc2 ExprIntFunc;
static Tcl_ObjCmdProc2 ExprIsqrtFunc;
static Tcl_ObjCmdProc2 ExprIsFiniteFunc;
static Tcl_ObjCmdProc2 ExprIsInfinityFunc;
static Tcl_ObjCmdProc2 ExprIsNaNFunc;
static Tcl_ObjCmdProc2 ExprIsNormalFunc;
static Tcl_ObjCmdProc2 ExprIsSubnormalFunc;
static Tcl_ObjCmdProc2 ExprIsUnorderedFunc;
static Tcl_ObjCmdProc2 ExprMaxFunc;
static Tcl_ObjCmdProc2 ExprMinFunc;
static Tcl_ObjCmdProc2 ExprRandFunc;
static Tcl_ObjCmdProc2 ExprRoundFunc;
static Tcl_ObjCmdProc2 ExprSqrtFunc;
static Tcl_ObjCmdProc2 ExprSrandFunc;
static Tcl_ObjCmdProc2 ExprUnaryFunc;
static Tcl_ObjCmdProc2 ExprWideFunc;
static Tcl_ObjCmdProc2 FloatClassifyObjCmd;
static void MathFuncWrongNumArgs(Tcl_Interp *interp, Tcl_Size expected,
Tcl_Size actual, Tcl_Obj *const *objv);
static Tcl_NRPostProc NRCoroutineCallerCallback;
static Tcl_NRPostProc NRCoroutineExitCallback;
static Tcl_NRPostProc NRCommand;
static void ProcessUnexpectedResult(Tcl_Interp *interp,
|
| ︙ | ︙ | |||
233 234 235 236 237 238 239 | static Tcl_NRPostProc TEOV_Exception; static Tcl_NRPostProc TEOV_NotFoundCallback; static Tcl_NRPostProc TEOV_RestoreVarFrame; static Tcl_NRPostProc TEOV_RunLeaveTraces; static Tcl_NRPostProc EvalObjvCore; static Tcl_NRPostProc Dispatch; | | | | | | | | | 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 |
static Tcl_NRPostProc TEOV_Exception;
static Tcl_NRPostProc TEOV_NotFoundCallback;
static Tcl_NRPostProc TEOV_RestoreVarFrame;
static Tcl_NRPostProc TEOV_RunLeaveTraces;
static Tcl_NRPostProc EvalObjvCore;
static Tcl_NRPostProc Dispatch;
static Tcl_ObjCmdProc2 CoroTypeObjCmd;
static Tcl_ObjCmdProc2 TclNRCoroInjectObjCmd;
static Tcl_ObjCmdProc2 TclNRCoroProbeObjCmd;
static Tcl_NRPostProc InjectHandler;
static Tcl_NRPostProc InjectHandlerPostCall;
MODULE_SCOPE const TclStubs tclStubs;
/*
* Magical counts for the number of arguments accepted by a coroutine command
* after particular kinds of [yield].
*/
enum CoroutineArgumentTypes {
COROUTINE_ARGUMENTS_SINGLE_OPTIONAL = -1,
COROUTINE_ARGUMENTS_ARBITRARY = -2
};
/*
* The following structure define the commands in the Tcl core.
*/
typedef struct {
const char *name; // Name of object-based command.
Tcl_ObjCmdProc2 *objProc; // Object-based function for command.
CompileProc *compileProc; // Function called to compile command.
Tcl_ObjCmdProc2 *nreProc; // NR-based function for command.
int flags; // Various flag bits, as defined below.
} CmdInfo;
enum CmdInfoFlags {
CMD_IS_SAFE = 1 /* Whether this command is part of the set of
* commands present by default in a safe
* interpreter. */
/* CMD_COMPILES_EXPANDED - Whether the compiler for this command can handle
* expansion for itself rather than needing the generic layer to take care of
* it for it. Defined in tclInt.h. */
};
/*
* Description of commands in ::tcl::unsupported.
*
*/
typedef struct UnsupportedCmdInfo {
const char *name; // Name of command in ::tcl::unsupported.
Tcl_ObjCmdProc2 *objProc; // Object-based function for command.
CompileProc *compileProc; // Function called to compile command.
Tcl_ObjCmdProc2 *nreProc; // NR-based function for command.
void *clientData; // ClientData to use for the command.
int flags; // Various flag bits, as defined for CmdInfo.
} UnsupportedCmdInfo;
// A function that can configure an ensemble after it is created.
typedef int (EnsembleConfigurer)(Tcl_Interp *interp, Tcl_Command ensemble);
|
| ︙ | ︙ | |||
301 302 303 304 305 306 307 | * so. This flag lets us mark those cases. */ } EnsembleSetup; /* * The built-in commands, and the functions that implement them: */ | < < < < < < < < < < | 301 302 303 304 305 306 307 308 309 310 311 312 313 314 |
* so. This flag lets us mark those cases. */
} EnsembleSetup;
/*
* The built-in commands, and the functions that implement them:
*/
static const CmdInfo builtInCmds[] = {
/*
* Commands in the generic core. All are safe.
*/
{"append", Tcl_AppendObjCmd, TclCompileAppendCmd, NULL, CMD_IS_SAFE},
{"apply", Tcl_ApplyObjCmd, NULL, TclNRApplyObjCmd, CMD_IS_SAFE},
|
| ︙ | ︙ | |||
356 357 358 359 360 361 362 |
{"lreplace", Tcl_LreplaceObjCmd, TclCompileLreplaceCmd, NULL, CMD_IS_SAFE},
{"lreverse", Tcl_LreverseObjCmd, NULL, NULL, CMD_IS_SAFE},
{"lsearch", Tcl_LsearchObjCmd, NULL, NULL, CMD_IS_SAFE},
{"lseq", Tcl_LseqObjCmd, TclCompileLseqCmd, NULL, CMD_IS_SAFE},
{"lset", Tcl_LsetObjCmd, TclCompileLsetCmd, NULL, CMD_IS_SAFE},
{"lsort", Tcl_LsortObjCmd, NULL, NULL, CMD_IS_SAFE},
{"package", Tcl_PackageObjCmd, NULL, TclNRPackageObjCmd, CMD_IS_SAFE},
| | | 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 |
{"lreplace", Tcl_LreplaceObjCmd, TclCompileLreplaceCmd, NULL, CMD_IS_SAFE},
{"lreverse", Tcl_LreverseObjCmd, NULL, NULL, CMD_IS_SAFE},
{"lsearch", Tcl_LsearchObjCmd, NULL, NULL, CMD_IS_SAFE},
{"lseq", Tcl_LseqObjCmd, TclCompileLseqCmd, NULL, CMD_IS_SAFE},
{"lset", Tcl_LsetObjCmd, TclCompileLsetCmd, NULL, CMD_IS_SAFE},
{"lsort", Tcl_LsortObjCmd, NULL, NULL, CMD_IS_SAFE},
{"package", Tcl_PackageObjCmd, NULL, TclNRPackageObjCmd, CMD_IS_SAFE},
{"proc", Tcl_ProcObjCmd, NULL, NULL, CMD_IS_SAFE},
{"regexp", Tcl_RegexpObjCmd, TclCompileRegexpCmd, NULL, CMD_IS_SAFE},
{"regsub", Tcl_RegsubObjCmd, TclCompileRegsubCmd, NULL, CMD_IS_SAFE},
{"rename", Tcl_RenameObjCmd, NULL, NULL, CMD_IS_SAFE},
{"return", Tcl_ReturnObjCmd, TclCompileReturnCmd, NULL, CMD_IS_SAFE},
{"scan", Tcl_ScanObjCmd, NULL, NULL, CMD_IS_SAFE},
{"set", Tcl_SetObjCmd, TclCompileSetCmd, NULL, CMD_IS_SAFE},
{"split", Tcl_SplitObjCmd, NULL, NULL, CMD_IS_SAFE},
|
| ︙ | ︙ | |||
457 458 459 460 461 462 463 |
typedef double (BuiltinUnaryFunc)(double x);
typedef double (BuiltinBinaryFunc)(double x, double y);
#define BINARY_TYPECAST(fn) \
(BuiltinUnaryFunc *)(void *)(BuiltinBinaryFunc *) fn
typedef struct {
const char *name; /* Name of the function. The full name is
* "::tcl::mathfunc::<name>". */
| | | 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 |
typedef double (BuiltinUnaryFunc)(double x);
typedef double (BuiltinBinaryFunc)(double x, double y);
#define BINARY_TYPECAST(fn) \
(BuiltinUnaryFunc *)(void *)(BuiltinBinaryFunc *) fn
typedef struct {
const char *name; /* Name of the function. The full name is
* "::tcl::mathfunc::<name>". */
Tcl_ObjCmdProc2 *objCmdProc; /* Function that evaluates the function */
BuiltinUnaryFunc *fn; /* Real function pointer */
} BuiltinFuncDef;
static const BuiltinFuncDef BuiltinFuncTable[] = {
{ "abs", ExprAbsFunc, NULL },
{ "acos", ExprUnaryFunc, acos },
{ "asin", ExprUnaryFunc, asin },
{ "atan", ExprUnaryFunc, atan },
|
| ︙ | ︙ | |||
507 508 509 510 511 512 513 |
/*
* TIP#174's math operators. All are safe.
*/
typedef struct {
const char *name; /* Name of object-based command. */
| | | 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 |
/*
* TIP#174's math operators. All are safe.
*/
typedef struct {
const char *name; /* Name of object-based command. */
Tcl_ObjCmdProc2 *objProc; /* Object-based function for command. */
CompileProc *compileProc; /* Function called to compile command. */
union {
int numArgs;
int identity;
} i;
const char *expected; /* For error message, what argument(s)
* were expected. */
|
| ︙ | ︙ | |||
739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 |
}
}
}
Tcl_SetObjResult(interp, Tcl_NewBooleanObj(0));
return TCL_OK;
}
static int
BuildInfoObjCmd(
void *clientData,
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
return BuildInfoObjCmd2(clientData, interp, objc, objv);
}
/*
*----------------------------------------------------------------------
*
* Tcl_CreateInterp --
*
* Create a new TCL command interpreter.
| > > | 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 |
}
}
}
Tcl_SetObjResult(interp, Tcl_NewBooleanObj(0));
return TCL_OK;
}
#ifndef TCL_NO_DEPRECATED
static int
BuildInfoObjCmd(
void *clientData,
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
return BuildInfoObjCmd2(clientData, interp, objc, objv);
}
#endif
/*
*----------------------------------------------------------------------
*
* Tcl_CreateInterp --
*
* Create a new TCL command interpreter.
|
| ︙ | ︙ | |||
820 821 822 823 824 825 826 |
Tcl_InitHashTable(&cancelTable, TCL_ONE_WORD_KEYS);
cancelTableInitialized = 1;
}
Tcl_MutexUnlock(&cancelLock);
}
| < | | 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 |
Tcl_InitHashTable(&cancelTable, TCL_ONE_WORD_KEYS);
cancelTableInitialized = 1;
}
Tcl_MutexUnlock(&cancelLock);
}
if (commandTypeInit == 0) {
TclRegisterCommandTypeName(TclObjInterpProc2, "proc");
TclRegisterCommandTypeName(TclEnsembleImplementationCmd, "ensemble");
TclRegisterCommandTypeName(TclAliasObjCmd, "alias");
TclRegisterCommandTypeName(TclLocalAliasObjCmd, "alias");
TclRegisterCommandTypeName(TclChildObjCmd, "interp");
TclRegisterCommandTypeName(TclInvokeImportedCmd, "import");
TclRegisterCommandTypeName(TclOOPublicObjectCmd, "object");
TclRegisterCommandTypeName(TclOOPrivateObjectCmd, "privateObject");
|
| ︙ | ︙ | |||
1103 1104 1105 1106 1107 1108 1109 | cmdPtr->hPtr = hPtr; cmdPtr->nsPtr = iPtr->globalNsPtr; cmdPtr->refCount = 1; cmdPtr->cmdEpoch = 0; cmdPtr->compileProc = cmdInfoPtr->compileProc; cmdPtr->proc = NULL; cmdPtr->clientData = NULL; | | | | | 1094 1095 1096 1097 1098 1099 1100 1101 1102 1103 1104 1105 1106 1107 1108 1109 1110 1111 1112 1113 1114 1115 1116 1117 1118 |
cmdPtr->hPtr = hPtr;
cmdPtr->nsPtr = iPtr->globalNsPtr;
cmdPtr->refCount = 1;
cmdPtr->cmdEpoch = 0;
cmdPtr->compileProc = cmdInfoPtr->compileProc;
cmdPtr->proc = NULL;
cmdPtr->clientData = NULL;
cmdPtr->objProc2 = cmdInfoPtr->objProc;
cmdPtr->objClientData2 = NULL;
cmdPtr->deleteProc = NULL;
cmdPtr->deleteData = NULL;
cmdPtr->flags = 0;
if (cmdInfoPtr->flags & CMD_COMPILES_EXPANDED) {
cmdPtr->flags |= CMD_COMPILES_EXPANDED;
}
cmdPtr->importRefPtr = NULL;
cmdPtr->tracePtr = NULL;
cmdPtr->nreProc2 = cmdInfoPtr->nreProc;
Tcl_SetHashValue(hPtr, cmdPtr);
}
}
/*
* Create the standard ensembles "array", "binary", "chan", "clock",
* "dict", "encoding", "file", "info", "namespace", "string", etc. Note
|
| ︙ | ︙ | |||
1154 1155 1156 1157 1158 1159 1160 |
* implemented as commands in the ::tcl::mathfunc namespace.
*/
/*
* Register the default [interp bgerror] handler.
*/
| | | | | | 1145 1146 1147 1148 1149 1150 1151 1152 1153 1154 1155 1156 1157 1158 1159 1160 1161 1162 1163 1164 1165 1166 1167 1168 1169 1170 1171 1172 1173 1174 1175 1176 1177 1178 1179 1180 1181 1182 1183 1184 1185 1186 1187 1188 1189 1190 1191 1192 1193 1194 1195 1196 1197 |
* implemented as commands in the ::tcl::mathfunc namespace.
*/
/*
* Register the default [interp bgerror] handler.
*/
Tcl_CreateObjCommand2(interp, "::tcl::Bgerror",
TclDefaultBgErrorHandlerObjCmd, NULL, NULL);
/*
* Create unsupported commands for debugging bytecode and objects.
*/
const UnsupportedCmdInfo *unsCmdInfoPtr;
for (unsCmdInfoPtr=unsupportedCmds; unsCmdInfoPtr->name; unsCmdInfoPtr++) {
cmdPtr = (Command *) TclCreateObjCommandInNs(interp,
unsCmdInfoPtr->name, unsupportedNs, unsCmdInfoPtr->objProc,
unsCmdInfoPtr->clientData, NULL);
cmdPtr->nreProc2 = unsCmdInfoPtr->nreProc;
cmdPtr->compileProc = unsCmdInfoPtr->compileProc;
}
Tcl_Export(interp, unsupportedNs, "*", 1);
#ifdef USE_DTRACE
/*
* Register the tcl::dtrace command.
*/
Tcl_CreateObjCommand2(interp, "::tcl::dtrace", DTraceObjCmd, NULL, NULL);
#endif /* USE_DTRACE */
/*
* Register the builtin math functions.
*/
nsPtr = Tcl_CreateNamespace(interp, "::tcl::mathfunc", NULL, NULL);
if (nsPtr == NULL) {
Tcl_Panic("Can't create math function namespace");
}
#define MATH_FUNC_PREFIX_LEN 17 /* == strlen("::tcl::mathfunc::") */
memcpy(mathFuncName, "::tcl::mathfunc::", MATH_FUNC_PREFIX_LEN);
for (builtinFuncPtr = BuiltinFuncTable; builtinFuncPtr->name != NULL;
builtinFuncPtr++) {
strcpy(mathFuncName + MATH_FUNC_PREFIX_LEN, builtinFuncPtr->name);
Tcl_CreateObjCommand2(interp, mathFuncName,
builtinFuncPtr->objCmdProc, (void *)builtinFuncPtr->fn, NULL);
Tcl_Export(interp, nsPtr, builtinFuncPtr->name, 0);
}
/*
* Register the mathematical "operator" commands. [TIP #174]
*/
|
| ︙ | ︙ | |||
1215 1216 1217 1218 1219 1220 1221 |
for (opcmdInfoPtr=mathOpCmds ; opcmdInfoPtr->name!=NULL ; opcmdInfoPtr++){
TclOpCmdClientData *occdPtr = (TclOpCmdClientData *)Tcl_Alloc(sizeof(TclOpCmdClientData));
occdPtr->op = opcmdInfoPtr->name;
occdPtr->i.numArgs = opcmdInfoPtr->i.numArgs;
occdPtr->expected = opcmdInfoPtr->expected;
strcpy(mathFuncName + MATH_OP_PREFIX_LEN, opcmdInfoPtr->name);
| | | 1206 1207 1208 1209 1210 1211 1212 1213 1214 1215 1216 1217 1218 1219 1220 |
for (opcmdInfoPtr=mathOpCmds ; opcmdInfoPtr->name!=NULL ; opcmdInfoPtr++){
TclOpCmdClientData *occdPtr = (TclOpCmdClientData *)Tcl_Alloc(sizeof(TclOpCmdClientData));
occdPtr->op = opcmdInfoPtr->name;
occdPtr->i.numArgs = opcmdInfoPtr->i.numArgs;
occdPtr->expected = opcmdInfoPtr->expected;
strcpy(mathFuncName + MATH_OP_PREFIX_LEN, opcmdInfoPtr->name);
cmdPtr = (Command *) Tcl_CreateObjCommand2(interp, mathFuncName,
opcmdInfoPtr->objProc, occdPtr, DeleteOpCmdClientData);
if (cmdPtr == NULL) {
Tcl_Panic("failed to create math operator %s",
opcmdInfoPtr->name);
} else if (opcmdInfoPtr->compileProc != NULL) {
cmdPtr->compileProc = opcmdInfoPtr->compileProc;
}
|
| ︙ | ︙ | |||
1277 1278 1279 1280 1281 1282 1283 1284 1285 1286 1287 1288 1289 1290 1291 1292 1293 1294 1295 1296 1297 |
* Register Tcl's version number.
* TIP #268: Full patchlevel instead of just major.minor
* TIP #599: Extended build information "+<UUID>.<tag1>.<tag2>...."
*/
Tcl_PkgProvideEx(interp, "Tcl", TCL_PATCH_LEVEL, &tclStubs);
Tcl_PkgProvideEx(interp, "tcl", TCL_PATCH_LEVEL, &tclStubs);
Tcl_CmdInfo info2;
Tcl_Command buildInfoCmd = Tcl_CreateObjCommand(interp, "::tcl::build-info",
BuildInfoObjCmd, (void *)version, NULL);
Tcl_GetCommandInfoFromToken(buildInfoCmd, &info2);
info2.objProc2 = BuildInfoObjCmd2;
info2.objClientData2 = (void *)version;
Tcl_SetCommandInfoFromToken(buildInfoCmd, &info2);
if (TclTommath_Init(interp) != TCL_OK) {
Tcl_Panic("%s", Tcl_GetStringResult(interp));
}
if (TclOOInit(interp) != TCL_OK) {
Tcl_Panic("%s", Tcl_GetStringResult(interp));
| > > > > > | 1268 1269 1270 1271 1272 1273 1274 1275 1276 1277 1278 1279 1280 1281 1282 1283 1284 1285 1286 1287 1288 1289 1290 1291 1292 1293 |
* Register Tcl's version number.
* TIP #268: Full patchlevel instead of just major.minor
* TIP #599: Extended build information "+<UUID>.<tag1>.<tag2>...."
*/
Tcl_PkgProvideEx(interp, "Tcl", TCL_PATCH_LEVEL, &tclStubs);
Tcl_PkgProvideEx(interp, "tcl", TCL_PATCH_LEVEL, &tclStubs);
#ifdef TCL_NO_DEPRECATED
Tcl_CreateObjCommand2(interp, "::tcl::build-info",
BuildInfoObjCmd2, (void *)version, NULL);
#else
Tcl_CmdInfo info2;
Tcl_Command buildInfoCmd = Tcl_CreateObjCommand(interp, "::tcl::build-info",
BuildInfoObjCmd, (void *)version, NULL);
Tcl_GetCommandInfoFromToken(buildInfoCmd, &info2);
info2.objProc2 = BuildInfoObjCmd2;
info2.objClientData2 = (void *)version;
Tcl_SetCommandInfoFromToken(buildInfoCmd, &info2);
#endif
if (TclTommath_Init(interp) != TCL_OK) {
Tcl_Panic("%s", Tcl_GetStringResult(interp));
}
if (TclOOInit(interp) != TCL_OK) {
Tcl_Panic("%s", Tcl_GetStringResult(interp));
|
| ︙ | ︙ | |||
1325 1326 1327 1328 1329 1330 1331 | * recommended that those names be ASCII.) * * --------------------------------------------------------------------- */ void TclRegisterCommandTypeName( | | | 1321 1322 1323 1324 1325 1326 1327 1328 1329 1330 1331 1332 1333 1334 1335 |
* recommended that those names be ASCII.)
*
* ---------------------------------------------------------------------
*/
void
TclRegisterCommandTypeName(
Tcl_ObjCmdProc2 *implementationProc,
const char *nameStr)
{
Tcl_HashEntry *hPtr;
Tcl_MutexLock(&commandTypeLock);
if (commandTypeInit == 0) {
Tcl_InitHashTable(&commandTypeTable, TCL_ONE_WORD_KEYS);
|
| ︙ | ︙ | |||
1356 1357 1358 1359 1360 1361 1362 |
}
const char *
TclGetCommandTypeName(
Tcl_Command command)
{
Command *cmdPtr = (Command *) command;
| | | | 1352 1353 1354 1355 1356 1357 1358 1359 1360 1361 1362 1363 1364 1365 1366 1367 1368 1369 1370 |
}
const char *
TclGetCommandTypeName(
Tcl_Command command)
{
Command *cmdPtr = (Command *) command;
Tcl_ObjCmdProc2 *procPtr = cmdPtr->objProc2;
const char *name = "native";
if (procPtr == NULL) {
procPtr = cmdPtr->nreProc2;
}
Tcl_MutexLock(&commandTypeLock);
if (commandTypeInit) {
Tcl_HashEntry *hPtr = Tcl_FindHashEntry(&commandTypeTable, procPtr);
if (hPtr && Tcl_GetHashValue(hPtr)) {
name = (const char *) Tcl_GetHashValue(hPtr);
|
| ︙ | ︙ | |||
1413 1414 1415 1416 1417 1418 1419 |
|| Tcl_HideCommand(interp, INTERIM_HACK_NAME,
TclGetString(hideName)) != TCL_OK) {
Tcl_Panic("problem making '%s %s' safe: %s",
nsName, name, Tcl_GetStringResult(interp));
}
if (publicNameTuple) {
Tcl_IncrRefCount(publicNameTuple);
| | | 1409 1410 1411 1412 1413 1414 1415 1416 1417 1418 1419 1420 1421 1422 1423 |
|| Tcl_HideCommand(interp, INTERIM_HACK_NAME,
TclGetString(hideName)) != TCL_OK) {
Tcl_Panic("problem making '%s %s' safe: %s",
nsName, name, Tcl_GetStringResult(interp));
}
if (publicNameTuple) {
Tcl_IncrRefCount(publicNameTuple);
Tcl_CreateObjCommand2(interp, TclGetString(cmdName),
BadEnsembleSubcommand, (void *)publicNameTuple,
BadEnsembleSubcommandCleanup);
}
TclDecrRefCount(cmdName);
TclDecrRefCount(hideName);
}
|
| ︙ | ︙ | |||
1496 1497 1498 1499 1500 1501 1502 |
*----------------------------------------------------------------------
*/
static int
BadEnsembleSubcommand(
void *clientData,
Tcl_Interp *interp,
| | | 1492 1493 1494 1495 1496 1497 1498 1499 1500 1501 1502 1503 1504 1505 1506 |
*----------------------------------------------------------------------
*/
static int
BadEnsembleSubcommand(
void *clientData,
Tcl_Interp *interp,
TCL_UNUSED(Tcl_Size) /*objc*/,
TCL_UNUSED(Tcl_Obj *const *) /* objv */)
{
Tcl_Obj *publicNameTuple = (Tcl_Obj *)clientData;
Tcl_Obj *ensembleName = TclListObjGetElement(publicNameTuple, 0);
Tcl_Obj *commandName = TclListObjGetElement(publicNameTuple, 1);
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
|
| ︙ | ︙ | |||
2516 2517 2518 2519 2520 2521 2522 | * The return value is a token for the command, which can be used in * future calls to Tcl_GetCommandName. * * Side effects: * If a command named cmdName already exists for interp, it is deleted. * In the future, when cmdName is seen as the name of a command by * Tcl_Eval, proc will be called. To support the bytecode interpreter, | | | 2512 2513 2514 2515 2516 2517 2518 2519 2520 2521 2522 2523 2524 2525 2526 | * The return value is a token for the command, which can be used in * future calls to Tcl_GetCommandName. * * Side effects: * If a command named cmdName already exists for interp, it is deleted. * In the future, when cmdName is seen as the name of a command by * Tcl_Eval, proc will be called. To support the bytecode interpreter, * the command is created with a wrapper Tcl_ObjCmdProc2 * (InvokeStringCommand) that eventually calls proc. When the command * is deleted from the table, deleteProc will be called. See the manual * entry for details on the calling sequence. * *---------------------------------------------------------------------- */ |
| ︙ | ︙ | |||
2659 2660 2661 2662 2663 2664 2665 |
cmdPtr = (Command *)Tcl_Alloc(sizeof(Command));
Tcl_SetHashValue(hPtr, cmdPtr);
cmdPtr->hPtr = hPtr;
cmdPtr->nsPtr = nsPtr;
cmdPtr->refCount = 1;
cmdPtr->cmdEpoch = 0;
cmdPtr->compileProc = NULL;
| | | | | | 2655 2656 2657 2658 2659 2660 2661 2662 2663 2664 2665 2666 2667 2668 2669 2670 2671 2672 2673 2674 2675 2676 2677 2678 2679 2680 2681 2682 2683 2684 2685 2686 2687 2688 2689 |
cmdPtr = (Command *)Tcl_Alloc(sizeof(Command));
Tcl_SetHashValue(hPtr, cmdPtr);
cmdPtr->hPtr = hPtr;
cmdPtr->nsPtr = nsPtr;
cmdPtr->refCount = 1;
cmdPtr->cmdEpoch = 0;
cmdPtr->compileProc = NULL;
cmdPtr->objProc2 = InvokeStringCommand;
cmdPtr->objClientData2 = cmdPtr;
cmdPtr->proc = proc;
cmdPtr->clientData = clientData;
cmdPtr->deleteProc = deleteProc;
cmdPtr->deleteData = clientData;
cmdPtr->flags = 0;
cmdPtr->importRefPtr = NULL;
cmdPtr->tracePtr = NULL;
cmdPtr->nreProc2 = NULL;
/*
* Plug in any existing import references found above. Be sure to update
* all of these references to point to the new command.
*/
if (oldRefPtr != NULL) {
cmdPtr->importRefPtr = oldRefPtr;
while (oldRefPtr != NULL) {
Command *refCmdPtr = oldRefPtr->importedCmdPtr;
dataPtr = (ImportedCmdData *)refCmdPtr->objClientData2;
dataPtr->realCmdPtr = cmdPtr;
oldRefPtr = oldRefPtr->nextPtr;
}
}
/*
* We just created a command, so in its namespace and all of its parent
|
| ︙ | ︙ | |||
2713 2714 2715 2716 2717 2718 2719 | * * Side effects: * If a command named "cmdName" already exists for interp, it is * first deleted. Then the new command is created from the arguments. * * In the future, during bytecode evaluation when "cmdName" is seen as * the name of a command by Tcl_EvalObj or Tcl_Eval, the object-based | | > | | | | | > > | | | > | | | 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 2740 2741 2742 2743 2744 2745 2746 2747 2748 2749 2750 2751 2752 2753 2754 2755 2756 2757 2758 2759 2760 2761 2762 2763 2764 2765 2766 2767 2768 2769 2770 2771 2772 2773 2774 2775 2776 2777 2778 2779 2780 2781 2782 2783 2784 2785 2786 2787 2788 2789 2790 2791 2792 2793 2794 2795 2796 2797 2798 2799 2800 2801 2802 2803 2804 2805 |
*
* Side effects:
* If a command named "cmdName" already exists for interp, it is
* first deleted. Then the new command is created from the arguments.
*
* In the future, during bytecode evaluation when "cmdName" is seen as
* the name of a command by Tcl_EvalObj or Tcl_Eval, the object-based
* Tcl_ObjCmdProc2 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.
*
*----------------------------------------------------------------------
*/
#ifndef TCL_NO_DEPRECATED
typedef struct {
Tcl_ObjCmdProc *proc;
void *clientData; /* Arbitrary value to pass to proc function. */
Tcl_CmdDeleteProc *deleteProc;
void *deleteData; /* Arbitrary value to pass to deleteProc function. */
Tcl_ObjCmdProc *nreProc;
} CmdWrapperInfo;
static int
CmdWrapperProc(
void *clientData,
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj * const *objv)
{
CmdWrapperInfo *info = (CmdWrapperInfo *) clientData;
if (objc > INT_MAX) {
Tcl_WrongNumArgs(interp, 1, objv, "?args?");
return TCL_ERROR;
}
return info->proc(info->clientData, interp, (int)objc, objv);
}
static void
CmdWrapperDeleteProc(
void *clientData)
{
CmdWrapperInfo *info = (CmdWrapperInfo *) clientData;
clientData = info->deleteData;
Tcl_CmdDeleteProc *deleteProc = info->deleteProc;
Tcl_Free(info);
if (deleteProc != NULL) {
deleteProc(clientData);
}
}
#undef Tcl_CreateObjCommand
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
* the global namespace. */
Tcl_ObjCmdProc *proc, /* Object-based function to associate with
* name. */
void *clientData, /* Arbitrary value to pass to object
* function. */
Tcl_CmdDeleteProc *deleteProc)
/* If not NULL, gives a function to call when
* this command is deleted. */
{
CmdWrapperInfo *info = (CmdWrapperInfo *)Tcl_Alloc(sizeof(CmdWrapperInfo));
info->proc = proc;
info->clientData = clientData;
info->deleteProc = deleteProc;
info->deleteData = clientData;
return Tcl_CreateObjCommand2(interp, cmdName,
(proc ? CmdWrapperProc : NULL),
info, CmdWrapperDeleteProc);
}
#endif /* TCL_NO_DEPRECATED */
Tcl_Command
Tcl_CreateObjCommand2(
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
* the global namespace. */
Tcl_ObjCmdProc2 *proc, /* Object-based function to associate with
* name. */
void *clientData, /* Arbitrary value to pass to object
* function. */
Tcl_CmdDeleteProc *deleteProc)
/* If not NULL, gives a function to call when
* this command is deleted. */
{
|
| ︙ | ︙ | |||
2840 2841 2842 2843 2844 2845 2846 |
Tcl_Command
TclCreateObjCommandInNs(
Tcl_Interp *interp,
const char *cmdName, /* Name of command, without any namespace
* components. */
Tcl_Namespace *namesp, /* The namespace to create the command in */
| | | 2840 2841 2842 2843 2844 2845 2846 2847 2848 2849 2850 2851 2852 2853 2854 |
Tcl_Command
TclCreateObjCommandInNs(
Tcl_Interp *interp,
const char *cmdName, /* Name of command, without any namespace
* components. */
Tcl_Namespace *namesp, /* The namespace to create the command in */
Tcl_ObjCmdProc2 *proc, /* Object-based function to associate with
* name. */
void *clientData, /* Arbitrary value to pass to object
* function. */
Tcl_CmdDeleteProc *deleteProc)
/* If not NULL, gives a function to call when
* this command is deleted. */
{
|
| ︙ | ︙ | |||
2948 2949 2950 2951 2952 2953 2954 |
cmdPtr = (Command *)Tcl_Alloc(sizeof(Command));
Tcl_SetHashValue(hPtr, cmdPtr);
cmdPtr->hPtr = hPtr;
cmdPtr->nsPtr = nsPtr;
cmdPtr->refCount = 1;
cmdPtr->cmdEpoch = 0;
cmdPtr->compileProc = NULL;
| | | | | | 2948 2949 2950 2951 2952 2953 2954 2955 2956 2957 2958 2959 2960 2961 2962 2963 2964 2965 2966 2967 2968 2969 2970 2971 2972 2973 2974 2975 2976 2977 2978 2979 2980 2981 2982 2983 |
cmdPtr = (Command *)Tcl_Alloc(sizeof(Command));
Tcl_SetHashValue(hPtr, cmdPtr);
cmdPtr->hPtr = hPtr;
cmdPtr->nsPtr = nsPtr;
cmdPtr->refCount = 1;
cmdPtr->cmdEpoch = 0;
cmdPtr->compileProc = NULL;
cmdPtr->objProc2 = proc;
cmdPtr->objClientData2 = clientData;
cmdPtr->proc = NULL;
cmdPtr->clientData = NULL;
cmdPtr->deleteProc = deleteProc;
cmdPtr->deleteData = clientData;
cmdPtr->flags = 0;
cmdPtr->importRefPtr = NULL;
cmdPtr->tracePtr = NULL;
cmdPtr->nreProc2 = NULL;
/*
* Plug in any existing import references found above. Be sure to update
* all of these references to point to the new command.
*/
if (oldRefPtr != NULL) {
cmdPtr->importRefPtr = oldRefPtr;
while (oldRefPtr != NULL) {
Command *refCmdPtr = oldRefPtr->importedCmdPtr;
dataPtr = (ImportedCmdData*)refCmdPtr->objClientData2;
cmdPtr->refCount++;
TclCleanupCommandMacro(dataPtr->realCmdPtr);
dataPtr->realCmdPtr = cmdPtr;
oldRefPtr = oldRefPtr->nextPtr;
}
}
|
| ︙ | ︙ | |||
2993 2994 2995 2996 2997 2998 2999 | } /* *---------------------------------------------------------------------- * * InvokeStringCommand -- * | | | | | > > > > > > | | 2993 2994 2995 2996 2997 2998 2999 3000 3001 3002 3003 3004 3005 3006 3007 3008 3009 3010 3011 3012 3013 3014 3015 3016 3017 3018 3019 3020 3021 3022 3023 3024 3025 3026 3027 3028 3029 3030 3031 3032 3033 3034 3035 3036 3037 3038 3039 3040 3041 3042 3043 3044 3045 3046 3047 3048 3049 3050 |
}
/*
*----------------------------------------------------------------------
*
* InvokeStringCommand --
*
* "Wrapper" Tcl_ObjCmdProc2 used to call an existing string-based
* Tcl_CmdProc if no object-based function exists for a command. A
* pointer to this function is stored as the Tcl_ObjCmdProc2 in a Command
* structure. It simply turns around and calls the string Tcl_CmdProc in
* the Command structure.
*
* Results:
* A standard Tcl object result value.
*
* Side effects:
* Besides those side effects of the called Tcl_CmdProc,
* InvokeStringCommand allocates and frees storage.
*
*----------------------------------------------------------------------
*/
int
InvokeStringCommand(
void *clientData, /* Points to command's Command structure. */
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Command *cmdPtr = (Command *)clientData;
int i, result;
const char **argv;
if (objc > INT_MAX) {
Tcl_WrongNumArgs(interp, 1, objv, "?args?");
return TCL_ERROR;
}
argv = (const char **)
TclStackAlloc(interp, (objc + 1) * sizeof(char *));
for (i = 0; i < objc; i++) {
argv[i] = TclGetString(objv[i]);
}
argv[objc] = 0;
/*
* Invoke the command's string-based Tcl_CmdProc.
*/
result = cmdPtr->proc(cmdPtr->clientData, interp, (int)objc, argv);
TclStackFree(interp, (void *) argv);
return result;
}
/*
*----------------------------------------------------------------------
|
| ︙ | ︙ | |||
3297 3298 3299 3300 3301 3302 3303 3304 3305 3306 3307 |
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
static int
InvokeObj2Command(
void *clientData, /* Points to command's Command structure. */
Tcl_Interp *interp, /* Current interpreter. */
| > | < < < | | | | | < < < | > | | | | | | | | > | | | | | | | > > > | | | | > > | 3303 3304 3305 3306 3307 3308 3309 3310 3311 3312 3313 3314 3315 3316 3317 3318 3319 3320 3321 3322 3323 3324 3325 3326 3327 3328 3329 3330 3331 3332 3333 3334 3335 3336 3337 3338 3339 3340 3341 3342 3343 3344 3345 3346 3347 3348 3349 3350 3351 3352 3353 3354 3355 3356 3357 3358 3359 3360 3361 3362 3363 3364 3365 3366 3367 3368 3369 3370 3371 3372 3373 3374 3375 3376 3377 3378 3379 3380 3381 3382 3383 3384 3385 3386 3387 3388 3389 3390 3391 3392 3393 3394 3395 3396 3397 3398 3399 3400 3401 3402 3403 3404 3405 3406 3407 3408 3409 |
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
#ifndef TCL_NO_DEPRECATED
static int
InvokeObj2Command(
void *clientData, /* Points to command's Command structure. */
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
int result;
Command *cmdPtr = (Command *)clientData;
if (cmdPtr->objProc2 != NULL) {
result = cmdPtr->objProc2(cmdPtr->objClientData2, interp, objc, objv);
} else {
result = Tcl_NRCallObjProc2(interp, cmdPtr->nreProc2,
cmdPtr->objClientData2, objc, objv);
}
return result;
}
static int
CmdWrapper2Proc(
void *clientData,
Tcl_Interp *interp,
int objc,
Tcl_Obj *const objv[])
{
Command *cmdPtr = (Command *) clientData;
return cmdPtr->objProc2(cmdPtr->objClientData2, interp, objc, objv);
}
#endif
int
Tcl_SetCommandInfoFromToken(
Tcl_Command cmd,
const Tcl_CmdInfo *infoPtr)
{
Command *cmdPtr; /* Internal representation of the command */
if (cmd == NULL) {
return 0;
}
/*
* The isNativeObjectProc and nsPtr members of *infoPtr are ignored.
*/
cmdPtr = (Command *) cmd;
cmdPtr->proc = infoPtr->proc;
cmdPtr->clientData = infoPtr->clientData;
if (infoPtr->objProc2 == NULL) {
cmdPtr->objProc2 = InvokeStringCommand;
cmdPtr->objClientData2 = cmdPtr;
cmdPtr->nreProc2 = NULL;
} else {
if (infoPtr->objProc2 != cmdPtr->objProc2) {
cmdPtr->nreProc2 = NULL;
cmdPtr->objProc2 = infoPtr->objProc2;
}
cmdPtr->objClientData2 = infoPtr->objClientData2;
}
#ifndef TCL_NO_DEPRECATED
if (cmdPtr->deleteProc == CmdWrapperDeleteProc) {
CmdWrapperInfo *info = (CmdWrapperInfo *) cmdPtr->deleteData;
if (infoPtr->objProc == NULL) {
info->proc = InvokeObj2Command;
info->clientData = cmdPtr;
info->nreProc = NULL;
} else {
if (infoPtr->objProc != info->proc) {
info->nreProc = NULL;
info->proc = infoPtr->objProc;
}
info->clientData = infoPtr->objClientData;
}
info->deleteProc = infoPtr->deleteProc;
info->deleteData = infoPtr->deleteData;
} else
#endif
{
#ifndef TCL_NO_DEPRECATED
if ((infoPtr->objProc != NULL) && (infoPtr->objProc != CmdWrapper2Proc)) {
CmdWrapperInfo *info = (CmdWrapperInfo *)Tcl_Alloc(sizeof(CmdWrapperInfo));
info->proc = infoPtr->objProc;
info->clientData = infoPtr->objClientData;
info->nreProc = NULL;
info->deleteProc = infoPtr->deleteProc;
info->deleteData = infoPtr->deleteData;
cmdPtr->deleteProc = CmdWrapperDeleteProc;
cmdPtr->deleteData = info;
} else
#endif
{
cmdPtr->deleteProc = infoPtr->deleteProc;
cmdPtr->deleteData = infoPtr->deleteData;
}
}
return 1;
}
|
| ︙ | ︙ | |||
3464 3465 3466 3467 3468 3469 3470 |
* Set isNativeObjectProc 1 if objProc was registered by a call to
* Tcl_CreateObjCommand. Set isNativeObjectProc 2 if objProc was
* registered by a call to Tcl_CreateObjCommand2. Otherwise set it to 0.
*/
cmdPtr = (Command *) cmd;
infoPtr->isNativeObjectProc =
| | | | > | | | | | | > > > | | > | 3472 3473 3474 3475 3476 3477 3478 3479 3480 3481 3482 3483 3484 3485 3486 3487 3488 3489 3490 3491 3492 3493 3494 3495 3496 3497 3498 3499 3500 3501 3502 3503 3504 3505 3506 3507 3508 3509 |
* Set isNativeObjectProc 1 if objProc was registered by a call to
* Tcl_CreateObjCommand. Set isNativeObjectProc 2 if objProc was
* registered by a call to Tcl_CreateObjCommand2. Otherwise set it to 0.
*/
cmdPtr = (Command *) cmd;
infoPtr->isNativeObjectProc =
(cmdPtr->objProc2 != InvokeStringCommand) ? 2 : 0;
infoPtr->objProc2 = cmdPtr->objProc2;
infoPtr->objClientData2 = cmdPtr->objClientData2;
infoPtr->proc = cmdPtr->proc;
infoPtr->clientData = cmdPtr->clientData;
#ifndef TCL_NO_DEPRECATED
if (cmdPtr->deleteProc == CmdWrapperDeleteProc) {
CmdWrapperInfo *info = (CmdWrapperInfo *)cmdPtr->deleteData;
infoPtr->deleteProc = info->deleteProc;
infoPtr->deleteData = info->deleteData;
infoPtr->objProc = info->proc;
infoPtr->objClientData = info->clientData;
if (cmdPtr->objProc2 == CmdWrapperProc) {
infoPtr->isNativeObjectProc = 1;
}
} else
#endif
{
infoPtr->deleteProc = cmdPtr->deleteProc;
infoPtr->deleteData = cmdPtr->deleteData;
#ifndef TCL_NO_DEPRECATED
infoPtr->objProc = CmdWrapper2Proc;
infoPtr->objClientData = cmdPtr;
#endif
}
infoPtr->namespacePtr = (Tcl_Namespace *) cmdPtr->nsPtr;
return 1;
}
/*
*----------------------------------------------------------------------
|
| ︙ | ︙ | |||
3797 3798 3799 3800 3801 3802 3803 |
/*
* A number of tests for particular kinds of commands are done by checking
* whether the objProc field holds a known value. Set the field to NULL so
* that such tests won't have false positives when applied to deleted
* commands.
*/
| | | 3810 3811 3812 3813 3814 3815 3816 3817 3818 3819 3820 3821 3822 3823 3824 |
/*
* A number of tests for particular kinds of commands are done by checking
* whether the objProc field holds a known value. Set the field to NULL so
* that such tests won't have false positives when applied to deleted
* commands.
*/
cmdPtr->objProc2 = NULL;
/*
* Now free the Command structure, unless there is another reference to it
* from a CmdName Tcl object in some ByteCode code sequence. In that case,
* delay the cleanup until all references are either discarded (when a
* ByteCode is freed) or replaced by a new reference (when a cached
* CmdName Command reference is found to be invalid and
|
| ︙ | ︙ | |||
4594 4595 4596 4597 4598 4599 4600 |
cmdPtr->refCount++;
TclNRAddCallback(interp, TEOV_RunLeaveTraces, INT2PTR(objc),
commandPtr, cmdPtr, objv);
}
TclNRAddCallback(interp, Dispatch,
| | | | | 4607 4608 4609 4610 4611 4612 4613 4614 4615 4616 4617 4618 4619 4620 4621 4622 4623 4624 4625 4626 4627 4628 4629 4630 4631 4632 |
cmdPtr->refCount++;
TclNRAddCallback(interp, TEOV_RunLeaveTraces, INT2PTR(objc),
commandPtr, cmdPtr, objv);
}
TclNRAddCallback(interp, Dispatch,
cmdPtr->nreProc2 ? cmdPtr->nreProc2 : cmdPtr->objProc2,
cmdPtr->objClientData2, INT2PTR(objc), objv);
return TCL_OK;
}
static int
Dispatch(
void *data[],
Tcl_Interp *interp,
TCL_UNUSED(int) /*result*/)
{
Tcl_ObjCmdProc2 *objProc = (Tcl_ObjCmdProc2 *)data[0];
void *clientData = data[1];
Tcl_Size objc = PTR2INT(data[2]);
Tcl_Obj **objv = (Tcl_Obj **)data[3];
Interp *iPtr = (Interp *) interp;
#ifdef USE_DTRACE
if (TCL_DTRACE_CMD_ARGS_ENABLED()) {
|
| ︙ | ︙ | |||
4642 4643 4644 4645 4646 4647 4648 |
if (TCL_DTRACE_CMD_ENTRY_ENABLED() && objc) {
TCL_DTRACE_CMD_ENTRY(TclGetString(objv[0]), objc - 1,
(Tcl_Obj **)(objv + 1));
}
#endif /* USE_DTRACE */
iPtr->cmdCount++;
| | | 4655 4656 4657 4658 4659 4660 4661 4662 4663 4664 4665 4666 4667 4668 4669 |
if (TCL_DTRACE_CMD_ENTRY_ENABLED() && objc) {
TCL_DTRACE_CMD_ENTRY(TclGetString(objv[0]), objc - 1,
(Tcl_Obj **)(objv + 1));
}
#endif /* USE_DTRACE */
iPtr->cmdCount++;
return objProc(clientData, interp, objc, objv);
}
int
TclNRRunCallbacks(
Tcl_Interp *interp,
int result,
struct NRE_callback *rootPtr)
|
| ︙ | ︙ | |||
5353 5354 5355 5356 5357 5358 5359 |
objv = objvSpace;
lines = lineSpace;
iPtr->cmdFramePtr = eeFramePtr->nextPtr;
for (objectsUsed = 0, tokenPtr = parsePtr->tokenPtr;
objectsUsed < numWords;
objectsUsed++, tokenPtr += tokenPtr->numComponents + 1) {
| < < | 5366 5367 5368 5369 5370 5371 5372 5373 5374 5375 5376 5377 5378 5379 |
objv = objvSpace;
lines = lineSpace;
iPtr->cmdFramePtr = eeFramePtr->nextPtr;
for (objectsUsed = 0, tokenPtr = parsePtr->tokenPtr;
objectsUsed < numWords;
objectsUsed++, tokenPtr += tokenPtr->numComponents + 1) {
/*
* TIP #280. Track lines to current word. Save the information
* on a per-word basis, signaling dynamic words as needed.
* Make the information available to the recursively called
* evaluator as well, including the type of context (source
* vs. eval).
*/
|
| ︙ | ︙ | |||
5404 5405 5406 5407 5408 5409 5410 | "\n (expanding word %" TCL_SIZE_MODIFIER "d)", objectsUsed)); Tcl_DecrRefCount(objv[objectsUsed]); break; } expandRequested = 1; expand[objectsUsed] = 1; | | < < < < < < | < < < < | 5415 5416 5417 5418 5419 5420 5421 5422 5423 5424 5425 5426 5427 5428 5429 5430 5431 5432 5433 |
"\n (expanding word %" TCL_SIZE_MODIFIER "d)", objectsUsed));
Tcl_DecrRefCount(objv[objectsUsed]);
break;
}
expandRequested = 1;
expand[objectsUsed] = 1;
objectsNeeded += (numElements ? numElements : 1);
} else {
expand[objectsUsed] = 0;
objectsNeeded++;
}
if (wordCLNext) {
TclContinuationsEnterDerived(objv[objectsUsed],
wordStart - outerScript, wordCLNext);
}
} /* for loop */
iPtr->cmdFramePtr = eeFramePtr;
|
| ︙ | ︙ | |||
6011 6012 6013 6014 6015 6016 6017 |
*/
void
TclArgumentGet(
Tcl_Interp *interp,
Tcl_Obj *obj,
CmdFrame **cfPtrPtr,
| | | 6012 6013 6014 6015 6016 6017 6018 6019 6020 6021 6022 6023 6024 6025 6026 |
*/
void
TclArgumentGet(
Tcl_Interp *interp,
Tcl_Obj *obj,
CmdFrame **cfPtrPtr,
Tcl_Size *wordPtr)
{
Interp *iPtr = (Interp *) interp;
Tcl_HashEntry *hPtr;
CmdFrame *framePtr;
/*
* An object which either has no string rep or else is a canonical list is
|
| ︙ | ︙ | |||
6037 6038 6039 6040 6041 6042 6043 |
* stack. That is nearest.
*/
hPtr = Tcl_FindHashEntry(iPtr->lineLAPtr, obj);
if (hPtr) {
CFWord *cfwPtr = (CFWord *)Tcl_GetHashValue(hPtr);
| | | | 6038 6039 6040 6041 6042 6043 6044 6045 6046 6047 6048 6049 6050 6051 6052 6053 6054 6055 6056 6057 6058 6059 6060 6061 6062 6063 6064 6065 6066 6067 6068 6069 6070 |
* stack. That is nearest.
*/
hPtr = Tcl_FindHashEntry(iPtr->lineLAPtr, obj);
if (hPtr) {
CFWord *cfwPtr = (CFWord *)Tcl_GetHashValue(hPtr);
*wordPtr = cfwPtr->word;
*cfPtrPtr = cfwPtr->framePtr;
return;
}
/*
* Check if the Tcl_Obj has location information as a bytecode literal, in
* that stack.
*/
hPtr = Tcl_FindHashEntry(iPtr->lineLABCPtr, obj);
if (hPtr) {
CFWordBC *cfwPtr = (CFWordBC *)Tcl_GetHashValue(hPtr);
framePtr = cfwPtr->framePtr;
framePtr->data.tebc.pc = (char *) (((ByteCode *)
framePtr->data.tebc.codePtr)->codeStart + cfwPtr->pc);
*cfPtrPtr = cfwPtr->framePtr;
*wordPtr = cfwPtr->word;
return;
}
}
/*
*----------------------------------------------------------------------
*
|
| ︙ | ︙ | |||
6111 6112 6113 6114 6115 6116 6117 |
* a previous call to Tcl_CreateInterp). */
Tcl_Obj *objPtr, /* Pointer to object containing commands to
* execute. */
int flags, /* Collection of OR-ed bits that control the
* evaluation of the script. Supported values
* are TCL_EVAL_GLOBAL and TCL_EVAL_DIRECT. */
const CmdFrame *invoker, /* Frame of the command doing the eval. */
| | | | 6112 6113 6114 6115 6116 6117 6118 6119 6120 6121 6122 6123 6124 6125 6126 6127 6128 6129 6130 6131 6132 6133 6134 6135 6136 6137 6138 6139 6140 6141 6142 6143 6144 6145 |
* a previous call to Tcl_CreateInterp). */
Tcl_Obj *objPtr, /* Pointer to object containing commands to
* execute. */
int flags, /* Collection of OR-ed bits that control the
* evaluation of the script. Supported values
* are TCL_EVAL_GLOBAL and TCL_EVAL_DIRECT. */
const CmdFrame *invoker, /* Frame of the command doing the eval. */
Tcl_Size word) /* Index of the word which is in objPtr. */
{
int result = TCL_OK;
NRE_callback *rootPtr = TOP_CB(interp);
result = TclNREvalObjEx(interp, objPtr, flags, invoker, word);
return TclNRRunCallbacks(interp, result, rootPtr);
}
int
TclNREvalObjEx(
Tcl_Interp *interp, /* Token for command interpreter (returned by
* a previous call to Tcl_CreateInterp). */
Tcl_Obj *objPtr, /* Pointer to object containing commands to
* execute. */
int flags, /* Collection of OR-ed bits that control the
* evaluation of the script. Supported values
* are TCL_EVAL_GLOBAL and TCL_EVAL_DIRECT. */
const CmdFrame *invoker, /* Frame of the command doing the eval. */
Tcl_Size word) /* Index of the word which is in objPtr. */
{
Interp *iPtr = (Interp *) interp;
int result;
/*
* This function consists of three independent blocks for: direct
* evaluation of canonical lists, compilation and bytecode execution and
|
| ︙ | ︙ | |||
6665 6666 6667 6668 6669 6670 6671 |
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"illegal argument vector", TCL_INDEX_NONE));
return TCL_ERROR;
}
if (flags != TCL_INVOKE_HIDDEN) {
Tcl_Panic("TclObjInvoke: called without just TCL_INVOKE_HIDDEN");
}
| | | | 6666 6667 6668 6669 6670 6671 6672 6673 6674 6675 6676 6677 6678 6679 6680 6681 6682 6683 6684 6685 6686 6687 |
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"illegal argument vector", TCL_INDEX_NONE));
return TCL_ERROR;
}
if (flags != TCL_INVOKE_HIDDEN) {
Tcl_Panic("TclObjInvoke: called without just TCL_INVOKE_HIDDEN");
}
return Tcl_NRCallObjProc2(interp, TclNRInvoke, NULL, objc, objv);
}
int
TclNRInvoke(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const objv[])
{
Interp *iPtr = (Interp *) interp;
Tcl_HashTable *hTblPtr; /* Table of hidden commands. */
const char *cmdName; /* Name of the command from objv[0]. */
Tcl_HashEntry *hPtr = NULL;
Command *cmdPtr;
|
| ︙ | ︙ | |||
7003 7004 7005 7006 7007 7008 7009 |
*/
static int
ExprCeilFunc(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* The interpreter in which to execute the
* function. */
| | | 7004 7005 7006 7007 7008 7009 7010 7011 7012 7013 7014 7015 7016 7017 7018 |
*/
static int
ExprCeilFunc(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* The interpreter in which to execute the
* function. */
Tcl_Size objc, /* Actual parameter count. */
Tcl_Obj *const *objv) /* Actual parameter list. */
{
int code;
double d;
mp_int big;
if (objc != 2) {
|
| ︙ | ︙ | |||
7043 7044 7045 7046 7047 7048 7049 |
}
static int
ExprFloorFunc(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* The interpreter in which to execute the
* function. */
| | | 7044 7045 7046 7047 7048 7049 7050 7051 7052 7053 7054 7055 7056 7057 7058 |
}
static int
ExprFloorFunc(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* The interpreter in which to execute the
* function. */
Tcl_Size objc, /* Actual parameter count. */
Tcl_Obj *const *objv) /* Actual parameter list. */
{
int code;
double d;
mp_int big;
if (objc != 2) {
|
| ︙ | ︙ | |||
7082 7083 7084 7085 7086 7087 7088 |
return TCL_OK;
}
static int
ExprIsqrtFunc(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* The interpreter in which to execute. */
| | | 7083 7084 7085 7086 7087 7088 7089 7090 7091 7092 7093 7094 7095 7096 7097 |
return TCL_OK;
}
static int
ExprIsqrtFunc(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* The interpreter in which to execute. */
Tcl_Size objc, /* Actual parameter count. */
Tcl_Obj *const *objv) /* Actual parameter list. */
{
void *ptr;
int type;
double d;
Tcl_WideInt w;
mp_int big;
|
| ︙ | ︙ | |||
7189 7190 7191 7192 7193 7194 7195 |
}
static int
ExprSqrtFunc(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* The interpreter in which to execute the
* function. */
| | | 7190 7191 7192 7193 7194 7195 7196 7197 7198 7199 7200 7201 7202 7203 7204 |
}
static int
ExprSqrtFunc(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* The interpreter in which to execute the
* function. */
Tcl_Size objc, /* Actual parameter count. */
Tcl_Obj *const *objv) /* Actual parameter list. */
{
int code;
double d;
mp_int big;
if (objc != 2) {
|
| ︙ | ︙ | |||
7243 7244 7245 7246 7247 7248 7249 |
static int
ExprUnaryFunc(
void *clientData, /* Contains the address of a function that
* takes one double argument and returns a
* double result. */
Tcl_Interp *interp, /* The interpreter in which to execute the
* function. */
| | | 7244 7245 7246 7247 7248 7249 7250 7251 7252 7253 7254 7255 7256 7257 7258 |
static int
ExprUnaryFunc(
void *clientData, /* Contains the address of a function that
* takes one double argument and returns a
* double result. */
Tcl_Interp *interp, /* The interpreter in which to execute the
* function. */
Tcl_Size objc, /* Actual parameter count */
Tcl_Obj *const *objv) /* Actual parameter list */
{
int code;
double d;
BuiltinUnaryFunc *func = (BuiltinUnaryFunc *) clientData;
if (objc != 2) {
|
| ︙ | ︙ | |||
7307 7308 7309 7310 7311 7312 7313 |
static int
ExprBinaryFunc(
void *clientData, /* Contains the address of a function that
* takes two double arguments and returns a
* double result. */
Tcl_Interp *interp, /* The interpreter in which to execute the
* function. */
| | | 7308 7309 7310 7311 7312 7313 7314 7315 7316 7317 7318 7319 7320 7321 7322 |
static int
ExprBinaryFunc(
void *clientData, /* Contains the address of a function that
* takes two double arguments and returns a
* double result. */
Tcl_Interp *interp, /* The interpreter in which to execute the
* function. */
Tcl_Size objc, /* Actual parameter count. */
Tcl_Obj *const *objv) /* Parameter vector. */
{
int code;
double d1, d2;
BuiltinBinaryFunc *func = (BuiltinBinaryFunc *)clientData;
if (objc != 3) {
|
| ︙ | ︙ | |||
7357 7358 7359 7360 7361 7362 7363 |
}
static int
ExprAbsFunc(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* The interpreter in which to execute the
* function. */
| | | 7358 7359 7360 7361 7362 7363 7364 7365 7366 7367 7368 7369 7370 7371 7372 |
}
static int
ExprAbsFunc(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* The interpreter in which to execute the
* function. */
Tcl_Size objc, /* Actual parameter count. */
Tcl_Obj *const *objv) /* Parameter vector. */
{
void *ptr;
int type;
mp_int big;
if (objc != 2) {
|
| ︙ | ︙ | |||
7466 7467 7468 7469 7470 7471 7472 |
}
static int
ExprBoolFunc(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* The interpreter in which to execute the
* function. */
| | | | 7467 7468 7469 7470 7471 7472 7473 7474 7475 7476 7477 7478 7479 7480 7481 7482 7483 7484 7485 7486 7487 7488 7489 7490 7491 7492 7493 7494 7495 7496 7497 7498 7499 7500 7501 7502 |
}
static int
ExprBoolFunc(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* The interpreter in which to execute the
* function. */
Tcl_Size objc, /* Actual parameter count. */
Tcl_Obj *const *objv) /* Actual parameter vector. */
{
int value;
if (objc != 2) {
MathFuncWrongNumArgs(interp, 2, objc, objv);
return TCL_ERROR;
}
if (Tcl_GetBooleanFromObj(interp, objv[1], &value) != TCL_OK) {
return TCL_ERROR;
}
Tcl_SetObjResult(interp, Tcl_NewBooleanObj(value));
return TCL_OK;
}
static int
ExprDoubleFunc(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* The interpreter in which to execute the
* function. */
Tcl_Size objc, /* Actual parameter count. */
Tcl_Obj *const *objv) /* Actual parameter vector. */
{
double dResult;
if (objc != 2) {
MathFuncWrongNumArgs(interp, 2, objc, objv);
return TCL_ERROR;
|
| ︙ | ︙ | |||
7514 7515 7516 7517 7518 7519 7520 |
}
static int
ExprIntFunc(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* The interpreter in which to execute the
* function. */
| | | 7515 7516 7517 7518 7519 7520 7521 7522 7523 7524 7525 7526 7527 7528 7529 |
}
static int
ExprIntFunc(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* The interpreter in which to execute the
* function. */
Tcl_Size objc, /* Actual parameter count. */
Tcl_Obj *const *objv) /* Actual parameter vector. */
{
double d;
int type;
void *ptr;
if (objc != 2) {
|
| ︙ | ︙ | |||
7570 7571 7572 7573 7574 7575 7576 |
}
static int
ExprWideFunc(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* The interpreter in which to execute the
* function. */
| | | | | 7571 7572 7573 7574 7575 7576 7577 7578 7579 7580 7581 7582 7583 7584 7585 7586 7587 7588 7589 7590 7591 7592 7593 7594 7595 7596 7597 7598 7599 7600 7601 7602 7603 7604 7605 7606 7607 7608 7609 7610 7611 7612 7613 |
}
static int
ExprWideFunc(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* The interpreter in which to execute the
* function. */
Tcl_Size objc, /* Actual parameter count. */
Tcl_Obj *const *objv) /* Actual parameter vector. */
{
Tcl_WideInt wResult;
if (ExprIntFunc(NULL, interp, objc, objv) != TCL_OK) {
return TCL_ERROR;
}
TclGetWideBitsFromObj(NULL, Tcl_GetObjResult(interp), &wResult);
Tcl_SetObjResult(interp, Tcl_NewWideIntObj(wResult));
return TCL_OK;
}
/*
* Common implmentation of max() and min().
*/
static int
ExprMaxMinFunc(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* The interpreter in which to execute the
* function. */
Tcl_Size objc, /* Actual parameter count. */
Tcl_Obj *const *objv, /* Actual parameter vector. */
int op) /* Comparison direction */
{
Tcl_Obj *res;
double d;
int type;
Tcl_Size i;
void *ptr;
if (objc < 2) {
MathFuncWrongNumArgs(interp, 2, objc, objv);
return TCL_ERROR;
}
res = objv[1];
|
| ︙ | ︙ | |||
7632 7633 7634 7635 7636 7637 7638 |
}
static int
ExprMaxFunc(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* The interpreter in which to execute the
* function. */
| | | | | 7633 7634 7635 7636 7637 7638 7639 7640 7641 7642 7643 7644 7645 7646 7647 7648 7649 7650 7651 7652 7653 7654 7655 7656 7657 7658 7659 7660 7661 7662 7663 7664 7665 7666 7667 7668 7669 |
}
static int
ExprMaxFunc(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* The interpreter in which to execute the
* function. */
Tcl_Size objc, /* Actual parameter count. */
Tcl_Obj *const *objv) /* Actual parameter vector. */
{
return ExprMaxMinFunc(NULL, interp, objc, objv, MP_GT);
}
static int
ExprMinFunc(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* The interpreter in which to execute the
* function. */
Tcl_Size objc, /* Actual parameter count. */
Tcl_Obj *const *objv) /* Actual parameter vector. */
{
return ExprMaxMinFunc(NULL, interp, objc, objv, MP_LT);
}
static int
ExprRandFunc(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* The interpreter in which to execute the
* function. */
Tcl_Size objc, /* Actual parameter count. */
Tcl_Obj *const *objv) /* Actual parameter vector. */
{
Interp *iPtr = (Interp *) interp;
double dResult;
long tmp; /* Algorithm assumes at least 32 bits. Only
* long guarantees that. See below. */
Tcl_Obj *oResult;
|
| ︙ | ︙ | |||
7747 7748 7749 7750 7751 7752 7753 |
}
static int
ExprRoundFunc(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* The interpreter in which to execute the
* function. */
| | | 7748 7749 7750 7751 7752 7753 7754 7755 7756 7757 7758 7759 7760 7761 7762 |
}
static int
ExprRoundFunc(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* The interpreter in which to execute the
* function. */
Tcl_Size objc, /* Actual parameter count. */
Tcl_Obj *const *objv) /* Parameter vector. */
{
double d;
void *ptr;
int type;
if (objc != 2) {
|
| ︙ | ︙ | |||
7826 7827 7828 7829 7830 7831 7832 |
}
static int
ExprSrandFunc(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* The interpreter in which to execute the
* function. */
| | | 7827 7828 7829 7830 7831 7832 7833 7834 7835 7836 7837 7838 7839 7840 7841 |
}
static int
ExprSrandFunc(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* The interpreter in which to execute the
* function. */
Tcl_Size objc, /* Actual parameter count. */
Tcl_Obj *const *objv) /* Parameter vector. */
{
Interp *iPtr = (Interp *) interp;
Tcl_WideInt w = 0; /* Initialized to avoid compiler warning. */
/*
* Convert argument and use it to reset the seed.
|
| ︙ | ︙ | |||
8045 8046 8047 8048 8049 8050 8051 |
}
*fpClsPtr = ClassifyDouble(d);
return TCL_OK;
}
static inline int
DoubleObjIsClass(
Tcl_Interp *interp,
| | | 8046 8047 8048 8049 8050 8051 8052 8053 8054 8055 8056 8057 8058 8059 8060 |
}
*fpClsPtr = ClassifyDouble(d);
return TCL_OK;
}
static inline int
DoubleObjIsClass(
Tcl_Interp *interp,
Tcl_Size objc, /* Actual parameter count */
Tcl_Obj *const *objv, /* Actual parameter list */
int cmpCls, /* FP class to compare. */
int positive) /* 1 if compare positive, 0 - otherwise */
{
int dCls;
if (objc != 2) {
|
| ︙ | ︙ | |||
8074 8075 8076 8077 8078 8079 8080 |
}
static int
ExprIsFiniteFunc(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* The interpreter in which to execute the
* function. */
| | | | | | | | 8075 8076 8077 8078 8079 8080 8081 8082 8083 8084 8085 8086 8087 8088 8089 8090 8091 8092 8093 8094 8095 8096 8097 8098 8099 8100 8101 8102 8103 8104 8105 8106 8107 8108 8109 8110 8111 8112 8113 8114 8115 8116 8117 8118 8119 8120 8121 8122 8123 8124 8125 8126 8127 8128 8129 8130 8131 8132 8133 8134 8135 8136 8137 8138 8139 8140 8141 8142 8143 8144 |
}
static int
ExprIsFiniteFunc(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* The interpreter in which to execute the
* function. */
Tcl_Size objc, /* Actual parameter count */
Tcl_Obj *const *objv) /* Actual parameter list */
{
return DoubleObjIsClass(interp, objc, objv, FP_INFINITE, 0);
}
static int
ExprIsInfinityFunc(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* The interpreter in which to execute the
* function. */
Tcl_Size objc, /* Actual parameter count */
Tcl_Obj *const *objv) /* Actual parameter list */
{
return DoubleObjIsClass(interp, objc, objv, FP_INFINITE, 1);
}
static int
ExprIsNaNFunc(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* The interpreter in which to execute the
* function. */
Tcl_Size objc, /* Actual parameter count */
Tcl_Obj *const *objv) /* Actual parameter list */
{
return DoubleObjIsClass(interp, objc, objv, FP_NAN, 1);
}
static int
ExprIsNormalFunc(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* The interpreter in which to execute the
* function. */
Tcl_Size objc, /* Actual parameter count */
Tcl_Obj *const *objv) /* Actual parameter list */
{
return DoubleObjIsClass(interp, objc, objv, FP_NORMAL, 1);
}
static int
ExprIsSubnormalFunc(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* The interpreter in which to execute the
* function. */
Tcl_Size objc, /* Actual parameter count */
Tcl_Obj *const *objv) /* Actual parameter list */
{
return DoubleObjIsClass(interp, objc, objv, FP_SUBNORMAL, 1);
}
static int
ExprIsUnorderedFunc(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* The interpreter in which to execute the
* function. */
Tcl_Size objc, /* Actual parameter count */
Tcl_Obj *const *objv) /* Actual parameter list */
{
int dCls, dCls2;
if (objc != 3) {
MathFuncWrongNumArgs(interp, 3, objc, objv);
return TCL_ERROR;
|
| ︙ | ︙ | |||
8154 8155 8156 8157 8158 8159 8160 |
}
static int
FloatClassifyObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* The interpreter in which to execute the
* function. */
| | | 8155 8156 8157 8158 8159 8160 8161 8162 8163 8164 8165 8166 8167 8168 8169 |
}
static int
FloatClassifyObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* The interpreter in which to execute the
* function. */
Tcl_Size objc, /* Actual parameter count */
Tcl_Obj *const *objv) /* Actual parameter list */
{
double d;
Tcl_Obj *objPtr;
void *ptr;
int type;
|
| ︙ | ︙ | |||
8262 8263 8264 8265 8266 8267 8268 |
*----------------------------------------------------------------------
*/
static int
DTraceObjCmd(
TCL_UNUSED(void *),
TCL_UNUSED(Tcl_Interp *),
| | | 8263 8264 8265 8266 8267 8268 8269 8270 8271 8272 8273 8274 8275 8276 8277 |
*----------------------------------------------------------------------
*/
static int
DTraceObjCmd(
TCL_UNUSED(void *),
TCL_UNUSED(Tcl_Interp *),
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
if (TCL_DTRACE_TCL_PROBE_ENABLED()) {
char *a[10];
int i = 0;
while (i++ < 10) {
|
| ︙ | ︙ | |||
8405 8406 8407 8408 8409 8410 8411 | * Side effects: * Depends on the objProc. * *---------------------------------------------------------------------- */ int | | | > | | < < < | > | | > | | | > | > > | > > > > > > > > | > > > > > > > > > > > > | > | > > > > > > > > < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | | | | | | 8406 8407 8408 8409 8410 8411 8412 8413 8414 8415 8416 8417 8418 8419 8420 8421 8422 8423 8424 8425 8426 8427 8428 8429 8430 8431 8432 8433 8434 8435 8436 8437 8438 8439 8440 8441 8442 8443 8444 8445 8446 8447 8448 8449 8450 8451 8452 8453 8454 8455 8456 8457 8458 8459 8460 8461 8462 8463 8464 8465 8466 8467 8468 8469 8470 8471 8472 8473 8474 8475 8476 8477 8478 8479 8480 8481 8482 8483 8484 8485 8486 8487 8488 8489 8490 8491 8492 8493 8494 8495 8496 8497 8498 8499 8500 8501 8502 8503 8504 8505 8506 8507 8508 8509 8510 8511 8512 8513 8514 8515 8516 8517 8518 8519 8520 8521 8522 8523 8524 8525 8526 8527 8528 8529 8530 8531 8532 8533 8534 8535 8536 8537 8538 8539 8540 8541 8542 8543 8544 8545 8546 8547 8548 8549 8550 8551 8552 8553 8554 8555 8556 8557 8558 8559 8560 8561 8562 8563 8564 8565 8566 8567 8568 8569 8570 8571 8572 8573 8574 8575 8576 8577 8578 8579 8580 8581 8582 8583 8584 8585 8586 8587 8588 8589 8590 |
* Side effects:
* Depends on the objProc.
*
*----------------------------------------------------------------------
*/
int
Tcl_NRCallObjProc2(
Tcl_Interp *interp,
Tcl_ObjCmdProc2 *objProc,
void *clientData,
Tcl_Size objc,
Tcl_Obj *const objv[])
{
NRE_callback *rootPtr = TOP_CB(interp);
TclNRAddCallback(interp, Dispatch, objProc, clientData,
INT2PTR(objc), objv);
return TclNRRunCallbacks(interp, TCL_OK, rootPtr);
}
#ifndef TCL_NO_DEPRECATED
static int
WrapperNRObjProc(
void *clientData,
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const objv[])
{
CmdWrapperInfo *info = (CmdWrapperInfo *) clientData;
clientData = info->clientData;
Tcl_ObjCmdProc *proc = info->proc;
Tcl_Free(info);
return proc(clientData, interp, (int)objc, objv);
}
#undef Tcl_NRCallObjProc
int
Tcl_NRCallObjProc(
Tcl_Interp *interp,
Tcl_ObjCmdProc *objProc,
void *clientData,
Tcl_Size objc,
Tcl_Obj *const objv[])
{
if (objc > INT_MAX) {
Tcl_WrongNumArgs(interp, 1, objv, "?args?");
return TCL_ERROR;
}
NRE_callback *rootPtr = TOP_CB(interp);
CmdWrapperInfo *info = (CmdWrapperInfo *)Tcl_Alloc(sizeof(CmdWrapperInfo));
info->clientData = clientData;
info->proc = objProc;
TclNRAddCallback(interp, Dispatch, WrapperNRObjProc, info,
INT2PTR(objc), objv);
return TclNRRunCallbacks(interp, TCL_OK, rootPtr);
}
#endif /* TCL_NO_DEPRECATED */
/*
*----------------------------------------------------------------------
*
* Tcl_NRCreateCommand --
*
* Define a new NRE-enabled object-based command in a command table.
*
* Results:
* The return value is a token for the command, which can be used in
* future calls to Tcl_GetCommandName.
*
* Side effects:
* If no command named "cmdName" already exists for interp, one is
* created. Otherwise, if a command does exist, then if the object-based
* Tcl_ObjCmdProc2 is InvokeStringCommand, we assume Tcl_CreateCommand
* was called previously for the same command and just set its
* Tcl_ObjCmdProc2 to the argument "proc"; otherwise, we delete the old
* command.
*
* In the future, during bytecode evaluation when "cmdName" is seen as
* the name of a command by Tcl_EvalObj or Tcl_Eval, the object-based
* Tcl_ObjCmdProc2 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.
*
*----------------------------------------------------------------------
*/
#ifndef TCL_NO_DEPRECATED
static int
CmdWrapperNreProc(
void *clientData,
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const objv[])
{
CmdWrapperInfo *info = (CmdWrapperInfo *) clientData;
return info->nreProc(info->clientData, interp, (int)objc, objv);
}
#undef Tcl_NRCreateCommand
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
* the global namespace. */
Tcl_ObjCmdProc *proc, /* Object-based function to associate with
* name, provides direct access for direct
* calls. */
Tcl_ObjCmdProc *nreProc, /* Object-based function to associate with
* name, provides NR implementation */
void *clientData, /* Arbitrary value to pass to object
* function. */
Tcl_CmdDeleteProc *deleteProc)
/* If not NULL, gives a function to call when
* this command is deleted. */
{
CmdWrapperInfo *info = (CmdWrapperInfo *)Tcl_Alloc(sizeof(CmdWrapperInfo));
info->proc = proc;
info->clientData = clientData;
info->nreProc = nreProc;
info->deleteProc = deleteProc;
info->deleteData = clientData;
return Tcl_NRCreateCommand2(interp, cmdName,
(proc ? CmdWrapperProc : NULL),
(nreProc ? CmdWrapperNreProc : NULL),
info, CmdWrapperDeleteProc);
}
#endif /* TCL_NO_DEPRECATED */
Tcl_Command
Tcl_NRCreateCommand2(
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
* the global namespace. */
Tcl_ObjCmdProc2 *proc, /* Object-based function to associate with
* name, provides direct access for direct
* calls. */
Tcl_ObjCmdProc2 *nreProc, /* Object-based function to associate with
* name, provides NR implementation */
void *clientData, /* Arbitrary value to pass to object
* function. */
Tcl_CmdDeleteProc *deleteProc)
/* If not NULL, gives a function to call when
* this command is deleted. */
{
Command *cmdPtr = (Command *)
Tcl_CreateObjCommand2(interp, cmdName, proc, clientData,
deleteProc);
cmdPtr->nreProc2 = nreProc;
return (Tcl_Command) cmdPtr;
}
Tcl_Command
TclNRCreateCommandInNs(
Tcl_Interp *interp,
const char *cmdName,
Tcl_Namespace *nsPtr,
Tcl_ObjCmdProc2 *proc,
Tcl_ObjCmdProc2 *nreProc,
void *clientData,
Tcl_CmdDeleteProc *deleteProc)
{
Command *cmdPtr = (Command *)
TclCreateObjCommandInNs(interp, cmdName, nsPtr, proc, clientData,
deleteProc);
cmdPtr->nreProc2 = nreProc;
return (Tcl_Command) cmdPtr;
}
/****************************************************************************
* Stuff for the public api
****************************************************************************/
|
| ︙ | ︙ | |||
8733 8734 8735 8736 8737 8738 8739 |
*----------------------------------------------------------------------
*/
int
TclNRTailcallObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | 8734 8735 8736 8737 8738 8739 8740 8741 8742 8743 8744 8745 8746 8747 8748 |
*----------------------------------------------------------------------
*/
int
TclNRTailcallObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const objv[])
{
Interp *iPtr = (Interp *) interp;
if (objc < 1) {
Tcl_WrongNumArgs(interp, 1, objv, "?command? ?arg ...?");
return TCL_ERROR;
|
| ︙ | ︙ | |||
8895 8896 8897 8898 8899 8900 8901 |
#define iPtr ((Interp *) interp)
int
TclNRYieldObjCmd(
void *clientData,
Tcl_Interp *interp,
| | | 8896 8897 8898 8899 8900 8901 8902 8903 8904 8905 8906 8907 8908 8909 8910 |
#define iPtr ((Interp *) interp)
int
TclNRYieldObjCmd(
void *clientData,
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const objv[])
{
CoroutineData *corPtr = iPtr->execEnvPtr->corPtr;
if (objc > 2) {
Tcl_WrongNumArgs(interp, 1, objv, "?returnValue?");
return TCL_ERROR;
|
| ︙ | ︙ | |||
8926 8927 8928 8929 8930 8931 8932 |
return TCL_OK;
}
int
TclNRYieldToObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | 8927 8928 8929 8930 8931 8932 8933 8934 8935 8936 8937 8938 8939 8940 8941 |
return TCL_OK;
}
int
TclNRYieldToObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const objv[])
{
CoroutineData *corPtr = iPtr->execEnvPtr->corPtr;
Tcl_Namespace *nsPtr = TclGetCurrentNamespace(interp);
Tcl_Obj *listPtr;
if (objc < 2) {
|
| ︙ | ︙ | |||
9223 9224 9225 9226 9227 9228 9229 |
*----------------------------------------------------------------------
*/
static int
CoroTypeObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | | | 9224 9225 9226 9227 9228 9229 9230 9231 9232 9233 9234 9235 9236 9237 9238 9239 9240 9241 9242 9243 9244 9245 9246 9247 9248 9249 9250 9251 9252 9253 9254 9255 9256 9257 9258 9259 9260 9261 9262 9263 9264 9265 9266 9267 |
*----------------------------------------------------------------------
*/
static int
CoroTypeObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const objv[])
{
Command *cmdPtr;
CoroutineData *corPtr;
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "coroName");
return TCL_ERROR;
}
/*
* Look up the coroutine.
*/
cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, objv[1]);
if ((!cmdPtr) || (cmdPtr->nreProc2 != TclNRInterpCoroutine)) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"can only get coroutine type of a coroutine", TCL_INDEX_NONE));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COROUTINE",
TclGetString(objv[1]), (char *)NULL);
return TCL_ERROR;
}
/*
* An active coroutine is "active". Can't tell what it might do in the
* future.
*/
corPtr = (CoroutineData *)cmdPtr->objClientData2;
if (!COR_IS_SUSPENDED(corPtr)) {
Tcl_SetObjResult(interp, Tcl_NewStringObj("active", TCL_INDEX_NONE));
return TCL_OK;
}
/*
* Inactive coroutines are classified by the (effective) command used to
|
| ︙ | ︙ | |||
9300 9301 9302 9303 9304 9305 9306 |
{
/*
* How to get a coroutine from its handle.
*/
Command *cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, objPtr);
| | | | | 9301 9302 9303 9304 9305 9306 9307 9308 9309 9310 9311 9312 9313 9314 9315 9316 9317 9318 9319 9320 9321 9322 9323 9324 9325 9326 9327 9328 |
{
/*
* How to get a coroutine from its handle.
*/
Command *cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, objPtr);
if ((!cmdPtr) || (cmdPtr->nreProc2 != TclNRInterpCoroutine)) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(errMsg, TCL_INDEX_NONE));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COROUTINE",
TclGetString(objPtr), (char *)NULL);
return NULL;
}
return (CoroutineData *)cmdPtr->objClientData2;
}
static int
TclNRCoroInjectObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const objv[])
{
CoroutineData *corPtr;
/*
* Usage more or less like tailcall:
* coroinject coroName cmd ?arg1 arg2 ...?
|
| ︙ | ︙ | |||
9358 9359 9360 9361 9362 9363 9364 |
return TCL_OK;
}
static int
TclNRCoroProbeObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | 9359 9360 9361 9362 9363 9364 9365 9366 9367 9368 9369 9370 9371 9372 9373 |
return TCL_OK;
}
static int
TclNRCoroProbeObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const objv[])
{
CoroutineData *corPtr;
/*
* Usage more or less like tailcall:
* coroprobe coroName cmd ?arg1 arg2 ...?
|
| ︙ | ︙ | |||
9539 9540 9541 9542 9543 9544 9545 |
return result;
}
int
TclNRInterpCoroutine(
void *clientData,
Tcl_Interp *interp, /* Current interpreter. */
| | | 9540 9541 9542 9543 9544 9545 9546 9547 9548 9549 9550 9551 9552 9553 9554 |
return result;
}
int
TclNRInterpCoroutine(
void *clientData,
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
CoroutineData *corPtr = (CoroutineData *)clientData;
if (!COR_IS_SUSPENDED(corPtr)) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"coroutine \"%s\" is already running",
|
| ︙ | ︙ | |||
9603 9604 9605 9606 9607 9608 9609 |
*----------------------------------------------------------------------
*/
int
TclNRCoroutineObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 9604 9605 9606 9607 9608 9609 9610 9611 9612 9613 9614 9615 9616 9617 9618 |
*----------------------------------------------------------------------
*/
int
TclNRCoroutineObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Command *cmdPtr;
CoroutineData *corPtr;
const char *procName, *simpleName;
Namespace *nsPtr, *altNsPtr, *cxtNsPtr,
*inNsPtr = (Namespace *)TclGetCurrentNamespace(interp);
|
| ︙ | ︙ | |||
9736 9737 9738 9739 9740 9741 9742 |
* This is used in the [info] ensemble
*/
int
TclInfoCoroutineCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | 9737 9738 9739 9740 9741 9742 9743 9744 9745 9746 9747 9748 9749 9750 9751 |
* This is used in the [info] ensemble
*/
int
TclInfoCoroutineCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const objv[])
{
CoroutineData *corPtr = iPtr->execEnvPtr->corPtr;
if (objc != 1) {
Tcl_WrongNumArgs(interp, 1, objv, NULL);
return TCL_ERROR;
|
| ︙ | ︙ |
Changes to generic/tclBinary.c.
| ︙ | ︙ | |||
69 70 71 72 73 74 75 | Tcl_Obj *objPtr); static void UpdateStringOfByteArray(Tcl_Obj *listPtr); static void DeleteScanNumberCache(Tcl_HashTable *numberCachePtr); static int NeedReversing(int format); static void CopyNumber(const void *from, void *to, size_t length, int type); /* Binary ensemble commands */ | | | | | | | | | | 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 |
Tcl_Obj *objPtr);
static void UpdateStringOfByteArray(Tcl_Obj *listPtr);
static void DeleteScanNumberCache(Tcl_HashTable *numberCachePtr);
static int NeedReversing(int format);
static void CopyNumber(const void *from, void *to,
size_t length, int type);
/* Binary ensemble commands */
static Tcl_ObjCmdProc2 BinaryFormatCmd;
static Tcl_ObjCmdProc2 BinaryScanCmd;
/* Binary encoding sub-ensemble commands */
static Tcl_ObjCmdProc2 BinaryEncodeHex;
static Tcl_ObjCmdProc2 BinaryDecodeHex;
static Tcl_ObjCmdProc2 BinaryEncode64;
static Tcl_ObjCmdProc2 BinaryDecode64;
static Tcl_ObjCmdProc2 BinaryEncodeUu;
static Tcl_ObjCmdProc2 BinaryDecodeUu;
/*
* The following tables are used by the binary encoders
*/
static const char HexDigits[16] = {
'0', '1', '2', '3', '4', '5', '6', '7',
|
| ︙ | ︙ | |||
801 802 803 804 805 806 807 |
*----------------------------------------------------------------------
*/
static int
BinaryFormatCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 |
*----------------------------------------------------------------------
*/
static int
BinaryFormatCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_Size arg; /* Index of next argument to consume. */
int value = 0; /* Current integer value to be packed.
* Initialized to avoid compiler warning. */
char cmd; /* Current format character. */
Tcl_Size count; /* Count associated with current format
|
| ︙ | ︙ | |||
1313 1314 1315 1316 1317 1318 1319 |
*----------------------------------------------------------------------
*/
static int
BinaryScanCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 1313 1314 1315 1316 1317 1318 1319 1320 1321 1322 1323 1324 1325 1326 1327 |
*----------------------------------------------------------------------
*/
static int
BinaryScanCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_Size arg; /* Index of next argument to consume. */
int value = 0; /* Current integer value to be packed.
* Initialized to avoid compiler warning. */
char cmd; /* Current format character. */
Tcl_Size count; /* Count associated with current format
|
| ︙ | ︙ | |||
2397 2398 2399 2400 2401 2402 2403 |
*----------------------------------------------------------------------
*/
static int
BinaryEncodeHex(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | 2397 2398 2399 2400 2401 2402 2403 2404 2405 2406 2407 2408 2409 2410 2411 |
*----------------------------------------------------------------------
*/
static int
BinaryEncodeHex(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const objv[])
{
Tcl_Obj *resultObj = NULL;
unsigned char *data = NULL;
unsigned char *cursor = NULL;
Tcl_Size offset = 0, count = 0;
|
| ︙ | ︙ | |||
2445 2446 2447 2448 2449 2450 2451 |
*----------------------------------------------------------------------
*/
static int
BinaryDecodeHex(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | 2445 2446 2447 2448 2449 2450 2451 2452 2453 2454 2455 2456 2457 2458 2459 |
*----------------------------------------------------------------------
*/
static int
BinaryDecodeHex(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const objv[])
{
Tcl_Obj *resultObj = NULL;
unsigned char *data, *datastart, *dataend;
unsigned char *begin, *cursor, c;
int index, value, pure = 1, strict = 0;
Tcl_Size i, size, cut = 0, count = 0;
|
| ︙ | ︙ | |||
2572 2573 2574 2575 2576 2577 2578 |
} \
} while (0)
static int
BinaryEncode64(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | 2572 2573 2574 2575 2576 2577 2578 2579 2580 2581 2582 2583 2584 2585 2586 |
} \
} while (0)
static int
BinaryEncode64(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const objv[])
{
Tcl_Obj *resultObj;
unsigned char *data, *limit;
Tcl_WideInt maxlen = 0;
const char *wrapchar = "\n";
Tcl_Size i, wrapcharlen = 1;
|
| ︙ | ︙ | |||
2700 2701 2702 2703 2704 2705 2706 |
*----------------------------------------------------------------------
*/
static int
BinaryEncodeUu(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | 2700 2701 2702 2703 2704 2705 2706 2707 2708 2709 2710 2711 2712 2713 2714 |
*----------------------------------------------------------------------
*/
static int
BinaryEncodeUu(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const objv[])
{
Tcl_Obj *resultObj;
unsigned char *data, *start, *cursor;
int bits, lineLength = 61;
Tcl_Size rawLength;
const unsigned char SingleNewline[] = { UCHAR('\n') };
|
| ︙ | ︙ | |||
2849 2850 2851 2852 2853 2854 2855 |
*----------------------------------------------------------------------
*/
static int
BinaryDecodeUu(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | 2849 2850 2851 2852 2853 2854 2855 2856 2857 2858 2859 2860 2861 2862 2863 |
*----------------------------------------------------------------------
*/
static int
BinaryDecodeUu(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const objv[])
{
Tcl_Obj *resultObj = NULL;
unsigned char *data, *datastart, *dataend;
unsigned char *begin, *cursor;
int index, pure = 1, strict = 0, lineLen;
Tcl_Size i, size, count = 0;
|
| ︙ | ︙ | |||
3025 3026 3027 3028 3029 3030 3031 |
*----------------------------------------------------------------------
*/
static int
BinaryDecode64(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | 3025 3026 3027 3028 3029 3030 3031 3032 3033 3034 3035 3036 3037 3038 3039 |
*----------------------------------------------------------------------
*/
static int
BinaryDecode64(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const objv[])
{
Tcl_Obj *resultObj = NULL;
unsigned char *data, *datastart, *dataend, c = '\0';
unsigned char *begin = NULL;
unsigned char *cursor = NULL;
int pure = 1, strict = 0;
|
| ︙ | ︙ |
Changes to generic/tclCkalloc.c.
| ︙ | ︙ | |||
793 794 795 796 797 798 799 |
*
*----------------------------------------------------------------------
*/
static int
MemoryCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 |
*
*----------------------------------------------------------------------
*/
static int
MemoryCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Obj values of arguments. */
{
const char *fileName;
FILE *fileP;
Tcl_DString buffer;
Tcl_WideInt value;
int result, option;
|
| ︙ | ︙ | |||
963 964 965 966 967 968 969 |
*
*----------------------------------------------------------------------
*/
static int
CheckmemCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Interpreter for evaluation. */
| | | 963 964 965 966 967 968 969 970 971 972 973 974 975 976 977 |
*
*----------------------------------------------------------------------
*/
static int
CheckmemCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Interpreter for evaluation. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Obj values of arguments. */
{
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "fileName");
return TCL_ERROR;
}
tclMemDumpFileName = dumpFile;
|
| ︙ | ︙ | |||
997 998 999 1000 1001 1002 1003 |
void
Tcl_InitMemory(
Tcl_Interp *interp) /* Interpreter in which commands should be
* added */
{
TclInitDbCkalloc();
| | | | 997 998 999 1000 1001 1002 1003 1004 1005 1006 1007 1008 1009 1010 1011 1012 |
void
Tcl_InitMemory(
Tcl_Interp *interp) /* Interpreter in which commands should be
* added */
{
TclInitDbCkalloc();
Tcl_CreateObjCommand2(interp, "memory", MemoryCmd, NULL, NULL);
Tcl_CreateObjCommand2(interp, "checkmem", CheckmemCmd, NULL, NULL);
}
#else /* TCL_MEM_DEBUG */
/* This is the !TCL_MEM_DEBUG case */
#undef Tcl_InitMemory
|
| ︙ | ︙ |
Changes to generic/tclClock.c.
| ︙ | ︙ | |||
77 78 79 80 81 82 83 | static int ConvertLocalToUTC(ClockClientData *, Tcl_Interp *, TclDateFields *, Tcl_Obj *timezoneObj, int); static int ConvertLocalToUTCUsingTable(Tcl_Interp *, TclDateFields *, Tcl_Size, Tcl_Obj *const[], Tcl_WideInt *rangesVal); static int ConvertLocalToUTCUsingC(Tcl_Interp *, TclDateFields *, int); | | | | | | | | | | | | | | | | 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 122 123 124 125 126 127 128 129 130 131 132 133 134 135 |
static int ConvertLocalToUTC(ClockClientData *, Tcl_Interp *,
TclDateFields *, Tcl_Obj *timezoneObj, int);
static int ConvertLocalToUTCUsingTable(Tcl_Interp *,
TclDateFields *, Tcl_Size, Tcl_Obj *const[],
Tcl_WideInt *rangesVal);
static int ConvertLocalToUTCUsingC(Tcl_Interp *,
TclDateFields *, int);
static Tcl_ObjCmdProc2 ClockConfigureObjCmd;
static void GetYearWeekDay(TclDateFields *, int);
static void GetGregorianEraYearDay(TclDateFields *, int);
static void GetJulianDayFromEraYearMonthDay(
TclDateFields *fields, int changeover);
static void GetMonthDay(TclDateFields *);
static Tcl_WideInt WeekdayOnOrBefore(int, Tcl_WideInt);
static Tcl_ObjCmdProc2 ClockClicksObjCmd;
static Tcl_ObjCmdProc2 ClockConvertlocaltoutcObjCmd;
static int ClockGetDateFields(ClockClientData *,
Tcl_Interp *interp, TclDateFields *fields,
Tcl_Obj *timezoneObj, int changeover);
static void GetJulianDayFromEraYearWeekDay(
TclDateFields *fields, int changeover);
static Tcl_ObjCmdProc2 ClockGetdatefieldsObjCmd;
static Tcl_ObjCmdProc2 ClockGetjuliandayfromerayearmonthdayObjCmd;
static Tcl_ObjCmdProc2 ClockGetjuliandayfromerayearweekdayObjCmd;
static Tcl_ObjCmdProc2 ClockGetenvObjCmd;
static Tcl_ObjCmdProc2 ClockMicrosecondsObjCmd;
static Tcl_ObjCmdProc2 ClockMillisecondsObjCmd;
static Tcl_ObjCmdProc2 ClockSecondsObjCmd;
static Tcl_ObjCmdProc2 ClockFormatObjCmd;
static Tcl_ObjCmdProc2 ClockScanObjCmd;
static int ClockScanCommit(DateInfo *info,
ClockFmtScnCmdArgs *opts);
static int ClockFreeScan(DateInfo *info,
Tcl_Obj *strObj, ClockFmtScnCmdArgs *opts);
static int ClockCalcRelTime(DateInfo *info,
ClockFmtScnCmdArgs *opts);
static Tcl_ObjCmdProc2 ClockAddObjCmd;
static int ClockValidDate(DateInfo *,
ClockFmtScnCmdArgs *, int stage);
static struct tm * ThreadSafeLocalTime(const time_t *);
static size_t TzsetIfNecessary(void);
static void ClockDeleteCmdProc(void *);
static void ClockFinalize(void *);
/*
* Structure containing description of "native" clock commands to create.
*/
struct ClockCommand {
const char *name; /* The tail of the command name. The full name
* is "::tcl::clock::<name>". When NULL marks
* the end of the table. */
Tcl_ObjCmdProc2 *objCmdProc; /* Function that implements the command. This
* will always have the ClockClientData sent
* to it, but may well ignore this data. */
CompileProc *compileProc; /* The compiler for the command. */
int useClientData; /* Whether to use the shared ClockClientData
* with this command. */
};
|
| ︙ | ︙ | |||
278 279 280 281 282 283 284 |
data->refCount++;
}
Command *cmdPtr = (Command *)TclCreateObjCommandInNs(interp,
clockCmdPtr->name, nsPtr, clockCmdPtr->objCmdProc, clientData,
clientData ? ClockDeleteCmdProc : NULL);
cmdPtr->compileProc = clockCmdPtr->compileProc;
}
| | | 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 |
data->refCount++;
}
Command *cmdPtr = (Command *)TclCreateObjCommandInNs(interp,
clockCmdPtr->name, nsPtr, clockCmdPtr->objCmdProc, clientData,
clientData ? ClockDeleteCmdProc : NULL);
cmdPtr->compileProc = clockCmdPtr->compileProc;
}
Tcl_CreateObjCommand2(interp, "::tcl::unsupported::clock::configure",
ClockConfigureObjCmd, data, ClockDeleteCmdProc);
data->refCount++;
}
/*
*----------------------------------------------------------------------
*
|
| ︙ | ︙ | |||
961 962 963 964 965 966 967 |
*----------------------------------------------------------------------
*/
static int
ClockConfigureObjCmd(
void *clientData, /* Client data containing literal pool */
Tcl_Interp *interp, /* Tcl interpreter */
| | | 961 962 963 964 965 966 967 968 969 970 971 972 973 974 975 |
*----------------------------------------------------------------------
*/
static int
ClockConfigureObjCmd(
void *clientData, /* Client data containing literal pool */
Tcl_Interp *interp, /* Tcl interpreter */
Tcl_Size objc, /* Parameter count */
Tcl_Obj *const objv[]) /* Parameter vector */
{
ClockClientData *dataPtr = (ClockClientData *)clientData;
static const char *const options[] = {
"-default-locale", "-clear", "-current-locale",
"-year-century", "-century-switch",
"-min-year", "-max-year", "-max-jdn",
|
| ︙ | ︙ | |||
1396 1397 1398 1399 1400 1401 1402 |
*----------------------------------------------------------------------
*/
static int
ClockConvertlocaltoutcObjCmd(
void *clientData, /* Literal table */
Tcl_Interp *interp, /* Tcl interpreter */
| | | 1396 1397 1398 1399 1400 1401 1402 1403 1404 1405 1406 1407 1408 1409 1410 |
*----------------------------------------------------------------------
*/
static int
ClockConvertlocaltoutcObjCmd(
void *clientData, /* Literal table */
Tcl_Interp *interp, /* Tcl interpreter */
Tcl_Size objc, /* Parameter count */
Tcl_Obj *const *objv) /* Parameter vector */
{
ClockClientData *dataPtr = (ClockClientData *)clientData;
Tcl_Obj *secondsObj;
Tcl_Obj *dict;
int changeover;
TclDateFields fields;
|
| ︙ | ︙ | |||
1485 1486 1487 1488 1489 1490 1491 |
*----------------------------------------------------------------------
*/
int
ClockGetdatefieldsObjCmd(
void *clientData, /* Opaque pointer to literal pool, etc. */
Tcl_Interp *interp, /* Tcl interpreter */
| | | 1485 1486 1487 1488 1489 1490 1491 1492 1493 1494 1495 1496 1497 1498 1499 |
*----------------------------------------------------------------------
*/
int
ClockGetdatefieldsObjCmd(
void *clientData, /* Opaque pointer to literal pool, etc. */
Tcl_Interp *interp, /* Tcl interpreter */
Tcl_Size objc, /* Parameter count */
Tcl_Obj *const *objv) /* Parameter vector */
{
TclDateFields fields;
Tcl_Obj *dict;
ClockClientData *dataPtr = (ClockClientData *)clientData;
Tcl_Obj *const *lit = dataPtr->literals;
int changeover;
|
| ︙ | ︙ | |||
1679 1680 1681 1682 1683 1684 1685 |
return TclGetIntFromObj(interp, value, storePtr);
}
static int
ClockGetjuliandayfromerayearmonthdayObjCmd(
void *clientData, /* Opaque pointer to literal pool, etc. */
Tcl_Interp *interp, /* Tcl interpreter */
| | | 1679 1680 1681 1682 1683 1684 1685 1686 1687 1688 1689 1690 1691 1692 1693 |
return TclGetIntFromObj(interp, value, storePtr);
}
static int
ClockGetjuliandayfromerayearmonthdayObjCmd(
void *clientData, /* Opaque pointer to literal pool, etc. */
Tcl_Interp *interp, /* Tcl interpreter */
Tcl_Size objc, /* Parameter count */
Tcl_Obj *const *objv) /* Parameter vector */
{
TclDateFields fields;
Tcl_Obj *dict;
ClockClientData *data = (ClockClientData *)clientData;
Tcl_Obj *const *lit = data->literals;
int changeover;
|
| ︙ | ︙ | |||
1768 1769 1770 1771 1772 1773 1774 |
*----------------------------------------------------------------------
*/
static int
ClockGetjuliandayfromerayearweekdayObjCmd(
void *clientData, /* Opaque pointer to literal pool, etc. */
Tcl_Interp *interp, /* Tcl interpreter */
| | | 1768 1769 1770 1771 1772 1773 1774 1775 1776 1777 1778 1779 1780 1781 1782 |
*----------------------------------------------------------------------
*/
static int
ClockGetjuliandayfromerayearweekdayObjCmd(
void *clientData, /* Opaque pointer to literal pool, etc. */
Tcl_Interp *interp, /* Tcl interpreter */
Tcl_Size objc, /* Parameter count */
Tcl_Obj *const *objv) /* Parameter vector */
{
TclDateFields fields;
Tcl_Obj *dict;
ClockClientData *data = (ClockClientData *)clientData;
Tcl_Obj *const *lit = data->literals;
int changeover;
|
| ︙ | ︙ | |||
3018 3019 3020 3021 3022 3023 3024 |
*----------------------------------------------------------------------
*/
int
ClockGetenvObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | 3018 3019 3020 3021 3022 3023 3024 3025 3026 3027 3028 3029 3030 3031 3032 |
*----------------------------------------------------------------------
*/
int
ClockGetenvObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const objv[])
{
#ifdef _WIN32
const WCHAR *varName;
const WCHAR *varValue;
Tcl_DString ds;
#else
|
| ︙ | ︙ | |||
3122 3123 3124 3125 3126 3127 3128 |
*----------------------------------------------------------------------
*/
int
ClockClicksObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Tcl interpreter */
| | | 3122 3123 3124 3125 3126 3127 3128 3129 3130 3131 3132 3133 3134 3135 3136 |
*----------------------------------------------------------------------
*/
int
ClockClicksObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Tcl interpreter */
Tcl_Size objc, /* Parameter count */
Tcl_Obj *const *objv) /* Parameter values */
{
static const char *const clicksSwitches[] = {
"-milliseconds", "-microseconds", NULL
};
enum ClicksSwitch {
CLICKS_MILLIS, CLICKS_MICROS, CLICKS_NATIVE
|
| ︙ | ︙ | |||
3194 3195 3196 3197 3198 3199 3200 |
*----------------------------------------------------------------------
*/
int
ClockMillisecondsObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Tcl interpreter */
| | | 3194 3195 3196 3197 3198 3199 3200 3201 3202 3203 3204 3205 3206 3207 3208 |
*----------------------------------------------------------------------
*/
int
ClockMillisecondsObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Tcl interpreter */
Tcl_Size objc, /* Parameter count */
Tcl_Obj *const *objv) /* Parameter values */
{
Tcl_Time now;
Tcl_Obj *timeObj;
if (objc != 1) {
Tcl_WrongNumArgs(interp, 0, objv, "clock milliseconds");
|
| ︙ | ︙ | |||
3233 3234 3235 3236 3237 3238 3239 |
*----------------------------------------------------------------------
*/
int
ClockMicrosecondsObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Tcl interpreter */
| | | 3233 3234 3235 3236 3237 3238 3239 3240 3241 3242 3243 3244 3245 3246 3247 |
*----------------------------------------------------------------------
*/
int
ClockMicrosecondsObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Tcl interpreter */
Tcl_Size objc, /* Parameter count */
Tcl_Obj *const *objv) /* Parameter values */
{
if (objc != 1) {
Tcl_WrongNumArgs(interp, 0, objv, "clock microseconds");
return TCL_ERROR;
}
Tcl_SetObjResult(interp, Tcl_NewWideIntObj(TclpGetMicroseconds()));
|
| ︙ | ︙ | |||
3529 3530 3531 3532 3533 3534 3535 |
*----------------------------------------------------------------------
*/
int
ClockFormatObjCmd(
void *clientData, /* Client data containing literal pool */
Tcl_Interp *interp, /* Tcl interpreter */
| | | 3529 3530 3531 3532 3533 3534 3535 3536 3537 3538 3539 3540 3541 3542 3543 |
*----------------------------------------------------------------------
*/
int
ClockFormatObjCmd(
void *clientData, /* Client data containing literal pool */
Tcl_Interp *interp, /* Tcl interpreter */
Tcl_Size objc, /* Parameter count */
Tcl_Obj *const objv[]) /* Parameter values */
{
ClockClientData *dataPtr = (ClockClientData *)clientData;
static const char *syntax = "clock format clockval|now "
"?-format string? "
"?-gmt boolean? "
"?-locale LOCALE? ?-timezone ZONE?";
|
| ︙ | ︙ | |||
3598 3599 3600 3601 3602 3603 3604 |
*----------------------------------------------------------------------
*/
int
ClockScanObjCmd(
void *clientData, /* Client data containing literal pool */
Tcl_Interp *interp, /* Tcl interpreter */
| | | 3598 3599 3600 3601 3602 3603 3604 3605 3606 3607 3608 3609 3610 3611 3612 |
*----------------------------------------------------------------------
*/
int
ClockScanObjCmd(
void *clientData, /* Client data containing literal pool */
Tcl_Interp *interp, /* Tcl interpreter */
Tcl_Size objc, /* Parameter count */
Tcl_Obj *const objv[]) /* Parameter values */
{
ClockClientData *dataPtr = (ClockClientData *)clientData;
static const char *syntax = "clock scan string "
"?-base seconds? "
"?-format string? "
"?-gmt boolean? "
|
| ︙ | ︙ | |||
4450 4451 4452 4453 4454 4455 4456 |
*----------------------------------------------------------------------
*/
int
ClockAddObjCmd(
void *clientData, /* Client data containing literal pool */
Tcl_Interp *interp, /* Tcl interpreter */
| | | 4450 4451 4452 4453 4454 4455 4456 4457 4458 4459 4460 4461 4462 4463 4464 |
*----------------------------------------------------------------------
*/
int
ClockAddObjCmd(
void *clientData, /* Client data containing literal pool */
Tcl_Interp *interp, /* Tcl interpreter */
Tcl_Size objc, /* Parameter count */
Tcl_Obj *const objv[]) /* Parameter values */
{
static const char *syntax = "clock add clockval|now ?number units?..."
"?-gmt boolean? "
"?-locale LOCALE? ?-timezone ZONE?";
ClockClientData *dataPtr = (ClockClientData *)clientData;
int ret;
|
| ︙ | ︙ | |||
4633 4634 4635 4636 4637 4638 4639 |
*----------------------------------------------------------------------
*/
int
ClockSecondsObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Tcl interpreter */
| | | 4633 4634 4635 4636 4637 4638 4639 4640 4641 4642 4643 4644 4645 4646 4647 |
*----------------------------------------------------------------------
*/
int
ClockSecondsObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Tcl interpreter */
Tcl_Size objc, /* Parameter count */
Tcl_Obj *const *objv) /* Parameter values */
{
Tcl_Time now;
Tcl_Obj *timeObj;
if (objc != 1) {
Tcl_WrongNumArgs(interp, 0, objv, "clock seconds");
|
| ︙ | ︙ |
Changes to generic/tclCmdAH.c.
| ︙ | ︙ | |||
43 44 45 46 47 48 49 | /* * Prototypes for local procedures defined in this file: */ static int CheckAccess(Tcl_Interp *interp, Tcl_Obj *pathPtr, int mode); | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 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 |
/*
* Prototypes for local procedures defined in this file:
*/
static int CheckAccess(Tcl_Interp *interp, Tcl_Obj *pathPtr,
int mode);
static Tcl_ObjCmdProc2 EncodingConvertfromObjCmd;
static Tcl_ObjCmdProc2 EncodingConverttoObjCmd;
static Tcl_ObjCmdProc2 EncodingDirsObjCmd;
static Tcl_ObjCmdProc2 EncodingNamesObjCmd;
static Tcl_ObjCmdProc2 EncodingProfilesObjCmd;
static Tcl_ObjCmdProc2 EncodingSystemObjCmd;
static Tcl_ObjCmdProc2 EncodingUserObjCmd;
static inline int ForeachAssignments(Tcl_Interp *interp,
struct ForeachState *statePtr);
static inline void ForeachCleanup(Tcl_Interp *interp,
struct ForeachState *statePtr);
static int GetStatBuf(Tcl_Interp *interp, Tcl_Obj *pathPtr,
Tcl_FSStatProc *statProc, Tcl_StatBuf *statPtr);
static const char * GetTypeFromMode(int mode);
static int StoreStatData(Tcl_Interp *interp, Tcl_Obj *varName,
Tcl_StatBuf *statPtr);
static int EachloopCmd(Tcl_Interp *interp, int collect,
Tcl_Size objc, Tcl_Obj *const objv[]);
static Tcl_NRPostProc CatchObjCmdCallback;
static Tcl_NRPostProc ExprCallback;
static Tcl_NRPostProc ForSetupCallback;
static Tcl_NRPostProc ForCondCallback;
static Tcl_NRPostProc ForNextCallback;
static Tcl_NRPostProc ForPostNextCallback;
static Tcl_NRPostProc ForeachLoopStep;
static Tcl_NRPostProc EvalCmdErrMsg;
static Tcl_ObjCmdProc2 FileAttrAccessTimeCmd;
static Tcl_ObjCmdProc2 FileAttrIsDirectoryCmd;
static Tcl_ObjCmdProc2 FileAttrIsExecutableCmd;
static Tcl_ObjCmdProc2 FileAttrIsExistingCmd;
static Tcl_ObjCmdProc2 FileAttrIsFileCmd;
static Tcl_ObjCmdProc2 FileAttrIsOwnedCmd;
static Tcl_ObjCmdProc2 FileAttrIsReadableCmd;
static Tcl_ObjCmdProc2 FileAttrIsWritableCmd;
static Tcl_ObjCmdProc2 FileAttrLinkStatCmd;
static Tcl_ObjCmdProc2 FileAttrModifyTimeCmd;
static Tcl_ObjCmdProc2 FileAttrSizeCmd;
static Tcl_ObjCmdProc2 FileAttrStatCmd;
static Tcl_ObjCmdProc2 FileAttrTypeCmd;
static Tcl_ObjCmdProc2 FilesystemSeparatorCmd;
static Tcl_ObjCmdProc2 FilesystemVolumesCmd;
static Tcl_ObjCmdProc2 PathDirNameCmd;
static Tcl_ObjCmdProc2 PathExtensionCmd;
static Tcl_ObjCmdProc2 PathFilesystemCmd;
static Tcl_ObjCmdProc2 PathJoinCmd;
static Tcl_ObjCmdProc2 PathNativeNameCmd;
static Tcl_ObjCmdProc2 PathNormalizeCmd;
static Tcl_ObjCmdProc2 PathRootNameCmd;
static Tcl_ObjCmdProc2 PathSplitCmd;
static Tcl_ObjCmdProc2 PathTailCmd;
static Tcl_ObjCmdProc2 PathTypeCmd;
const EnsembleImplMap tclEncodingImplMap[] = {
{"convertfrom", EncodingConvertfromObjCmd, TclCompileBasic1To3ArgCmd, NULL, NULL, 0},
{"convertto", EncodingConverttoObjCmd, TclCompileBasic1To3ArgCmd, NULL, NULL, 0},
{"dirs", EncodingDirsObjCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 1},
{"names", EncodingNamesObjCmd, TclCompileBasic0ArgCmd, NULL, NULL, 0},
{"profiles", EncodingProfilesObjCmd, TclCompileBasic0ArgCmd, NULL, NULL, 0},
|
| ︙ | ︙ | |||
173 174 175 176 177 178 179 |
*----------------------------------------------------------------------
*/
int
Tcl_BreakObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 |
*----------------------------------------------------------------------
*/
int
Tcl_BreakObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
if (objc != 1) {
Tcl_WrongNumArgs(interp, 1, objv, NULL);
return TCL_ERROR;
}
return TCL_BREAK;
|
| ︙ | ︙ | |||
204 205 206 207 208 209 210 |
*----------------------------------------------------------------------
*/
int
Tcl_CatchObjCmd(
void *clientData,
Tcl_Interp *interp, /* Current interpreter. */
| | | | | 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 |
*----------------------------------------------------------------------
*/
int
Tcl_CatchObjCmd(
void *clientData,
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
return Tcl_NRCallObjProc2(interp, TclNRCatchObjCmd, clientData, objc, objv);
}
int
TclNRCatchObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_Obj *varNamePtr = NULL;
Tcl_Obj *optionVarNamePtr = NULL;
Interp *iPtr = (Interp *) interp;
if ((objc < 2) || (objc > 4)) {
|
| ︙ | ︙ | |||
309 310 311 312 313 314 315 |
*----------------------------------------------------------------------
*/
int
Tcl_CdObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 |
*----------------------------------------------------------------------
*/
int
Tcl_CdObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_Obj *dir;
int result;
if (objc > 2) {
Tcl_WrongNumArgs(interp, 1, objv, "?dirName?");
|
| ︙ | ︙ | |||
372 373 374 375 376 377 378 |
*----------------------------------------------------------------------
*/
int
Tcl_ConcatObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 |
*----------------------------------------------------------------------
*/
int
Tcl_ConcatObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
if (objc >= 2) {
Tcl_SetObjResult(interp, Tcl_ConcatObj(objc-1, objv+1));
}
return TCL_OK;
}
|
| ︙ | ︙ | |||
406 407 408 409 410 411 412 |
*----------------------------------------------------------------------
*/
int
Tcl_ContinueObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 |
*----------------------------------------------------------------------
*/
int
Tcl_ContinueObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
if (objc != 1) {
Tcl_WrongNumArgs(interp, 1, objv, NULL);
return TCL_ERROR;
}
return TCL_CONTINUE;
|
| ︙ | ︙ | |||
441 442 443 444 445 446 447 | * - *failVarPtr is set to -failindex option value or NULL * On error, all of the above are uninitialized. * *------------------------------------------------------------------------ */ static int EncodingConvertParseOptions( | | | | | | | | > | 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 |
* - *failVarPtr is set to -failindex option value or NULL
* On error, all of the above are uninitialized.
*
*------------------------------------------------------------------------
*/
static int
EncodingConvertParseOptions(
Tcl_Interp *interp, /* For error messages. May be NULL */
Tcl_Size objc, /* Number of arguments */
Tcl_Obj *const objv[], /* Argument objects as passed to command. */
Tcl_Encoding *encPtr, /* Where to store the encoding */
Tcl_Obj **dataObjPtr, /* Where to store ptr to Tcl_Obj containing data */
int *profilePtr, /* Bit mask of encoding option profile */
Tcl_Obj **failVarPtr /* Where to store -failindex option value */
)
{
static const char *const options[] = {"-profile", "-failindex", NULL};
enum convertfromOptions { PROFILE, FAILINDEX } optIndex;
Tcl_Encoding encoding;
Tcl_Obj *dataObj;
Tcl_Obj *failVarObj;
int profile = TCL_ENCODING_PROFILE_STRICT;
|
| ︙ | ︙ | |||
536 537 538 539 540 541 542 |
*----------------------------------------------------------------------
*/
int
EncodingConvertfromObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 |
*----------------------------------------------------------------------
*/
int
EncodingConvertfromObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_Obj *data; /* Byte array to convert */
Tcl_DString ds; /* Buffer to hold the string */
Tcl_Encoding encoding; /* Encoding to use */
Tcl_Size length = 0; /* Length of the byte array being converted */
const char *bytesPtr; /* Pointer to the first byte of the array */
|
| ︙ | ︙ | |||
634 635 636 637 638 639 640 |
*----------------------------------------------------------------------
*/
int
EncodingConverttoObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 |
*----------------------------------------------------------------------
*/
int
EncodingConverttoObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_Obj *data; /* String to convert */
Tcl_DString ds; /* Buffer to hold the byte array */
Tcl_Encoding encoding; /* Encoding to use */
Tcl_Size length; /* Length of the string being converted */
const char *stringPtr; /* Pointer to the first byte of the string */
|
| ︙ | ︙ | |||
730 731 732 733 734 735 736 |
*----------------------------------------------------------------------
*/
int
EncodingDirsObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 |
*----------------------------------------------------------------------
*/
int
EncodingDirsObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_Obj *dirListObj;
if (objc > 2) {
Tcl_WrongNumArgs(interp, 1, objv, "?dirList?");
return TCL_ERROR;
|
| ︙ | ︙ | |||
774 775 776 777 778 779 780 |
*-----------------------------------------------------------------------------
*/
int
EncodingNamesObjCmd(
TCL_UNUSED(void *),
Tcl_Interp* interp, /* Tcl interpreter */
| | | 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 |
*-----------------------------------------------------------------------------
*/
int
EncodingNamesObjCmd(
TCL_UNUSED(void *),
Tcl_Interp* interp, /* Tcl interpreter */
Tcl_Size objc, /* Number of command line args */
Tcl_Obj* const objv[]) /* Vector of command line args */
{
if (objc > 1) {
Tcl_WrongNumArgs(interp, 1, objv, NULL);
return TCL_ERROR;
}
Tcl_GetEncodingNames(interp);
|
| ︙ | ︙ | |||
802 803 804 805 806 807 808 |
*-----------------------------------------------------------------------------
*/
int
EncodingProfilesObjCmd(
TCL_UNUSED(void *),
Tcl_Interp* interp, /* Tcl interpreter */
| | | 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 |
*-----------------------------------------------------------------------------
*/
int
EncodingProfilesObjCmd(
TCL_UNUSED(void *),
Tcl_Interp* interp, /* Tcl interpreter */
Tcl_Size objc, /* Number of command line args */
Tcl_Obj* const objv[]) /* Vector of command line args */
{
if (objc > 1) {
Tcl_WrongNumArgs(interp, 1, objv, NULL);
return TCL_ERROR;
}
TclGetEncodingProfiles(interp);
|
| ︙ | ︙ | |||
833 834 835 836 837 838 839 |
*-----------------------------------------------------------------------------
*/
int
EncodingSystemObjCmd(
TCL_UNUSED(void *),
Tcl_Interp* interp, /* Tcl interpreter */
| | | 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 |
*-----------------------------------------------------------------------------
*/
int
EncodingSystemObjCmd(
TCL_UNUSED(void *),
Tcl_Interp* interp, /* Tcl interpreter */
Tcl_Size objc, /* Number of command line args */
Tcl_Obj* const objv[]) /* Vector of command line args */
{
if (objc > 2) {
Tcl_WrongNumArgs(interp, 1, objv, "?encoding?");
return TCL_ERROR;
}
if (objc == 1) {
|
| ︙ | ︙ | |||
866 867 868 869 870 871 872 |
*-----------------------------------------------------------------------------
*/
int
EncodingUserObjCmd(
TCL_UNUSED(void *),
Tcl_Interp* interp, /* Tcl interpreter */
| | | 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 |
*-----------------------------------------------------------------------------
*/
int
EncodingUserObjCmd(
TCL_UNUSED(void *),
Tcl_Interp* interp, /* Tcl interpreter */
Tcl_Size objc, /* Number of command line args */
Tcl_Obj* const objv[]) /* Vector of command line args */
{
if (objc > 1) {
Tcl_WrongNumArgs(interp, 1, objv, "");
return TCL_ERROR;
}
Tcl_DString ds;
|
| ︙ | ︙ | |||
900 901 902 903 904 905 906 |
*----------------------------------------------------------------------
*/
int
Tcl_ErrorObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915 |
*----------------------------------------------------------------------
*/
int
Tcl_ErrorObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_Obj *options, *optName;
if ((objc < 2) || (objc > 4)) {
Tcl_WrongNumArgs(interp, 1, objv, "message ?errorInfo? ?errorCode?");
return TCL_ERROR;
|
| ︙ | ︙ | |||
962 963 964 965 966 967 968 |
return result;
}
int
Tcl_EvalObjCmd(
void *clientData,
Tcl_Interp *interp, /* Current interpreter. */
| | | | | | 963 964 965 966 967 968 969 970 971 972 973 974 975 976 977 978 979 980 981 982 983 984 985 986 987 988 989 990 991 992 993 |
return result;
}
int
Tcl_EvalObjCmd(
void *clientData,
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
return Tcl_NRCallObjProc2(interp, TclNREvalObjCmd, clientData, objc, objv);
}
int
TclNREvalObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_Obj *objPtr;
Interp *iPtr = (Interp *) interp;
CmdFrame *invoker = NULL;
Tcl_Size word = 0;
if (objc < 2) {
Tcl_WrongNumArgs(interp, 1, objv, "arg ?arg ...?");
return TCL_ERROR;
}
if (objc == 2) {
|
| ︙ | ︙ | |||
1031 1032 1033 1034 1035 1036 1037 |
*----------------------------------------------------------------------
*/
int
Tcl_ExitObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 |
*----------------------------------------------------------------------
*/
int
Tcl_ExitObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_WideInt value;
if ((objc != 1) && (objc != 2)) {
Tcl_WrongNumArgs(interp, 1, objv, "?returnCode?");
return TCL_ERROR;
|
| ︙ | ︙ | |||
1078 1079 1080 1081 1082 1083 1084 |
*----------------------------------------------------------------------
*/
int
Tcl_ExprObjCmd(
void *clientData,
Tcl_Interp *interp, /* Current interpreter. */
| | | | | 1079 1080 1081 1082 1083 1084 1085 1086 1087 1088 1089 1090 1091 1092 1093 1094 1095 1096 1097 1098 1099 1100 1101 1102 1103 |
*----------------------------------------------------------------------
*/
int
Tcl_ExprObjCmd(
void *clientData,
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
return Tcl_NRCallObjProc2(interp, TclNRExprObjCmd, clientData, objc, objv);
}
int
TclNRExprObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_Obj *resultPtr, *objPtr;
if (objc < 2) {
Tcl_WrongNumArgs(interp, 1, objv, "arg ?arg ...?");
return TCL_ERROR;
|
| ︙ | ︙ | |||
1152 1153 1154 1155 1156 1157 1158 |
*----------------------------------------------------------------------
*/
static int
FileAttrAccessTimeCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | 1153 1154 1155 1156 1157 1158 1159 1160 1161 1162 1163 1164 1165 1166 1167 |
*----------------------------------------------------------------------
*/
static int
FileAttrAccessTimeCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const objv[])
{
Tcl_StatBuf buf;
struct utimbuf tval;
if (objc < 2 || objc > 3) {
Tcl_WrongNumArgs(interp, 1, objv, "name ?time?");
|
| ︙ | ︙ | |||
1234 1235 1236 1237 1238 1239 1240 |
*----------------------------------------------------------------------
*/
static int
FileAttrModifyTimeCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | 1235 1236 1237 1238 1239 1240 1241 1242 1243 1244 1245 1246 1247 1248 1249 |
*----------------------------------------------------------------------
*/
static int
FileAttrModifyTimeCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const objv[])
{
Tcl_StatBuf buf;
struct utimbuf tval;
if (objc < 2 || objc > 3) {
Tcl_WrongNumArgs(interp, 1, objv, "name ?time?");
|
| ︙ | ︙ | |||
1313 1314 1315 1316 1317 1318 1319 |
*----------------------------------------------------------------------
*/
static int
FileAttrLinkStatCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | 1314 1315 1316 1317 1318 1319 1320 1321 1322 1323 1324 1325 1326 1327 1328 |
*----------------------------------------------------------------------
*/
static int
FileAttrLinkStatCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const objv[])
{
Tcl_StatBuf buf;
if (objc < 2 || objc > 3) {
Tcl_WrongNumArgs(interp, 1, objv, "name ?varName?");
return TCL_ERROR;
|
| ︙ | ︙ | |||
1353 1354 1355 1356 1357 1358 1359 |
*----------------------------------------------------------------------
*/
static int
FileAttrStatCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | 1354 1355 1356 1357 1358 1359 1360 1361 1362 1363 1364 1365 1366 1367 1368 |
*----------------------------------------------------------------------
*/
static int
FileAttrStatCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const objv[])
{
Tcl_StatBuf buf;
if (objc < 2 || objc > 3) {
Tcl_WrongNumArgs(interp, 1, objv, "name ?varName?");
return TCL_ERROR;
|
| ︙ | ︙ | |||
1393 1394 1395 1396 1397 1398 1399 |
*----------------------------------------------------------------------
*/
static int
FileAttrTypeCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | 1394 1395 1396 1397 1398 1399 1400 1401 1402 1403 1404 1405 1406 1407 1408 |
*----------------------------------------------------------------------
*/
static int
FileAttrTypeCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const objv[])
{
Tcl_StatBuf buf;
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "name");
return TCL_ERROR;
|
| ︙ | ︙ | |||
1431 1432 1433 1434 1435 1436 1437 |
*----------------------------------------------------------------------
*/
static int
FileAttrSizeCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | 1432 1433 1434 1435 1436 1437 1438 1439 1440 1441 1442 1443 1444 1445 1446 |
*----------------------------------------------------------------------
*/
static int
FileAttrSizeCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const objv[])
{
Tcl_StatBuf buf;
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "name");
return TCL_ERROR;
|
| ︙ | ︙ | |||
1468 1469 1470 1471 1472 1473 1474 |
*----------------------------------------------------------------------
*/
static int
FileAttrIsDirectoryCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | 1469 1470 1471 1472 1473 1474 1475 1476 1477 1478 1479 1480 1481 1482 1483 |
*----------------------------------------------------------------------
*/
static int
FileAttrIsDirectoryCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const objv[])
{
Tcl_StatBuf buf;
int value = 0;
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "name");
|
| ︙ | ︙ | |||
1506 1507 1508 1509 1510 1511 1512 |
*----------------------------------------------------------------------
*/
static int
FileAttrIsExecutableCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | 1507 1508 1509 1510 1511 1512 1513 1514 1515 1516 1517 1518 1519 1520 1521 |
*----------------------------------------------------------------------
*/
static int
FileAttrIsExecutableCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const objv[])
{
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "name");
return TCL_ERROR;
}
return CheckAccess(interp, objv[1], X_OK);
|
| ︙ | ︙ | |||
1537 1538 1539 1540 1541 1542 1543 |
*----------------------------------------------------------------------
*/
static int
FileAttrIsExistingCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | 1538 1539 1540 1541 1542 1543 1544 1545 1546 1547 1548 1549 1550 1551 1552 |
*----------------------------------------------------------------------
*/
static int
FileAttrIsExistingCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const objv[])
{
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "name");
return TCL_ERROR;
}
return CheckAccess(interp, objv[1], F_OK);
|
| ︙ | ︙ | |||
1568 1569 1570 1571 1572 1573 1574 |
*----------------------------------------------------------------------
*/
static int
FileAttrIsFileCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | 1569 1570 1571 1572 1573 1574 1575 1576 1577 1578 1579 1580 1581 1582 1583 |
*----------------------------------------------------------------------
*/
static int
FileAttrIsFileCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const objv[])
{
Tcl_StatBuf buf;
int value = 0;
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "name");
|
| ︙ | ︙ | |||
1606 1607 1608 1609 1610 1611 1612 |
*----------------------------------------------------------------------
*/
static int
FileAttrIsOwnedCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | 1607 1608 1609 1610 1611 1612 1613 1614 1615 1616 1617 1618 1619 1620 1621 |
*----------------------------------------------------------------------
*/
static int
FileAttrIsOwnedCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const objv[])
{
#ifdef __CYGWIN__
#define geteuid() (short)(geteuid)()
#endif
#if !defined(_WIN32)
Tcl_StatBuf buf;
|
| ︙ | ︙ | |||
1668 1669 1670 1671 1672 1673 1674 |
*----------------------------------------------------------------------
*/
static int
FileAttrIsReadableCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | 1669 1670 1671 1672 1673 1674 1675 1676 1677 1678 1679 1680 1681 1682 1683 |
*----------------------------------------------------------------------
*/
static int
FileAttrIsReadableCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const objv[])
{
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "name");
return TCL_ERROR;
}
return CheckAccess(interp, objv[1], R_OK);
|
| ︙ | ︙ | |||
1699 1700 1701 1702 1703 1704 1705 |
*----------------------------------------------------------------------
*/
static int
FileAttrIsWritableCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | 1700 1701 1702 1703 1704 1705 1706 1707 1708 1709 1710 1711 1712 1713 1714 |
*----------------------------------------------------------------------
*/
static int
FileAttrIsWritableCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const objv[])
{
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "name");
return TCL_ERROR;
}
return CheckAccess(interp, objv[1], W_OK);
|
| ︙ | ︙ | |||
1730 1731 1732 1733 1734 1735 1736 |
*----------------------------------------------------------------------
*/
static int
PathDirNameCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | 1731 1732 1733 1734 1735 1736 1737 1738 1739 1740 1741 1742 1743 1744 1745 |
*----------------------------------------------------------------------
*/
static int
PathDirNameCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const objv[])
{
Tcl_Obj *dirPtr;
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "name");
return TCL_ERROR;
|
| ︙ | ︙ | |||
1769 1770 1771 1772 1773 1774 1775 |
*----------------------------------------------------------------------
*/
static int
PathExtensionCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | 1770 1771 1772 1773 1774 1775 1776 1777 1778 1779 1780 1781 1782 1783 1784 |
*----------------------------------------------------------------------
*/
static int
PathExtensionCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const objv[])
{
Tcl_Obj *dirPtr;
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "name");
return TCL_ERROR;
|
| ︙ | ︙ | |||
1808 1809 1810 1811 1812 1813 1814 |
*----------------------------------------------------------------------
*/
static int
PathRootNameCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | 1809 1810 1811 1812 1813 1814 1815 1816 1817 1818 1819 1820 1821 1822 1823 |
*----------------------------------------------------------------------
*/
static int
PathRootNameCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const objv[])
{
Tcl_Obj *dirPtr;
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "name");
return TCL_ERROR;
|
| ︙ | ︙ | |||
1847 1848 1849 1850 1851 1852 1853 |
*----------------------------------------------------------------------
*/
static int
PathTailCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | 1848 1849 1850 1851 1852 1853 1854 1855 1856 1857 1858 1859 1860 1861 1862 |
*----------------------------------------------------------------------
*/
static int
PathTailCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const objv[])
{
Tcl_Obj *dirPtr;
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "name");
return TCL_ERROR;
|
| ︙ | ︙ | |||
1886 1887 1888 1889 1890 1891 1892 |
*----------------------------------------------------------------------
*/
static int
PathFilesystemCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | 1887 1888 1889 1890 1891 1892 1893 1894 1895 1896 1897 1898 1899 1900 1901 |
*----------------------------------------------------------------------
*/
static int
PathFilesystemCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const objv[])
{
Tcl_Obj *fsInfo;
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "name");
return TCL_ERROR;
|
| ︙ | ︙ | |||
1927 1928 1929 1930 1931 1932 1933 |
*----------------------------------------------------------------------
*/
static int
PathJoinCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | 1928 1929 1930 1931 1932 1933 1934 1935 1936 1937 1938 1939 1940 1941 1942 |
*----------------------------------------------------------------------
*/
static int
PathJoinCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const objv[])
{
if (objc < 2) {
Tcl_WrongNumArgs(interp, 1, objv, "name ?name ...?");
return TCL_ERROR;
}
Tcl_SetObjResult(interp, TclJoinPath(objc - 1, objv + 1, 0));
|
| ︙ | ︙ | |||
1959 1960 1961 1962 1963 1964 1965 |
*----------------------------------------------------------------------
*/
static int
PathNativeNameCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | 1960 1961 1962 1963 1964 1965 1966 1967 1968 1969 1970 1971 1972 1973 1974 |
*----------------------------------------------------------------------
*/
static int
PathNativeNameCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const objv[])
{
Tcl_DString ds;
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "name");
return TCL_ERROR;
|
| ︙ | ︙ | |||
1996 1997 1998 1999 2000 2001 2002 |
*----------------------------------------------------------------------
*/
static int
PathNormalizeCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | 1997 1998 1999 2000 2001 2002 2003 2004 2005 2006 2007 2008 2009 2010 2011 |
*----------------------------------------------------------------------
*/
static int
PathNormalizeCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const objv[])
{
Tcl_Obj *fileName;
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "name");
return TCL_ERROR;
|
| ︙ | ︙ | |||
2034 2035 2036 2037 2038 2039 2040 |
*----------------------------------------------------------------------
*/
static int
PathSplitCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | 2035 2036 2037 2038 2039 2040 2041 2042 2043 2044 2045 2046 2047 2048 2049 |
*----------------------------------------------------------------------
*/
static int
PathSplitCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const objv[])
{
Tcl_Obj *res;
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "name");
return TCL_ERROR;
|
| ︙ | ︙ | |||
2077 2078 2079 2080 2081 2082 2083 |
*----------------------------------------------------------------------
*/
static int
PathTypeCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | 2078 2079 2080 2081 2082 2083 2084 2085 2086 2087 2088 2089 2090 2091 2092 |
*----------------------------------------------------------------------
*/
static int
PathTypeCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const objv[])
{
Tcl_Obj *typeName;
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "name");
return TCL_ERROR;
|
| ︙ | ︙ | |||
2124 2125 2126 2127 2128 2129 2130 |
*----------------------------------------------------------------------
*/
static int
FilesystemSeparatorCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | 2125 2126 2127 2128 2129 2130 2131 2132 2133 2134 2135 2136 2137 2138 2139 |
*----------------------------------------------------------------------
*/
static int
FilesystemSeparatorCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const objv[])
{
if (objc < 1 || objc > 2) {
Tcl_WrongNumArgs(interp, 1, objv, "?name?");
return TCL_ERROR;
}
if (objc == 1) {
|
| ︙ | ︙ | |||
2179 2180 2181 2182 2183 2184 2185 |
*----------------------------------------------------------------------
*/
static int
FilesystemVolumesCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | 2180 2181 2182 2183 2184 2185 2186 2187 2188 2189 2190 2191 2192 2193 2194 |
*----------------------------------------------------------------------
*/
static int
FilesystemVolumesCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const objv[])
{
if (objc != 1) {
Tcl_WrongNumArgs(interp, 1, objv, NULL);
return TCL_ERROR;
}
Tcl_SetObjResult(interp, Tcl_FSListVolumes());
|
| ︙ | ︙ | |||
2484 2485 2486 2487 2488 2489 2490 |
*----------------------------------------------------------------------
*/
int
Tcl_ForObjCmd(
void *clientData,
Tcl_Interp *interp, /* Current interpreter. */
| | | | | 2485 2486 2487 2488 2489 2490 2491 2492 2493 2494 2495 2496 2497 2498 2499 2500 2501 2502 2503 2504 2505 2506 2507 2508 2509 |
*----------------------------------------------------------------------
*/
int
Tcl_ForObjCmd(
void *clientData,
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
return Tcl_NRCallObjProc2(interp, TclNRForObjCmd, clientData, objc, objv);
}
int
TclNRForObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Interp *iPtr = (Interp *) interp;
ForIterData *iterPtr;
if (objc != 5) {
Tcl_WrongNumArgs(interp, 1, objv, "start test next command");
|
| ︙ | ︙ | |||
2678 2679 2680 2681 2682 2683 2684 |
*----------------------------------------------------------------------
*/
int
Tcl_ForeachObjCmd(
void *clientData,
Tcl_Interp *interp, /* Current interpreter. */
| | | | | | | | | | | 2679 2680 2681 2682 2683 2684 2685 2686 2687 2688 2689 2690 2691 2692 2693 2694 2695 2696 2697 2698 2699 2700 2701 2702 2703 2704 2705 2706 2707 2708 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 2740 |
*----------------------------------------------------------------------
*/
int
Tcl_ForeachObjCmd(
void *clientData,
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
return Tcl_NRCallObjProc2(interp, TclNRForeachCmd, clientData, objc, objv);
}
int
TclNRForeachCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const objv[])
{
return EachloopCmd(interp, TCL_EACH_KEEP_NONE, objc, objv);
}
int
Tcl_LmapObjCmd(
void *clientData,
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
return Tcl_NRCallObjProc2(interp, TclNRLmapCmd, clientData, objc, objv);
}
int
TclNRLmapCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const objv[])
{
return EachloopCmd(interp, TCL_EACH_COLLECT, objc, objv);
}
static int
EachloopCmd(
Tcl_Interp *interp, /* Our context for variables and script
* evaluation. */
int collect, /* Select collecting or accumulating mode
* (TCL_EACH_*) */
Tcl_Size objc, /* The arguments being passed in... */
Tcl_Obj *const objv[])
{
Tcl_Size i, numLists = (objc-2) / 2;
struct ForeachState *statePtr;
int result;
Tcl_Size j;
if (objc < 4 || (objc%2 != 0)) {
Tcl_WrongNumArgs(interp, 1, objv,
"varList list ?varList list ...? command");
return TCL_ERROR;
}
|
| ︙ | ︙ | |||
3038 3039 3040 3041 3042 3043 3044 |
*----------------------------------------------------------------------
*/
int
Tcl_FormatObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 3039 3040 3041 3042 3043 3044 3045 3046 3047 3048 3049 3050 3051 3052 3053 |
*----------------------------------------------------------------------
*/
int
Tcl_FormatObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_Obj *resultPtr; /* Where result is stored finally. */
if (objc < 2) {
Tcl_WrongNumArgs(interp, 1, objv, "formatString ?arg ...?");
return TCL_ERROR;
|
| ︙ | ︙ |
Changes to generic/tclCmdIL.c.
| ︙ | ︙ | |||
71 72 73 74 75 76 77 |
* that option.
* NULL if no indexes supplied, and points to
* singleIndex field when only one
* supplied. */
Tcl_Size indexc; /* Number of indexes in indexv array. */
int singleIndex; /* Static space for common index case. */
int unique;
| | | 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 |
* that option.
* NULL if no indexes supplied, and points to
* singleIndex field when only one
* supplied. */
Tcl_Size indexc; /* Number of indexes in indexv array. */
int singleIndex; /* Static space for common index case. */
int unique;
Tcl_Size numElements;
Tcl_Interp *interp; /* The interpreter in which the sort is being
* done. */
int resultCode; /* Completion code for the lsort command. If
* an error occurs during the sort this is
* changed from TCL_OK to TCL_ERROR. */
} SortInfo;
|
| ︙ | ︙ | |||
111 112 113 114 115 116 117 | /* * Forward declarations for procedures defined in this file: */ static int DictionaryCompare(const char *left, const char *right); static Tcl_NRPostProc IfConditionCallback; | | | | | | | | | | | | | | | | | | | | | | 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 | /* * Forward declarations for procedures defined in this file: */ static int DictionaryCompare(const char *left, const char *right); static Tcl_NRPostProc IfConditionCallback; static Tcl_ObjCmdProc2 InfoArgsCmd; static Tcl_ObjCmdProc2 InfoBodyCmd; static Tcl_ObjCmdProc2 InfoCmdCountCmd; static Tcl_ObjCmdProc2 InfoCommandsCmd; static Tcl_ObjCmdProc2 InfoCompleteCmd; static Tcl_ObjCmdProc2 InfoDefaultCmd; /* TIP #348 - New 'info' subcommand 'errorstack' */ static Tcl_ObjCmdProc2 InfoErrorStackCmd; /* TIP #280 - New 'info' subcommand 'frame' */ static Tcl_ObjCmdProc2 InfoFrameCmd; static Tcl_ObjCmdProc2 InfoFunctionsCmd; static Tcl_ObjCmdProc2 InfoHostnameCmd; static Tcl_ObjCmdProc2 InfoLevelCmd; static Tcl_ObjCmdProc2 InfoLibraryCmd; static Tcl_ObjCmdProc2 InfoLoadedCmd; static Tcl_ObjCmdProc2 InfoNameOfExecutableCmd; static Tcl_ObjCmdProc2 InfoPatchLevelCmd; static Tcl_ObjCmdProc2 InfoProcsCmd; static Tcl_ObjCmdProc2 InfoScriptCmd; static Tcl_ObjCmdProc2 InfoSharedlibCmd; static Tcl_ObjCmdProc2 InfoCmdTypeCmd; static Tcl_ObjCmdProc2 InfoTclVersionCmd; static SortElement * MergeLists(SortElement *leftPtr, SortElement *rightPtr, SortInfo *infoPtr); static int SortCompare(SortElement *firstPtr, SortElement *second, SortInfo *infoPtr); static Tcl_Obj * SelectObjFromSublist(Tcl_Obj *firstPtr, SortInfo *infoPtr); |
| ︙ | ︙ | |||
201 202 203 204 205 206 207 |
*----------------------------------------------------------------------
*/
int
Tcl_IfObjCmd(
void *clientData,
Tcl_Interp *interp, /* Current interpreter. */
| | | | | 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 |
*----------------------------------------------------------------------
*/
int
Tcl_IfObjCmd(
void *clientData,
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
return Tcl_NRCallObjProc2(interp, TclNRIfObjCmd, clientData, objc, objv);
}
int
TclNRIfObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_Obj *boolObj;
if (objc <= 1) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"wrong # args: no expression after \"%s\" argument",
|
| ︙ | ︙ | |||
247 248 249 250 251 252 253 |
int result)
{
Interp *iPtr = (Interp *) interp;
Tcl_Size objc = PTR2INT(data[0]);
Tcl_Obj *const *objv = (Tcl_Obj *const *)data[1];
Tcl_Size i = PTR2INT(data[2]);
Tcl_Obj *boolObj = (Tcl_Obj *)data[3];
| > | | 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 |
int result)
{
Interp *iPtr = (Interp *) interp;
Tcl_Size objc = PTR2INT(data[0]);
Tcl_Obj *const *objv = (Tcl_Obj *const *)data[1];
Tcl_Size i = PTR2INT(data[2]);
Tcl_Obj *boolObj = (Tcl_Obj *)data[3];
int value;
Tcl_Size thenScriptIndex = 0;
const char *clause;
if (result != TCL_OK) {
TclDecrRefCount(boolObj);
return result;
}
if (Tcl_GetBooleanFromObj(interp, boolObj, &value) != TCL_OK) {
|
| ︙ | ︙ | |||
384 385 386 387 388 389 390 |
*----------------------------------------------------------------------
*/
int
Tcl_IncrObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 |
*----------------------------------------------------------------------
*/
int
Tcl_IncrObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_Obj *newValuePtr, *incrPtr;
if ((objc != 2) && (objc != 3)) {
Tcl_WrongNumArgs(interp, 1, objv, "varName ?increment?");
return TCL_ERROR;
|
| ︙ | ︙ | |||
441 442 443 444 445 446 447 |
*----------------------------------------------------------------------
*/
static int
InfoArgsCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 |
*----------------------------------------------------------------------
*/
static int
InfoArgsCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Interp *iPtr = (Interp *) interp;
const char *name;
Proc *procPtr;
CompiledLocal *localPtr;
Tcl_Obj *listObjPtr;
|
| ︙ | ︙ | |||
504 505 506 507 508 509 510 |
*----------------------------------------------------------------------
*/
static int
InfoBodyCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 |
*----------------------------------------------------------------------
*/
static int
InfoBodyCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Interp *iPtr = (Interp *) interp;
const char *name, *bytes;
Proc *procPtr;
Tcl_Size numBytes;
|
| ︙ | ︙ | |||
565 566 567 568 569 570 571 |
*----------------------------------------------------------------------
*/
static int
InfoCmdCountCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 |
*----------------------------------------------------------------------
*/
static int
InfoCmdCountCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Interp *iPtr = (Interp *) interp;
if (objc != 1) {
Tcl_WrongNumArgs(interp, 1, objv, NULL);
return TCL_ERROR;
|
| ︙ | ︙ | |||
607 608 609 610 611 612 613 |
*----------------------------------------------------------------------
*/
static int
InfoCommandsCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 |
*----------------------------------------------------------------------
*/
static int
InfoCommandsCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
const char *cmdName, *pattern;
const char *simplePattern;
Tcl_HashEntry *entryPtr;
Tcl_HashSearch search;
Namespace *nsPtr;
|
| ︙ | ︙ | |||
884 885 886 887 888 889 890 |
*----------------------------------------------------------------------
*/
static int
InfoCompleteCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899 |
*----------------------------------------------------------------------
*/
static int
InfoCompleteCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "command");
return TCL_ERROR;
}
|
| ︙ | ︙ | |||
921 922 923 924 925 926 927 |
*----------------------------------------------------------------------
*/
static int
InfoDefaultCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 922 923 924 925 926 927 928 929 930 931 932 933 934 935 936 |
*----------------------------------------------------------------------
*/
static int
InfoDefaultCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Interp *iPtr = (Interp *) interp;
const char *procName, *argName;
Proc *procPtr;
CompiledLocal *localPtr;
Tcl_Obj *valueObjPtr;
|
| ︙ | ︙ | |||
1004 1005 1006 1007 1008 1009 1010 |
*----------------------------------------------------------------------
*/
static int
InfoErrorStackCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 1005 1006 1007 1008 1009 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 |
*----------------------------------------------------------------------
*/
static int
InfoErrorStackCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_Interp *target;
Interp *iPtr;
if ((objc != 1) && (objc != 2)) {
Tcl_WrongNumArgs(interp, 1, objv, "?interp?");
|
| ︙ | ︙ | |||
1053 1054 1055 1056 1057 1058 1059 |
*----------------------------------------------------------------------
*/
int
TclInfoExistsCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 |
*----------------------------------------------------------------------
*/
int
TclInfoExistsCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
const char *varName;
Var *varPtr;
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "varName");
|
| ︙ | ︙ | |||
1098 1099 1100 1101 1102 1103 1104 |
*----------------------------------------------------------------------
*/
static int
InfoFrameCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 1099 1100 1101 1102 1103 1104 1105 1106 1107 1108 1109 1110 1111 1112 1113 |
*----------------------------------------------------------------------
*/
static int
InfoFrameCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Interp *iPtr = (Interp *) interp;
int level, code = TCL_OK;
CmdFrame *framePtr, **cmdFramePtrPtr = &iPtr->cmdFramePtr;
CoroutineData *corPtr = iPtr->execEnvPtr->corPtr;
int topLevel = 0;
|
| ︙ | ︙ | |||
1402 1403 1404 1405 1406 1407 1408 |
if (framePtr && (framePtr->framePtr != NULL) && (iPtr->varFramePtr != NULL)) {
CallFrame *current = framePtr->framePtr;
CallFrame *top = iPtr->varFramePtr;
CallFrame *idx;
for (idx=top ; idx!=NULL ; idx=idx->callerVarPtr) {
if (idx == current) {
| | | | 1403 1404 1405 1406 1407 1408 1409 1410 1411 1412 1413 1414 1415 1416 1417 1418 |
if (framePtr && (framePtr->framePtr != NULL) && (iPtr->varFramePtr != NULL)) {
CallFrame *current = framePtr->framePtr;
CallFrame *top = iPtr->varFramePtr;
CallFrame *idx;
for (idx=top ; idx!=NULL ; idx=idx->callerVarPtr) {
if (idx == current) {
Tcl_Size c = framePtr->framePtr->level;
Tcl_Size t = iPtr->varFramePtr->level;
ADD_PAIR("level", Tcl_NewWideIntObj(t - c));
break;
}
}
}
|
| ︙ | ︙ | |||
1443 1444 1445 1446 1447 1448 1449 |
*----------------------------------------------------------------------
*/
static int
InfoFunctionsCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 1444 1445 1446 1447 1448 1449 1450 1451 1452 1453 1454 1455 1456 1457 1458 |
*----------------------------------------------------------------------
*/
static int
InfoFunctionsCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_Obj *script;
int code;
if (objc > 2) {
Tcl_WrongNumArgs(interp, 1, objv, "?pattern?");
|
| ︙ | ︙ | |||
1508 1509 1510 1511 1512 1513 1514 |
*----------------------------------------------------------------------
*/
static int
InfoHostnameCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 1509 1510 1511 1512 1513 1514 1515 1516 1517 1518 1519 1520 1521 1522 1523 |
*----------------------------------------------------------------------
*/
static int
InfoHostnameCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
const char *name;
if (objc != 1) {
Tcl_WrongNumArgs(interp, 1, objv, NULL);
return TCL_ERROR;
|
| ︙ | ︙ | |||
1554 1555 1556 1557 1558 1559 1560 |
*----------------------------------------------------------------------
*/
static int
InfoLevelCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | | 1555 1556 1557 1558 1559 1560 1561 1562 1563 1564 1565 1566 1567 1568 1569 1570 1571 1572 1573 1574 1575 1576 1577 1578 1579 1580 1581 1582 1583 1584 1585 1586 1587 1588 1589 1590 |
*----------------------------------------------------------------------
*/
static int
InfoLevelCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Interp *iPtr = (Interp *) interp;
if (objc == 1) { /* Just "info level" */
Tcl_SetObjResult(interp, Tcl_NewWideIntObj((int)iPtr->varFramePtr->level));
return TCL_OK;
}
if (objc == 2) {
int level;
CallFrame *framePtr, *rootFramePtr = iPtr->rootFramePtr;
if (TclGetIntFromObj(interp, objv[1], &level) != TCL_OK) {
return TCL_ERROR;
}
if (level <= 0) {
if (iPtr->varFramePtr == rootFramePtr) {
goto levelError;
}
level += (int)iPtr->varFramePtr->level;
}
for (framePtr=iPtr->varFramePtr ; framePtr!=rootFramePtr;
framePtr=framePtr->callerVarPtr) {
if (framePtr->level == level) {
break;
}
}
|
| ︙ | ︙ | |||
1628 1629 1630 1631 1632 1633 1634 |
*----------------------------------------------------------------------
*/
static int
InfoLibraryCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 1629 1630 1631 1632 1633 1634 1635 1636 1637 1638 1639 1640 1641 1642 1643 |
*----------------------------------------------------------------------
*/
static int
InfoLibraryCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
const char *libDirName;
if (objc != 1) {
Tcl_WrongNumArgs(interp, 1, objv, NULL);
return TCL_ERROR;
|
| ︙ | ︙ | |||
1675 1676 1677 1678 1679 1680 1681 |
*----------------------------------------------------------------------
*/
static int
InfoLoadedCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 1676 1677 1678 1679 1680 1681 1682 1683 1684 1685 1686 1687 1688 1689 1690 |
*----------------------------------------------------------------------
*/
static int
InfoLoadedCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
const char *interpName, *prefix;
if (objc > 3) {
Tcl_WrongNumArgs(interp, 1, objv, "?interp? ?prefix?");
return TCL_ERROR;
|
| ︙ | ︙ | |||
1723 1724 1725 1726 1727 1728 1729 |
*----------------------------------------------------------------------
*/
static int
InfoNameOfExecutableCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 1724 1725 1726 1727 1728 1729 1730 1731 1732 1733 1734 1735 1736 1737 1738 |
*----------------------------------------------------------------------
*/
static int
InfoNameOfExecutableCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
if (objc != 1) {
Tcl_WrongNumArgs(interp, 1, objv, NULL);
return TCL_ERROR;
}
Tcl_SetObjResult(interp, TclGetObjNameOfExecutable());
|
| ︙ | ︙ | |||
1759 1760 1761 1762 1763 1764 1765 |
*----------------------------------------------------------------------
*/
static int
InfoPatchLevelCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 1760 1761 1762 1763 1764 1765 1766 1767 1768 1769 1770 1771 1772 1773 1774 |
*----------------------------------------------------------------------
*/
static int
InfoPatchLevelCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
const char *patchlevel;
if (objc != 1) {
Tcl_WrongNumArgs(interp, 1, objv, NULL);
return TCL_ERROR;
|
| ︙ | ︙ | |||
1806 1807 1808 1809 1810 1811 1812 |
*----------------------------------------------------------------------
*/
static int
InfoProcsCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 1807 1808 1809 1810 1811 1812 1813 1814 1815 1816 1817 1818 1819 1820 1821 |
*----------------------------------------------------------------------
*/
static int
InfoProcsCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
const char *cmdName, *pattern;
const char *simplePattern;
Namespace *nsPtr;
Namespace *currNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
Tcl_Obj *listPtr, *elemObjPtr;
|
| ︙ | ︙ | |||
1947 1948 1949 1950 1951 1952 1953 |
*----------------------------------------------------------------------
*/
static int
InfoScriptCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 1948 1949 1950 1951 1952 1953 1954 1955 1956 1957 1958 1959 1960 1961 1962 |
*----------------------------------------------------------------------
*/
static int
InfoScriptCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Interp *iPtr = (Interp *) interp;
if ((objc != 1) && (objc != 2)) {
Tcl_WrongNumArgs(interp, 1, objv, "?filename?");
return TCL_ERROR;
|
| ︙ | ︙ | |||
1995 1996 1997 1998 1999 2000 2001 |
*----------------------------------------------------------------------
*/
static int
InfoSharedlibCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 1996 1997 1998 1999 2000 2001 2002 2003 2004 2005 2006 2007 2008 2009 2010 |
*----------------------------------------------------------------------
*/
static int
InfoSharedlibCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
if (objc != 1) {
Tcl_WrongNumArgs(interp, 1, objv, NULL);
return TCL_ERROR;
}
|
| ︙ | ︙ | |||
2033 2034 2035 2036 2037 2038 2039 |
*----------------------------------------------------------------------
*/
static int
InfoTclVersionCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 2034 2035 2036 2037 2038 2039 2040 2041 2042 2043 2044 2045 2046 2047 2048 |
*----------------------------------------------------------------------
*/
static int
InfoTclVersionCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_Obj *version;
if (objc != 1) {
Tcl_WrongNumArgs(interp, 1, objv, NULL);
return TCL_ERROR;
|
| ︙ | ︙ | |||
2076 2077 2078 2079 2080 2081 2082 |
*----------------------------------------------------------------------
*/
static int
InfoCmdTypeCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | | 2077 2078 2079 2080 2081 2082 2083 2084 2085 2086 2087 2088 2089 2090 2091 2092 2093 2094 2095 2096 2097 2098 2099 2100 2101 2102 2103 2104 2105 2106 2107 2108 2109 2110 2111 2112 |
*----------------------------------------------------------------------
*/
static int
InfoCmdTypeCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_Command command;
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "commandName");
return TCL_ERROR;
}
command = Tcl_FindCommand(interp, TclGetString(objv[1]), NULL,
TCL_LEAVE_ERR_MSG);
if (command == NULL) {
return TCL_ERROR;
}
/*
* There's one special case: safe child interpreters can't see aliases as
* aliases as they're part of the security mechanisms.
*/
if (Tcl_IsSafe(interp)
&& (((Command *) command)->objProc2 == TclAliasObjCmd)) {
Tcl_AppendResult(interp, "native", (char *)NULL);
} else {
Tcl_SetObjResult(interp,
Tcl_NewStringObj(TclGetCommandTypeName(command), -1));
}
return TCL_OK;
}
|
| ︙ | ︙ | |||
2127 2128 2129 2130 2131 2132 2133 |
*----------------------------------------------------------------------
*/
int
Tcl_JoinObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 2128 2129 2130 2131 2132 2133 2134 2135 2136 2137 2138 2139 2140 2141 2142 |
*----------------------------------------------------------------------
*/
int
Tcl_JoinObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* The argument objects. */
{
Tcl_Size length, listLen;
int isAbstractList = 0;
Tcl_Obj *resObjPtr = NULL, *joinObjPtr, **elemPtrs;
if ((objc < 2) || (objc > 3)) {
|
| ︙ | ︙ | |||
2229 2230 2231 2232 2233 2234 2235 |
*----------------------------------------------------------------------
*/
int
Tcl_LassignObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 2230 2231 2232 2233 2234 2235 2236 2237 2238 2239 2240 2241 2242 2243 2244 |
*----------------------------------------------------------------------
*/
int
Tcl_LassignObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_Obj *listPtr;
Tcl_Size listObjc; /* The length of the list. */
Tcl_Size origListObjc; /* Original length */
int i;
|
| ︙ | ︙ | |||
2333 2334 2335 2336 2337 2338 2339 |
*----------------------------------------------------------------------
*/
int
Tcl_LindexObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 2334 2335 2336 2337 2338 2339 2340 2341 2342 2343 2344 2345 2346 2347 2348 |
*----------------------------------------------------------------------
*/
int
Tcl_LindexObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_Obj *elemPtr; /* Pointer to the element being extracted. */
if (objc < 2) {
Tcl_WrongNumArgs(interp, 1, objv, "list ?index ...?");
return TCL_ERROR;
|
| ︙ | ︙ | |||
2391 2392 2393 2394 2395 2396 2397 |
*----------------------------------------------------------------------
*/
int
Tcl_LinsertObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 2392 2393 2394 2395 2396 2397 2398 2399 2400 2401 2402 2403 2404 2405 2406 |
*----------------------------------------------------------------------
*/
int
Tcl_LinsertObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_Obj *listPtr;
Tcl_Size len, index;
int copied = 0, result;
if (objc < 3) {
|
| ︙ | ︙ | |||
2484 2485 2486 2487 2488 2489 2490 |
*----------------------------------------------------------------------
*/
int
Tcl_ListObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 2485 2486 2487 2488 2489 2490 2491 2492 2493 2494 2495 2496 2497 2498 2499 |
*----------------------------------------------------------------------
*/
int
Tcl_ListObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* The argument objects. */
{
/*
* If there are no list elements, the result is an empty object.
* Otherwise set the interpreter's result object to be a list object.
*/
|
| ︙ | ︙ | |||
2519 2520 2521 2522 2523 2524 2525 |
*----------------------------------------------------------------------
*/
int
Tcl_LlengthObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 2520 2521 2522 2523 2524 2525 2526 2527 2528 2529 2530 2531 2532 2533 2534 |
*----------------------------------------------------------------------
*/
int
Tcl_LlengthObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_Size listLen;
int result;
Tcl_Obj *objPtr;
if (objc != 2) {
|
| ︙ | ︙ | |||
2567 2568 2569 2570 2571 2572 2573 |
*----------------------------------------------------------------------
*/
int
Tcl_LpopObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 2568 2569 2570 2571 2572 2573 2574 2575 2576 2577 2578 2579 2580 2581 2582 |
*----------------------------------------------------------------------
*/
int
Tcl_LpopObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_Size listLen;
int copied = 0, result;
Tcl_Obj *elemPtr, *stored;
Tcl_Obj *listPtr;
|
| ︙ | ︙ | |||
2685 2686 2687 2688 2689 2690 2691 |
*----------------------------------------------------------------------
*/
int
Tcl_LrangeObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 2686 2687 2688 2689 2690 2691 2692 2693 2694 2695 2696 2697 2698 2699 2700 |
*----------------------------------------------------------------------
*/
int
Tcl_LrangeObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
int result;
Tcl_Size listLen, first, last;
if (objc != 4) {
Tcl_WrongNumArgs(interp, 1, objv, "list first last");
return TCL_ERROR;
|
| ︙ | ︙ | |||
2756 2757 2758 2759 2760 2761 2762 |
return (idx1 < idx2) ? 1 : (idx1 > idx2) ? -1 : 0;
}
int
Tcl_LremoveObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 2757 2758 2759 2760 2761 2762 2763 2764 2765 2766 2767 2768 2769 2770 2771 |
return (idx1 < idx2) ? 1 : (idx1 > idx2) ? -1 : 0;
}
int
Tcl_LremoveObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_Size i, idxc, prevIdx, first, num;
Tcl_Size *idxv, listLen;
Tcl_Obj *listObj;
int copied = 0, status = TCL_OK;
|
| ︙ | ︙ | |||
2887 2888 2889 2890 2891 2892 2893 |
*----------------------------------------------------------------------
*/
int
Tcl_LrepeatObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 2888 2889 2890 2891 2892 2893 2894 2895 2896 2897 2898 2899 2900 2901 2902 |
*----------------------------------------------------------------------
*/
int
Tcl_LrepeatObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* The argument objects. */
{
Tcl_Size repeatCount;
Tcl_Obj *resultPtr;
if (objc < 2) {
Tcl_WrongNumArgs(interp, 1, objv, "count ?value ...?");
|
| ︙ | ︙ | |||
2933 2934 2935 2936 2937 2938 2939 |
*----------------------------------------------------------------------
*/
int
Tcl_LreplaceObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 2934 2935 2936 2937 2938 2939 2940 2941 2942 2943 2944 2945 2946 2947 2948 |
*----------------------------------------------------------------------
*/
int
Tcl_LreplaceObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_Obj *listPtr;
Tcl_Size numToDelete, listLen, first, last;
int result;
if (objc < 4) {
|
| ︙ | ︙ | |||
3035 3036 3037 3038 3039 3040 3041 |
*----------------------------------------------------------------------
*/
int
Tcl_LreverseObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 3036 3037 3038 3039 3040 3041 3042 3043 3044 3045 3046 3047 3048 3049 3050 |
*----------------------------------------------------------------------
*/
int
Tcl_LreverseObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument values. */
{
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "list");
return TCL_ERROR;
}
|
| ︙ | ︙ | |||
3072 3073 3074 3075 3076 3077 3078 |
*----------------------------------------------------------------------
*/
int
Tcl_LsearchObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 3073 3074 3075 3076 3077 3078 3079 3080 3081 3082 3083 3084 3085 3086 3087 |
*----------------------------------------------------------------------
*/
int
Tcl_LsearchObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument values. */
{
const char *bytes, *patternBytes;
int match, result=TCL_OK, bisect;
Tcl_Size i, length = 0, listc, elemLen, start, index;
Tcl_Size groupOffset, lower, upper;
int allocatedIndexVector = 0;
|
| ︙ | ︙ | |||
3951 3952 3953 3954 3955 3956 3957 |
*----------------------------------------------------------------------
*/
int
Tcl_LseqObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | > | | 3952 3953 3954 3955 3956 3957 3958 3959 3960 3961 3962 3963 3964 3965 3966 3967 3968 3969 3970 3971 3972 3973 3974 3975 3976 3977 3978 3979 3980 3981 |
*----------------------------------------------------------------------
*/
int
Tcl_LseqObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* The argument objects. */
{
Tcl_Obj *elementCount = NULL;
Tcl_Obj *start = NULL, *end = NULL, *step = NULL;
Tcl_WideInt values[5];
Tcl_Obj *numValues[5];
Tcl_Obj *numberObj;
int status = TCL_ERROR, keyword, allowedArgs = NumericArg;
int useDoubles = 0;
int remNums = 3;
Tcl_Obj *arithSeriesPtr;
SequenceOperators opmode;
SequenceDecoded decoded;
Tcl_Size i;
int arg_key = 0, value_i = 0;
/* Default constants */
#define zero ((Interp *)interp)->execEnvPtr->constants[0];
#define one ((Interp *)interp)->execEnvPtr->constants[1];
/*
* Create a decoding key by looping through the arguments and identify
* what kind of argument each one is. Encode each argument as a decimal
|
| ︙ | ︙ | |||
4233 4234 4235 4236 4237 4238 4239 |
*----------------------------------------------------------------------
*/
int
Tcl_LsetObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 4235 4236 4237 4238 4239 4240 4241 4242 4243 4244 4245 4246 4247 4248 4249 |
*----------------------------------------------------------------------
*/
int
Tcl_LsetObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument values. */
{
Tcl_Obj *listPtr; /* Pointer to the list being altered. */
Tcl_Obj *finalValuePtr; /* Value finally assigned to the variable. */
/*
* Check parameter count.
|
| ︙ | ︙ | |||
4326 4327 4328 4329 4330 4331 4332 |
*----------------------------------------------------------------------
*/
int
Tcl_LsortObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | | | 4328 4329 4330 4331 4332 4333 4334 4335 4336 4337 4338 4339 4340 4341 4342 4343 4344 4345 4346 4347 4348 |
*----------------------------------------------------------------------
*/
int
Tcl_LsortObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument values. */
{
int indices, nocase = 0;
int sortMode = SORTMODE_ASCII;
int group, allocatedIndexVector = 0;
Tcl_Size j, idx, groupOffset, length, indexc;
Tcl_WideInt wide, groupSize;
Tcl_Obj *resultPtr, *cmdPtr, **listObjPtrs, *listObj, *indexPtr;
Tcl_Size i, elmArrSize;
SortElement *elementArray = NULL, *elementPtr;
SortInfo sortInfo; /* Information about this sort that needs to
* be passed to the comparison function. */
# define MAXCALLOC 1024000
|
| ︙ | ︙ | |||
4845 4846 4847 4848 4849 4850 4851 |
*----------------------------------------------------------------------
*/
int
Tcl_LeditObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 4847 4848 4849 4850 4851 4852 4853 4854 4855 4856 4857 4858 4859 4860 4861 |
*----------------------------------------------------------------------
*/
int
Tcl_LeditObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument values. */
{
Tcl_Obj *listPtr; /* Pointer to the list being altered. */
Tcl_Obj *finalValuePtr; /* Value finally assigned to the variable. */
int createdNewObj;
int result;
Tcl_Size first;
|
| ︙ | ︙ | |||
5319 5320 5321 5322 5323 5324 5325 |
/*
* Iterate over the indices, traversing through the nested sublists as we
* go.
*/
for (i=0 ; i<infoPtr->indexc ; i++) {
Tcl_Size listLen;
| | | | | 5321 5322 5323 5324 5325 5326 5327 5328 5329 5330 5331 5332 5333 5334 5335 5336 5337 5338 5339 5340 5341 5342 5343 5344 5345 5346 5347 5348 5349 5350 5351 5352 5353 5354 5355 5356 5357 5358 |
/*
* Iterate over the indices, traversing through the nested sublists as we
* go.
*/
for (i=0 ; i<infoPtr->indexc ; i++) {
Tcl_Size listLen;
Tcl_Size index;
Tcl_Obj *currentObj, *lastObj=NULL;
if (TclListObjLength(infoPtr->interp, objPtr, &listLen) != TCL_OK) {
infoPtr->resultCode = TCL_ERROR;
return NULL;
}
index = TclIndexDecode(infoPtr->indexv[i], listLen - 1);
if (Tcl_ListObjIndex(infoPtr->interp, objPtr, index,
¤tObj) != TCL_OK) {
infoPtr->resultCode = TCL_ERROR;
return NULL;
}
if (currentObj == NULL) {
if (index == TCL_INDEX_NONE) {
index = TCL_INDEX_END - infoPtr->indexv[i];
Tcl_SetObjResult(infoPtr->interp, Tcl_ObjPrintf(
"element end-%" TCL_SIZE_MODIFIER "d missing from sublist \"%s\"",
index, TclGetString(objPtr)));
} else {
Tcl_SetObjResult(infoPtr->interp, Tcl_ObjPrintf(
"element %" TCL_SIZE_MODIFIER "d missing from sublist \"%s\"",
index, TclGetString(objPtr)));
}
Tcl_SetErrorCode(infoPtr->interp, "TCL", "OPERATION", "LSORT",
"INDEXFAILED", (char *)NULL);
infoPtr->resultCode = TCL_ERROR;
return NULL;
}
|
| ︙ | ︙ |
Changes to generic/tclCmdMZ.c.
| ︙ | ︙ | |||
26 27 28 29 30 31 32 | Tcl_Obj *oldOptions, Tcl_Obj *errorInfo); static Tcl_NRPostProc SwitchPostProc; static Tcl_NRPostProc TryPostBody; static Tcl_NRPostProc TryPostFinal; static Tcl_NRPostProc TryPostHandler; static int UniCharIsAscii(int character); static int UniCharIsHexDigit(int character); | | | | | | | | | | | | | | | | | | | | | | | | | | | 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 |
Tcl_Obj *oldOptions, Tcl_Obj *errorInfo);
static Tcl_NRPostProc SwitchPostProc;
static Tcl_NRPostProc TryPostBody;
static Tcl_NRPostProc TryPostFinal;
static Tcl_NRPostProc TryPostHandler;
static int UniCharIsAscii(int character);
static int UniCharIsHexDigit(int character);
static int StringCmpOpts(Tcl_Interp *interp, Tcl_Size objc,
Tcl_Obj *const objv[], int *nocase,
Tcl_Size *reqlength);
static Tcl_ObjCmdProc2 StringCatCmd;
static Tcl_ObjCmdProc2 StringCmpCmd;
static Tcl_ObjCmdProc2 StringEqualCmd;
static Tcl_ObjCmdProc2 StringFirstCmd;
static Tcl_ObjCmdProc2 StringIndexCmd;
static Tcl_ObjCmdProc2 StringInsertCmd;
static Tcl_ObjCmdProc2 StringIsCmd;
static Tcl_ObjCmdProc2 StringLastCmd;
static Tcl_ObjCmdProc2 StringLenCmd;
static Tcl_ObjCmdProc2 StringMapCmd;
static Tcl_ObjCmdProc2 StringMatchCmd;
static Tcl_ObjCmdProc2 StringRangeCmd;
static Tcl_ObjCmdProc2 StringReptCmd;
static Tcl_ObjCmdProc2 StringRplcCmd;
static Tcl_ObjCmdProc2 StringRevCmd;
static Tcl_ObjCmdProc2 StringLowerCmd;
static Tcl_ObjCmdProc2 StringUpperCmd;
static Tcl_ObjCmdProc2 StringTitleCmd;
static Tcl_ObjCmdProc2 StringTrimCmd;
static Tcl_ObjCmdProc2 StringTrimLCmd;
static Tcl_ObjCmdProc2 StringTrimRCmd;
static Tcl_ObjCmdProc2 StringEndCmd;
static Tcl_ObjCmdProc2 StringStartCmd;
static Tcl_ObjCmdProc2 TclUnicodeNormalizeCmd;
/*
* Definition of the contents of the [string] ensemble.
*/
const EnsembleImplMap tclStringImplMap[] = {
{"cat", StringCatCmd, TclCompileStringCatCmd, NULL, NULL, 0},
{"compare", StringCmpCmd, TclCompileStringCmpCmd, NULL, NULL, 0},
|
| ︙ | ︙ | |||
149 150 151 152 153 154 155 |
*----------------------------------------------------------------------
*/
int
Tcl_PwdObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 |
*----------------------------------------------------------------------
*/
int
Tcl_PwdObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_Obj *retVal;
if (objc != 1) {
Tcl_WrongNumArgs(interp, 1, objv, NULL);
return TCL_ERROR;
|
| ︙ | ︙ | |||
189 190 191 192 193 194 195 |
*----------------------------------------------------------------------
*/
int
Tcl_RegexpObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | < | | 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 |
*----------------------------------------------------------------------
*/
int
Tcl_RegexpObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_Size i, about, all, offset, stringLength, matchLength, numMatchesSaved;
int indices, match, doinline, cflags, eflags;
Tcl_RegExp regExpr;
Tcl_Obj *objPtr, *startIndex = NULL, *resultPtr = NULL;
Tcl_RegExpInfo info;
static const char *const options[] = {
"-all", "-about", "-indices", "-inline",
"-expanded", "-line", "-linestop", "-lineanchor",
"-nocase", "-start", "--", NULL
|
| ︙ | ︙ | |||
551 552 553 554 555 556 557 |
*----------------------------------------------------------------------
*/
int
Tcl_RegsubObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 |
*----------------------------------------------------------------------
*/
int
Tcl_RegsubObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
int result, cflags, all, match, command;
Tcl_Size idx, wlen, wsublen = 0, offset, numMatches, numParts;
Tcl_Size start, end, subStart, subEnd;
Tcl_RegExp regExpr;
Tcl_RegExpInfo info;
|
| ︙ | ︙ | |||
1073 1074 1075 1076 1077 1078 1079 |
*----------------------------------------------------------------------
*/
int
Tcl_RenameObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 1072 1073 1074 1075 1076 1077 1078 1079 1080 1081 1082 1083 1084 1085 1086 |
*----------------------------------------------------------------------
*/
int
Tcl_RenameObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
const char *oldName, *newName;
if (objc != 3) {
Tcl_WrongNumArgs(interp, 1, objv, "oldName newName");
return TCL_ERROR;
|
| ︙ | ︙ | |||
1109 1110 1111 1112 1113 1114 1115 |
*----------------------------------------------------------------------
*/
int
Tcl_ReturnObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | | 1108 1109 1110 1111 1112 1113 1114 1115 1116 1117 1118 1119 1120 1121 1122 1123 1124 1125 1126 1127 1128 1129 1130 1131 1132 1133 1134 |
*----------------------------------------------------------------------
*/
int
Tcl_ReturnObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
int code, level;
Tcl_Obj *returnOpts;
/*
* General syntax: [return ?-option value ...? ?result?]
* An even number of words means an explicit result argument is present.
*/
int explicitResult = (0 == (objc % 2));
Tcl_Size numOptionWords = objc - 1 - explicitResult;
if (TCL_ERROR == TclMergeReturnOptions(interp, numOptionWords, objv+1,
&returnOpts, &code, &level)) {
return TCL_ERROR;
}
code = TclProcessReturn(interp, code, level, returnOpts);
|
| ︙ | ︙ | |||
1156 1157 1158 1159 1160 1161 1162 |
*----------------------------------------------------------------------
*/
int
Tcl_SourceObjCmd(
void *clientData,
Tcl_Interp *interp, /* Current interpreter. */
| | | | | 1155 1156 1157 1158 1159 1160 1161 1162 1163 1164 1165 1166 1167 1168 1169 1170 1171 1172 1173 1174 1175 1176 1177 1178 1179 |
*----------------------------------------------------------------------
*/
int
Tcl_SourceObjCmd(
void *clientData,
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
return Tcl_NRCallObjProc2(interp, TclNRSourceObjCmd, clientData, objc, objv);
}
int
TclNRSourceObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
const char *encodingName = NULL;
Tcl_Obj *fileName;
int result;
void **pkgFiles = NULL;
void *names = NULL;
|
| ︙ | ︙ | |||
1240 1241 1242 1243 1244 1245 1246 |
*----------------------------------------------------------------------
*/
int
Tcl_SplitObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | | 1239 1240 1241 1242 1243 1244 1245 1246 1247 1248 1249 1250 1251 1252 1253 1254 1255 1256 1257 |
*----------------------------------------------------------------------
*/
int
Tcl_SplitObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
int ch = 0;
Tcl_Size len;
const char *splitChars;
const char *stringPtr;
const char *end;
Tcl_Size splitCharLen, stringLen;
Tcl_Obj *listPtr, *objPtr;
if (objc == 2) {
|
| ︙ | ︙ | |||
1373 1374 1375 1376 1377 1378 1379 |
*----------------------------------------------------------------------
*/
static int
StringFirstCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 1372 1373 1374 1375 1376 1377 1378 1379 1380 1381 1382 1383 1384 1385 1386 |
*----------------------------------------------------------------------
*/
static int
StringFirstCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_Size start = TCL_INDEX_START;
if (objc < 3 || objc > 4) {
Tcl_WrongNumArgs(interp, 1, objv,
"needleString haystackString ?startIndex?");
|
| ︙ | ︙ | |||
1417 1418 1419 1420 1421 1422 1423 |
*----------------------------------------------------------------------
*/
static int
StringLastCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 1416 1417 1418 1419 1420 1421 1422 1423 1424 1425 1426 1427 1428 1429 1430 |
*----------------------------------------------------------------------
*/
static int
StringLastCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_Size last = TCL_SIZE_MAX;
if (objc < 3 || objc > 4) {
Tcl_WrongNumArgs(interp, 1, objv,
"needleString haystackString ?lastIndex?");
|
| ︙ | ︙ | |||
1461 1462 1463 1464 1465 1466 1467 |
*----------------------------------------------------------------------
*/
static int
StringIndexCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 1460 1461 1462 1463 1464 1465 1466 1467 1468 1469 1470 1471 1472 1473 1474 |
*----------------------------------------------------------------------
*/
static int
StringIndexCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_Size index, end;
if (objc != 3) {
Tcl_WrongNumArgs(interp, 1, objv, "string charIndex");
return TCL_ERROR;
|
| ︙ | ︙ | |||
1528 1529 1530 1531 1532 1533 1534 |
*----------------------------------------------------------------------
*/
static int
StringInsertCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter */
| | | 1527 1528 1529 1530 1531 1532 1533 1534 1535 1536 1537 1538 1539 1540 1541 |
*----------------------------------------------------------------------
*/
static int
StringInsertCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter */
Tcl_Size objc, /* Number of arguments */
Tcl_Obj *const objv[]) /* Argument objects */
{
Tcl_Size length; /* String length */
Tcl_Size index; /* Insert index */
Tcl_Obj *outObj; /* Output object */
if (objc != 4) {
|
| ︙ | ︙ | |||
1585 1586 1587 1588 1589 1590 1591 |
*----------------------------------------------------------------------
*/
static int
StringIsCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | | | 1584 1585 1586 1587 1588 1589 1590 1591 1592 1593 1594 1595 1596 1597 1598 1599 1600 1601 1602 1603 1604 |
*----------------------------------------------------------------------
*/
static int
StringIsCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
const char *string1, *end, *stop;
int (*chcomp)(int) = NULL; /* The UniChar comparison function. */
int result = 1, strict = 0;
Tcl_Size i, failat = 0, length1, length2, length3;
Tcl_Obj *objPtr, *failVarObj = NULL;
Tcl_WideInt w;
static const char *const isClasses[] = {
"alnum", "alpha", "ascii", "control",
"boolean", "dict", "digit", "double",
"entier", "false", "graph", "integer",
|
| ︙ | ︙ | |||
2021 2022 2023 2024 2025 2026 2027 |
*----------------------------------------------------------------------
*/
static int
StringMapCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 2020 2021 2022 2023 2024 2025 2026 2027 2028 2029 2030 2031 2032 2033 2034 |
*----------------------------------------------------------------------
*/
static int
StringMapCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_Size length1, length2, mapElemc, index;
int nocase = 0, mapWithDict = 0, copySource = 0;
Tcl_Obj **mapElemv, *sourceObj, *resultPtr;
Tcl_UniChar *ustring1, *ustring2, *p, *end;
int (*strCmpFn)(const Tcl_UniChar*, const Tcl_UniChar*, size_t);
|
| ︙ | ︙ | |||
2297 2298 2299 2300 2301 2302 2303 |
*----------------------------------------------------------------------
*/
static int
StringMatchCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 2296 2297 2298 2299 2300 2301 2302 2303 2304 2305 2306 2307 2308 2309 2310 |
*----------------------------------------------------------------------
*/
static int
StringMatchCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
int nocase = 0;
if (objc < 3 || objc > 4) {
Tcl_WrongNumArgs(interp, 1, objv, "?-nocase? pattern string");
return TCL_ERROR;
|
| ︙ | ︙ | |||
2348 2349 2350 2351 2352 2353 2354 |
*----------------------------------------------------------------------
*/
static int
StringRangeCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 2347 2348 2349 2350 2351 2352 2353 2354 2355 2356 2357 2358 2359 2360 2361 |
*----------------------------------------------------------------------
*/
static int
StringRangeCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_Size first, last, end;
if (objc != 4) {
Tcl_WrongNumArgs(interp, 1, objv, "string first last");
return TCL_ERROR;
|
| ︙ | ︙ | |||
2398 2399 2400 2401 2402 2403 2404 |
*----------------------------------------------------------------------
*/
static int
StringReptCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 2397 2398 2399 2400 2401 2402 2403 2404 2405 2406 2407 2408 2409 2410 2411 |
*----------------------------------------------------------------------
*/
static int
StringReptCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_WideInt count;
Tcl_Obj *resultPtr;
if (objc != 3) {
Tcl_WrongNumArgs(interp, 1, objv, "string count");
|
| ︙ | ︙ | |||
2454 2455 2456 2457 2458 2459 2460 |
*----------------------------------------------------------------------
*/
static int
StringRplcCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 2453 2454 2455 2456 2457 2458 2459 2460 2461 2462 2463 2464 2465 2466 2467 |
*----------------------------------------------------------------------
*/
static int
StringRplcCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_Size first, last, end;
if (objc < 4 || objc > 5) {
Tcl_WrongNumArgs(interp, 1, objv, "string first last ?string?");
return TCL_ERROR;
|
| ︙ | ︙ | |||
2531 2532 2533 2534 2535 2536 2537 |
*----------------------------------------------------------------------
*/
static int
StringRevCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 2530 2531 2532 2533 2534 2535 2536 2537 2538 2539 2540 2541 2542 2543 2544 |
*----------------------------------------------------------------------
*/
static int
StringRevCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "string");
return TCL_ERROR;
}
|
| ︙ | ︙ | |||
2564 2565 2566 2567 2568 2569 2570 |
*----------------------------------------------------------------------
*/
static int
StringStartCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 2563 2564 2565 2566 2567 2568 2569 2570 2571 2572 2573 2574 2575 2576 2577 |
*----------------------------------------------------------------------
*/
static int
StringStartCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
int ch;
const Tcl_UniChar *p, *string;
Tcl_Size cur, index, length;
Tcl_Obj *obj;
|
| ︙ | ︙ | |||
2635 2636 2637 2638 2639 2640 2641 |
*----------------------------------------------------------------------
*/
static int
StringEndCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 2634 2635 2636 2637 2638 2639 2640 2641 2642 2643 2644 2645 2646 2647 2648 |
*----------------------------------------------------------------------
*/
static int
StringEndCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
int ch;
const Tcl_UniChar *p, *end, *string;
Tcl_Size cur, index, length;
Tcl_Obj *obj;
|
| ︙ | ︙ | |||
2697 2698 2699 2700 2701 2702 2703 |
*----------------------------------------------------------------------
*/
static int
StringEqualCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | | | 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 |
*----------------------------------------------------------------------
*/
static int
StringEqualCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
/*
* Remember to keep code here in some sync with the byte-compiled versions
* in tclExecute.c (INST_STR_EQ, INST_STR_NEQ and INST_STR_CMP as well as
* the expr string comparison in INST_EQ/INST_NEQ/INST_LT/...).
*/
const char *string2;
int match, nocase = 0;
Tcl_Size i, length;
Tcl_WideInt reqlength = -1;
if (objc < 3 || objc > 6) {
str_cmp_args:
Tcl_WrongNumArgs(interp, 1, objv,
"?-nocase? ?-length int? string1 string2");
return TCL_ERROR;
|
| ︙ | ︙ | |||
2777 2778 2779 2780 2781 2782 2783 |
*----------------------------------------------------------------------
*/
static int
StringCmpCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 2776 2777 2778 2779 2780 2781 2782 2783 2784 2785 2786 2787 2788 2789 2790 |
*----------------------------------------------------------------------
*/
static int
StringCmpCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
/*
* Remember to keep code here in some sync with the byte-compiled versions
* in tclExecute.c (INST_STR_EQ, INST_STR_NEQ and INST_STR_CMP as well as
* the expr string comparison in INST_EQ/INST_NEQ/INST_LT/...).
*/
|
| ︙ | ︙ | |||
2803 2804 2805 2806 2807 2808 2809 |
Tcl_SetObjResult(interp, Tcl_NewWideIntObj(match));
return TCL_OK;
}
int
StringCmpOpts(
Tcl_Interp *interp, /* Current interpreter. */
| | < | | 2802 2803 2804 2805 2806 2807 2808 2809 2810 2811 2812 2813 2814 2815 2816 2817 2818 2819 2820 2821 |
Tcl_SetObjResult(interp, Tcl_NewWideIntObj(match));
return TCL_OK;
}
int
StringCmpOpts(
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[], /* Argument objects. */
int *nocase,
Tcl_Size *reqlength)
{
Tcl_Size i, length;
const char *string;
Tcl_WideInt wreqlength = -1;
*nocase = 0;
if (objc < 3 || objc > 6) {
str_cmp_args:
Tcl_WrongNumArgs(interp, 1, objv,
|
| ︙ | ︙ | |||
2872 2873 2874 2875 2876 2877 2878 |
*----------------------------------------------------------------------
*/
static int
StringCatCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 2870 2871 2872 2873 2874 2875 2876 2877 2878 2879 2880 2881 2882 2883 2884 |
*----------------------------------------------------------------------
*/
static int
StringCatCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_Obj *objResultPtr;
if (objc < 2) {
/*
* If there are no args, the result is an empty object.
|
| ︙ | ︙ | |||
2917 2918 2919 2920 2921 2922 2923 |
*----------------------------------------------------------------------
*/
static int
StringLenCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 2915 2916 2917 2918 2919 2920 2921 2922 2923 2924 2925 2926 2927 2928 2929 |
*----------------------------------------------------------------------
*/
static int
StringLenCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "string");
return TCL_ERROR;
}
|
| ︙ | ︙ | |||
2951 2952 2953 2954 2955 2956 2957 |
*----------------------------------------------------------------------
*/
static int
StringLowerCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 2949 2950 2951 2952 2953 2954 2955 2956 2957 2958 2959 2960 2961 2962 2963 |
*----------------------------------------------------------------------
*/
static int
StringLowerCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_Size length1, length2;
const char *string1;
char *string2;
if (objc < 2 || objc > 4) {
|
| ︙ | ︙ | |||
3036 3037 3038 3039 3040 3041 3042 |
*----------------------------------------------------------------------
*/
static int
StringUpperCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 3034 3035 3036 3037 3038 3039 3040 3041 3042 3043 3044 3045 3046 3047 3048 |
*----------------------------------------------------------------------
*/
static int
StringUpperCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_Size length1, length2;
const char *string1;
char *string2;
if (objc < 2 || objc > 4) {
|
| ︙ | ︙ | |||
3121 3122 3123 3124 3125 3126 3127 |
*----------------------------------------------------------------------
*/
static int
StringTitleCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 3119 3120 3121 3122 3123 3124 3125 3126 3127 3128 3129 3130 3131 3132 3133 |
*----------------------------------------------------------------------
*/
static int
StringTitleCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_Size length1, length2;
const char *string1;
char *string2;
if (objc < 2 || objc > 4) {
|
| ︙ | ︙ | |||
3206 3207 3208 3209 3210 3211 3212 |
*----------------------------------------------------------------------
*/
static int
StringTrimCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 3204 3205 3206 3207 3208 3209 3210 3211 3212 3213 3214 3215 3216 3217 3218 |
*----------------------------------------------------------------------
*/
static int
StringTrimCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
const char *string1, *string2;
Tcl_Size triml, trimr, length1, length2;
if (objc == 3) {
string2 = TclGetStringFromObj(objv[2], &length2);
|
| ︙ | ︙ | |||
3253 3254 3255 3256 3257 3258 3259 |
*----------------------------------------------------------------------
*/
static int
StringTrimLCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | | 3251 3252 3253 3254 3255 3256 3257 3258 3259 3260 3261 3262 3263 3264 3265 3266 3267 3268 3269 |
*----------------------------------------------------------------------
*/
static int
StringTrimLCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
const char *string1, *string2;
Tcl_Size trim;
Tcl_Size length1, length2;
if (objc == 3) {
string2 = TclGetStringFromObj(objv[2], &length2);
} else if (objc == 2) {
string2 = tclDefaultTrimSet;
length2 = strlen(tclDefaultTrimSet);
|
| ︙ | ︙ | |||
3300 3301 3302 3303 3304 3305 3306 |
*----------------------------------------------------------------------
*/
static int
StringTrimRCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | | 3298 3299 3300 3301 3302 3303 3304 3305 3306 3307 3308 3309 3310 3311 3312 3313 3314 3315 3316 |
*----------------------------------------------------------------------
*/
static int
StringTrimRCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
const char *string1, *string2;
Tcl_Size trim;
Tcl_Size length1, length2;
if (objc == 3) {
string2 = TclGetStringFromObj(objv[2], &length2);
} else if (objc == 2) {
string2 = tclDefaultTrimSet;
length2 = strlen(tclDefaultTrimSet);
|
| ︙ | ︙ | |||
3391 3392 3393 3394 3395 3396 3397 |
return TCL_OK;
}
int
Tcl_SubstObjCmd(
void *clientData,
Tcl_Interp *interp, /* Current interpreter. */
| | | | | 3389 3390 3391 3392 3393 3394 3395 3396 3397 3398 3399 3400 3401 3402 3403 3404 3405 3406 3407 3408 3409 3410 3411 3412 3413 |
return TCL_OK;
}
int
Tcl_SubstObjCmd(
void *clientData,
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
return Tcl_NRCallObjProc2(interp, TclNRSubstObjCmd, clientData, objc, objv);
}
int
TclNRSubstObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
int flags;
if (objc < 2) {
Tcl_WrongNumArgs(interp, 1, objv,
"?-backslashes? ?-commands? ?-variables? "
|
| ︙ | ︙ | |||
3440 3441 3442 3443 3444 3445 3446 |
*----------------------------------------------------------------------
*/
int
Tcl_SwitchObjCmd(
void *clientData,
Tcl_Interp *interp, /* Current interpreter. */
| | | | | | | | 3438 3439 3440 3441 3442 3443 3444 3445 3446 3447 3448 3449 3450 3451 3452 3453 3454 3455 3456 3457 3458 3459 3460 3461 3462 3463 3464 3465 3466 3467 3468 3469 3470 3471 3472 3473 3474 |
*----------------------------------------------------------------------
*/
int
Tcl_SwitchObjCmd(
void *clientData,
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
return Tcl_NRCallObjProc2(interp, TclNRSwitchObjCmd, clientData, objc, objv);
}
int
TclNRSwitchObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
int noCase, mode, foundmode, splitObjs, numMatchesSaved;
Tcl_Size i;
Tcl_Size patternLength, j;
const char *pattern;
Tcl_Obj *valueObj, *indexVarObj, *matchVarObj;
Tcl_Obj *const *savedObjv = objv;
Tcl_RegExp regExpr = NULL;
Tcl_WideInt intValue = 0, armValue;
Interp *iPtr = (Interp *) interp;
int pc = 0;
Tcl_Size bidx = 0; /* Index of body argument. */
Tcl_Obj *blist = NULL; /* List obj which is the body */
CmdFrame *ctxPtr; /* Copy of the topmost cmdframe, to allow us
* to mess with the line information */
/*
* If you add options that make -e and -g not unique prefixes of -exact or
* -glob, you *must* fix TclCompileSwitchCmd's option parser as well.
|
| ︙ | ︙ | |||
3538 3539 3540 3541 3542 3543 3544 | /* * Check for TIP#75 options specifying the variables to write * regexp information into. */ case OPT_INDEXV: i++; | | | | | 3536 3537 3538 3539 3540 3541 3542 3543 3544 3545 3546 3547 3548 3549 3550 3551 3552 3553 3554 3555 3556 3557 3558 3559 3560 3561 3562 3563 3564 3565 3566 3567 3568 3569 3570 3571 3572 3573 3574 3575 3576 3577 3578 |
/*
* Check for TIP#75 options specifying the variables to write
* regexp information into.
*/
case OPT_INDEXV:
i++;
if (i + 2 >= objc) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"missing variable name argument to %s option",
"-indexvar"));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "SWITCH",
"NOVAR", (char *)NULL);
return TCL_ERROR;
}
indexVarObj = objv[i];
numMatchesSaved = -1;
break;
case OPT_MATCHV:
i++;
if (i + 2 >= objc) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"missing variable name argument to %s option",
"-matchvar"));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "SWITCH",
"NOVAR", (char *)NULL);
return TCL_ERROR;
}
matchVarObj = objv[i];
numMatchesSaved = -1;
break;
}
}
finishedOptions:
if (objc < i + 2) {
Tcl_WrongNumArgs(interp, 1, objv,
"?-option ...? string ?pattern body ...? ?default body?");
return TCL_ERROR;
}
if (indexVarObj != NULL && mode != OPT_REGEXP) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"%s option requires -regexp option", "-indexvar"));
|
| ︙ | ︙ | |||
3621 3622 3623 3624 3625 3626 3627 | return TCL_ERROR; } /* * Ensure that the list is non-empty. */ | | | 3619 3620 3621 3622 3623 3624 3625 3626 3627 3628 3629 3630 3631 3632 3633 |
return TCL_ERROR;
}
/*
* Ensure that the list is non-empty.
*/
if (listc < 1) {
Tcl_WrongNumArgs(interp, 1, savedObjv,
"?-option ...? string {?pattern body ...? ?default body?}");
return TCL_ERROR;
}
if (TclListObjGetElements(interp, objv[0], &listc, &listv) != TCL_OK) {
return TCL_ERROR;
}
|
| ︙ | ︙ | |||
3698 3699 3700 3701 3702 3703 3704 |
for (i = 0; i < objc; i += 2) {
/*
* See if the pattern matches the string.
*/
pattern = TclGetStringFromObj(objv[i], &patternLength);
| | | 3696 3697 3698 3699 3700 3701 3702 3703 3704 3705 3706 3707 3708 3709 3710 |
for (i = 0; i < objc; i += 2) {
/*
* See if the pattern matches the string.
*/
pattern = TclGetStringFromObj(objv[i], &patternLength);
if ((i + 2 == objc) && (*pattern == 'd')
&& (strcmp(pattern, "default") == 0)) {
Tcl_Obj *emptyObj = NULL;
/*
* If either indexVarObj or matchVarObj are non-NULL, we're in
* REGEXP mode but have reached the default clause anyway. TIP#75
* specifies that we set the variables to empty lists (== empty
|
| ︙ | ︙ | |||
3890 3891 3892 3893 3894 3895 3896 |
/*
* The line information in the cmdFrame is now a copy we do not
* own.
*/
}
if (ctxPtr->type == TCL_LOCATION_SOURCE && ctxPtr->line[bidx] >= 0) {
| | | 3888 3889 3890 3891 3892 3893 3894 3895 3896 3897 3898 3899 3900 3901 3902 |
/*
* The line information in the cmdFrame is now a copy we do not
* own.
*/
}
if (ctxPtr->type == TCL_LOCATION_SOURCE && ctxPtr->line[bidx] >= 0) {
Tcl_Size bline = ctxPtr->line[bidx];
ctxPtr->line = (int *)Tcl_Alloc(objc * sizeof(int));
ctxPtr->nline = objc;
TclListLines(blist, bline, objc, ctxPtr->line, objv);
} else {
/*
* This is either a dynamic code word, when all elements are
|
| ︙ | ︙ | |||
3945 3946 3947 3948 3949 3950 3951 |
SwitchPostProc(
void *data[], /* Data passed from Tcl_NRAddCallback above */
Tcl_Interp *interp, /* Tcl interpreter */
int result) /* Result to return*/
{
/* Unpack the preserved data */
| | | | 3943 3944 3945 3946 3947 3948 3949 3950 3951 3952 3953 3954 3955 3956 3957 3958 3959 |
SwitchPostProc(
void *data[], /* Data passed from Tcl_NRAddCallback above */
Tcl_Interp *interp, /* Tcl interpreter */
int result) /* Result to return*/
{
/* Unpack the preserved data */
int splitObjs = PTR2INT(data[0]) != 0;
CmdFrame *ctxPtr = (CmdFrame *)data[1];
Tcl_Size pc = PTR2INT(data[2]);
const char *pattern = (const char *)data[3];
Tcl_Size patternLength = strlen(pattern);
/*
* Clean up TIP 280 context information
*/
|
| ︙ | ︙ | |||
4004 4005 4006 4007 4008 4009 4010 |
*----------------------------------------------------------------------
*/
int
Tcl_ThrowObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 4002 4003 4004 4005 4006 4007 4008 4009 4010 4011 4012 4013 4014 4015 4016 |
*----------------------------------------------------------------------
*/
int
Tcl_ThrowObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_Obj *options;
Tcl_Size len;
if (objc != 3) {
Tcl_WrongNumArgs(interp, 1, objv, "type message");
|
| ︙ | ︙ | |||
4066 4067 4068 4069 4070 4071 4072 |
*----------------------------------------------------------------------
*/
int
Tcl_TimeObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 4064 4065 4066 4067 4068 4069 4070 4071 4072 4073 4074 4075 4076 4077 4078 |
*----------------------------------------------------------------------
*/
int
Tcl_TimeObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_Obj *objPtr;
Tcl_Obj *objs[4];
int i, result;
int count;
double totalMicroSec;
|
| ︙ | ︙ | |||
4164 4165 4166 4167 4168 4169 4170 |
*----------------------------------------------------------------------
*/
int
Tcl_TimeRateObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | > | 4162 4163 4164 4165 4166 4167 4168 4169 4170 4171 4172 4173 4174 4175 4176 4177 4178 4179 4180 4181 4182 4183 4184 |
*----------------------------------------------------------------------
*/
int
Tcl_TimeRateObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
static double measureOverhead = 0;
/* global measure-overhead */
double overhead = -1; /* given measure-overhead */
Tcl_Obj *objPtr;
int result;
Tcl_Size i;
Tcl_Obj *calibrate = NULL, *direct = NULL;
Tcl_WideUInt count = 0; /* Holds repetition count */
Tcl_WideUInt lastCount = 0; /* Repetition count since last calculation. */
Tcl_WideInt maxms = WIDE_MIN;
/* Maximal running time (in milliseconds) */
Tcl_WideUInt maxcnt = UWIDE_MAX;
/* Maximal count of iterations. */
|
| ︙ | ︙ | |||
4210 4211 4212 4213 4214 4215 4216 |
};
enum timeRateOptionsEnum {
TMRT_EV_DIRECT, TMRT_OVERHEAD, TMRT_CALIBRATE, TMRT_LAST
};
NRE_callback *rootPtr;
ByteCode *codePtr = NULL;
| | | | | 4209 4210 4211 4212 4213 4214 4215 4216 4217 4218 4219 4220 4221 4222 4223 4224 4225 4226 4227 4228 4229 4230 4231 4232 4233 4234 4235 4236 4237 4238 4239 4240 4241 4242 4243 4244 4245 4246 4247 4248 4249 4250 4251 4252 4253 4254 4255 4256 |
};
enum timeRateOptionsEnum {
TMRT_EV_DIRECT, TMRT_OVERHEAD, TMRT_CALIBRATE, TMRT_LAST
};
NRE_callback *rootPtr;
ByteCode *codePtr = NULL;
for (i = 1; i + 1 < objc; i++) {
enum timeRateOptionsEnum index;
if (Tcl_GetIndexFromObj(NULL, objv[i], options, "option", TCL_EXACT,
&index) != TCL_OK) {
break;
}
if (index == TMRT_LAST) {
i++;
break;
}
switch (index) {
case TMRT_EV_DIRECT:
direct = objv[i];
break;
case TMRT_OVERHEAD:
if (++i + 1 >= objc) {
goto usage;
}
if (Tcl_GetDoubleFromObj(interp, objv[i], &overhead) != TCL_OK) {
return TCL_ERROR;
}
break;
case TMRT_CALIBRATE:
calibrate = objv[i];
break;
case TMRT_LAST:
break;
default:
TCL_UNREACHABLE();
}
}
if (i >= objc || i + 3 < objc) {
usage:
Tcl_WrongNumArgs(interp, 1, objv,
"?-direct? ?-calibrate? ?-overhead double? "
"command ?time ?max-count??");
return TCL_ERROR;
}
objPtr = objv[i++];
|
| ︙ | ︙ | |||
4411 4412 4413 4414 4415 4416 4417 |
#ifdef TCL_WIDE_CLICKS
start = last = middle = TclpGetWideClicks();
/*
* Time to stop execution (in wide clicks).
*/
| | | 4410 4411 4412 4413 4414 4415 4416 4417 4418 4419 4420 4421 4422 4423 4424 |
#ifdef TCL_WIDE_CLICKS
start = last = middle = TclpGetWideClicks();
/*
* Time to stop execution (in wide clicks).
*/
stop = start + (Tcl_WideInt)((double)maxms * 1000.0 / TclpWideClickInMicrosec());
#else
Tcl_GetTime(&now);
start = now.sec;
start *= 1000000;
start += now.usec;
last = middle = start;
|
| ︙ | ︙ | |||
4570 4571 4572 4573 4574 4575 4576 |
* Estimated count of iteration til the end of execution.
* Thereby 2.5% longer execution time would be OK.
*/
if (threshold / estIterTm < 0.975) {
/* estimated time for next iteration is too large */
break;
}
| | | 4569 4570 4571 4572 4573 4574 4575 4576 4577 4578 4579 4580 4581 4582 4583 |
* Estimated count of iteration til the end of execution.
* Thereby 2.5% longer execution time would be OK.
*/
if (threshold / estIterTm < 0.975) {
/* estimated time for next iteration is too large */
break;
}
threshold = (Tcl_WideUInt)((double)threshold / estIterTm);
/*
* Don't use threshold by few iterations, because sometimes
* first iteration(s) can be too fast or slow (cached, delayed
* clean up, etc). Also avoid unexpected execution time growth,
* so if iterations continuously grow, stay by single iteration.
*/
if (count < 10 || factor >= TR_FACT_SINGLE_ITER) {
|
| ︙ | ︙ | |||
4615 4616 4617 4618 4619 4620 4621 | usec = (Tcl_WideUInt)(middle - start); #ifdef TCL_WIDE_CLICKS /* * convert execution time (in wide clicks) to microsecs. */ | | | 4614 4615 4616 4617 4618 4619 4620 4621 4622 4623 4624 4625 4626 4627 4628 |
usec = (Tcl_WideUInt)(middle - start);
#ifdef TCL_WIDE_CLICKS
/*
* convert execution time (in wide clicks) to microsecs.
*/
usec = (Tcl_WideUInt)((double)usec * TclpWideClickInMicrosec());
#endif /* TCL_WIDE_CLICKS */
if (!count) { /* no iterations - avoid divide by zero */
TclNewIntObj(objs[4], 0);
objs[0] = objs[2] = objs[4];
goto retRes;
}
|
| ︙ | ︙ | |||
4638 4639 4640 4641 4642 4643 4644 |
*/
if (overhead > 0) {
/*
* Estimate the time of overhead (microsecs).
*/
| | | 4637 4638 4639 4640 4641 4642 4643 4644 4645 4646 4647 4648 4649 4650 4651 |
*/
if (overhead > 0) {
/*
* Estimate the time of overhead (microsecs).
*/
Tcl_WideUInt curOverhead = (Tcl_WideUInt)(overhead * (double)count);
if (usec > curOverhead) {
usec -= curOverhead;
} else {
usec = 0;
}
}
|
| ︙ | ︙ | |||
4762 4763 4764 4765 4766 4767 4768 |
*----------------------------------------------------------------------
*/
int
Tcl_TryObjCmd(
void *clientData,
Tcl_Interp *interp, /* Current interpreter. */
| | | | | | | 4761 4762 4763 4764 4765 4766 4767 4768 4769 4770 4771 4772 4773 4774 4775 4776 4777 4778 4779 4780 4781 4782 4783 4784 4785 4786 4787 4788 4789 4790 |
*----------------------------------------------------------------------
*/
int
Tcl_TryObjCmd(
void *clientData,
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
return Tcl_NRCallObjProc2(interp, TclNRTryObjCmd, clientData, objc, objv);
}
int
TclNRTryObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_Obj *bodyObj, *handlersObj, *finallyObj = NULL;
int bodyShared, haveHandlers, code;
Tcl_Size i, dummy;
static const char *const handlerNames[] = {
"finally", "on", "trap", NULL
};
enum Handlers {
TryFinally, TryOn, TryTrap
};
|
| ︙ | ︙ | |||
4811 4812 4813 4814 4815 4816 4817 |
if (Tcl_GetIndexFromObj(interp, objv[i], handlerNames, "handler type",
0, &type) != TCL_OK) {
Tcl_DecrRefCount(handlersObj);
return TCL_ERROR;
}
switch (type) {
case TryFinally: /* finally script */
| | | | | | 4810 4811 4812 4813 4814 4815 4816 4817 4818 4819 4820 4821 4822 4823 4824 4825 4826 4827 4828 4829 4830 4831 4832 4833 4834 4835 4836 4837 4838 4839 4840 4841 4842 4843 4844 4845 4846 4847 4848 4849 4850 4851 4852 4853 4854 4855 4856 4857 4858 4859 4860 4861 4862 |
if (Tcl_GetIndexFromObj(interp, objv[i], handlerNames, "handler type",
0, &type) != TCL_OK) {
Tcl_DecrRefCount(handlersObj);
return TCL_ERROR;
}
switch (type) {
case TryFinally: /* finally script */
if (i+2 < objc) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"finally clause must be last", -1));
Tcl_DecrRefCount(handlersObj);
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "TRY", "FINALLY",
"NONTERMINAL", (char *)NULL);
return TCL_ERROR;
} else if (i+1 == objc) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"wrong # args to finally clause: must be"
" \"... finally script\"", -1));
Tcl_DecrRefCount(handlersObj);
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "TRY", "FINALLY",
"ARGUMENT", (char *)NULL);
return TCL_ERROR;
}
finallyObj = objv[++i];
break;
case TryOn: /* on code variableList script */
if (i+4 > objc) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"wrong # args to on clause: must be \"... on code"
" variableList script\"", -1));
Tcl_DecrRefCount(handlersObj);
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "TRY", "ON",
"ARGUMENT", (char *)NULL);
return TCL_ERROR;
}
if (TclGetCompletionCodeFromObj(interp, objv[i+1],
&code) != TCL_OK) {
Tcl_DecrRefCount(handlersObj);
return TCL_ERROR;
}
info[2] = NULL;
goto commonHandler;
case TryTrap: /* trap pattern variableList script */
if (i+4 > objc) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"wrong # args to trap clause: "
"must be \"... trap pattern variableList script\"",
-1));
Tcl_DecrRefCount(handlersObj);
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "TRY", "TRAP",
"ARGUMENT", (char *)NULL);
|
| ︙ | ︙ | |||
4973 4974 4975 4976 4977 4978 4979 |
static int
TryPostBody(
void *data[],
Tcl_Interp *interp,
int result)
{
Tcl_Obj *resultObj, *options, *handlersObj, *finallyObj, *cmdObj, **objv;
| | | | 4972 4973 4974 4975 4976 4977 4978 4979 4980 4981 4982 4983 4984 4985 4986 4987 |
static int
TryPostBody(
void *data[],
Tcl_Interp *interp,
int result)
{
Tcl_Obj *resultObj, *options, *handlersObj, *finallyObj, *cmdObj, **objv;
int code;
Tcl_Size i, numHandlers = 0, objc;
handlersObj = (Tcl_Obj *)data[0];
finallyObj = (Tcl_Obj *)data[1];
objv = (Tcl_Obj **)data[2];
objc = PTR2INT(data[3]);
cmdObj = objv[0];
|
| ︙ | ︙ | |||
5188 5189 5190 5191 5192 5193 5194 |
TryPostHandler(
void *data[],
Tcl_Interp *interp,
int result)
{
Tcl_Obj *resultObj, *cmdObj, *options, *handlerKindObj, **objv;
Tcl_Obj *finallyObj;
| | | 5187 5188 5189 5190 5191 5192 5193 5194 5195 5196 5197 5198 5199 5200 5201 |
TryPostHandler(
void *data[],
Tcl_Interp *interp,
int result)
{
Tcl_Obj *resultObj, *cmdObj, *options, *handlerKindObj, **objv;
Tcl_Obj *finallyObj;
Tcl_Size finallyIndex;
objv = (Tcl_Obj **)data[0];
options = (Tcl_Obj *)data[1];
handlerKindObj = (Tcl_Obj *)data[2];
finallyIndex = PTR2INT(data[3]);
cmdObj = objv[0];
|
| ︙ | ︙ | |||
5337 5338 5339 5340 5341 5342 5343 |
*----------------------------------------------------------------------
*/
int
Tcl_WhileObjCmd(
void *clientData,
Tcl_Interp *interp, /* Current interpreter. */
| | | | | 5336 5337 5338 5339 5340 5341 5342 5343 5344 5345 5346 5347 5348 5349 5350 5351 5352 5353 5354 5355 5356 5357 5358 5359 5360 |
*----------------------------------------------------------------------
*/
int
Tcl_WhileObjCmd(
void *clientData,
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
return Tcl_NRCallObjProc2(interp, TclNRWhileObjCmd, clientData, objc, objv);
}
int
TclNRWhileObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
ForIterData *iterPtr;
if (objc != 3) {
Tcl_WrongNumArgs(interp, 1, objv, "test command");
return TCL_ERROR;
|
| ︙ | ︙ | |||
5445 5446 5447 5448 5449 5450 5451 |
* Side effects:
* Stores the normalized string in the interpreter result.
*/
static int
TclUnicodeNormalizeCmd(
void *clientData, /* TCL_{NFC,NFD,NFKC,NFKD} */
Tcl_Interp *interp, /* Current interpreter. */
| | | 5444 5445 5446 5447 5448 5449 5450 5451 5452 5453 5454 5455 5456 5457 5458 |
* Side effects:
* Stores the normalized string in the interpreter result.
*/
static int
TclUnicodeNormalizeCmd(
void *clientData, /* TCL_{NFC,NFD,NFKC,NFKD} */
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
static const char *optNames[] = {"-profile", NULL};
enum { OPT_PROFILE } opt;
int profile = TCL_ENCODING_PROFILE_STRICT;
if (objc == 4) {
|
| ︙ | ︙ |
Changes to generic/tclCompCmds.c.
| ︙ | ︙ | |||
817 818 819 820 821 822 823 |
* compiled. */
CompileEnv *envPtr) /* Holds resulting instructions. */
{
if (parsePtr->numWords != 1) {
return TCL_ERROR;
}
| | | 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 |
* compiled. */
CompileEnv *envPtr) /* Holds resulting instructions. */
{
if (parsePtr->numWords != 1) {
return TCL_ERROR;
}
OP1( CLOCK_READ, PTR2INT(cmdPtr->objClientData2));
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
* TclCompileConcatCmd --
|
| ︙ | ︙ |
Changes to generic/tclCompExpr.c.
| ︙ | ︙ | |||
491 492 493 494 495 496 497 | } JumpList; /* * Declarations for local functions to this file: */ static void CompileExprTree(Tcl_Interp *interp, OpNode *nodes, | | | | 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 | } JumpList; /* * Declarations for local functions to this file: */ static void CompileExprTree(Tcl_Interp *interp, OpNode *nodes, Tcl_Size index, Tcl_Obj *const **litObjvPtr, Tcl_Obj *const *funcObjv, Tcl_Token *tokenPtr, CompileEnv *envPtr, bool optimize); static void ConvertTreeToTokens(const char *start, Tcl_Size numBytes, OpNode *nodes, Tcl_Token *tokenPtr, Tcl_Parse *parsePtr); static int ExecConstantExprTree(Tcl_Interp *interp, OpNode *nodes, Tcl_Size index, Tcl_Obj * const **litObjvPtr); static int ParseExpr(Tcl_Interp *interp, const char *start, Tcl_Size numBytes, OpNode **opTreePtr, Tcl_Obj *litList, Tcl_Obj *funcList, Tcl_Parse *parsePtr, bool parseOnly); static Tcl_Size ParseLexeme(const char *start, Tcl_Size numBytes, unsigned char *lexemePtr, Tcl_Obj **literalPtr); |
| ︙ | ︙ | |||
2254 2255 2256 2257 2258 2259 2260 |
*----------------------------------------------------------------------
*/
static int
ExecConstantExprTree(
Tcl_Interp *interp,
OpNode *nodes,
| | | 2254 2255 2256 2257 2258 2259 2260 2261 2262 2263 2264 2265 2266 2267 2268 |
*----------------------------------------------------------------------
*/
static int
ExecConstantExprTree(
Tcl_Interp *interp,
OpNode *nodes,
Tcl_Size index,
Tcl_Obj *const **litObjvPtr)
{
CompileEnv *envPtr;
ByteCode *byteCodePtr;
int code;
NRE_callback *rootPtr = TOP_CB(interp);
|
| ︙ | ︙ | |||
2309 2310 2311 2312 2313 2314 2315 |
*----------------------------------------------------------------------
*/
static void
CompileExprTree(
Tcl_Interp *interp,
OpNode *nodes,
| | | 2309 2310 2311 2312 2313 2314 2315 2316 2317 2318 2319 2320 2321 2322 2323 |
*----------------------------------------------------------------------
*/
static void
CompileExprTree(
Tcl_Interp *interp,
OpNode *nodes,
Tcl_Size index,
Tcl_Obj *const **litObjvPtr,
Tcl_Obj *const *funcObjv,
Tcl_Token *tokenPtr,
CompileEnv *envPtr,
bool optimize)
{
OpNode *nodePtr = nodes + index;
|
| ︙ | ︙ | |||
2592 2593 2594 2595 2596 2597 2598 |
*----------------------------------------------------------------------
*/
int
TclSingleOpCmd(
void *clientData,
Tcl_Interp *interp,
| | | 2592 2593 2594 2595 2596 2597 2598 2599 2600 2601 2602 2603 2604 2605 2606 |
*----------------------------------------------------------------------
*/
int
TclSingleOpCmd(
void *clientData,
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const objv[])
{
TclOpCmdClientData *occdPtr = (TclOpCmdClientData *)clientData;
unsigned char lexeme;
OpNode nodes[2];
Tcl_Obj *const *litObjv = objv + 1;
|
| ︙ | ︙ | |||
2645 2646 2647 2648 2649 2650 2651 |
*----------------------------------------------------------------------
*/
int
TclSortingOpCmd(
void *clientData,
Tcl_Interp *interp,
| | > | | | | | | 2645 2646 2647 2648 2649 2650 2651 2652 2653 2654 2655 2656 2657 2658 2659 2660 2661 2662 2663 2664 2665 2666 2667 2668 2669 2670 2671 2672 2673 2674 2675 2676 2677 2678 2679 2680 2681 2682 2683 2684 2685 2686 2687 2688 2689 2690 2691 2692 2693 2694 2695 2696 2697 2698 2699 |
*----------------------------------------------------------------------
*/
int
TclSortingOpCmd(
void *clientData,
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const objv[])
{
int code = TCL_OK;
if (objc < 3) {
Tcl_SetObjResult(interp, Tcl_NewBooleanObj(1));
} else {
TclOpCmdClientData *occdPtr = (TclOpCmdClientData *)clientData;
Tcl_Obj **litObjv = (Tcl_Obj **)TclStackAlloc(interp,
2 * (objc-2) * sizeof(Tcl_Obj *));
OpNode *nodes = (OpNode *)TclStackAlloc(interp,
2 * (objc-2) * sizeof(OpNode));
unsigned char lexeme;
Tcl_Size i;
int lastAnd = 1;
Tcl_Obj *const *litObjPtrPtr = litObjv;
ParseLexeme(occdPtr->op, strlen(occdPtr->op), &lexeme, NULL);
litObjv[0] = objv[1];
nodes[0].lexeme = START;
nodes[0].mark = MARK_RIGHT;
for (i=2; i<objc-1; i++) {
int j = 2 * (i - 1);
litObjv[j - 1] = objv[i];
nodes[j - 1].lexeme = lexeme;
nodes[j - 1].mark = MARK_LEFT;
nodes[j - 1].left = OT_LITERAL;
nodes[j - 1].right = OT_LITERAL;
litObjv[j] = objv[i];
nodes[j].lexeme = AND;
nodes[j].mark = MARK_LEFT;
nodes[j].left = lastAnd;
nodes[lastAnd].p.parent = 2*((int)i-1);
nodes[2*(i-1)].right = 2*((int)i-1)+1;
nodes[2*(i-1)+1].p.parent= 2*((int)i-1);
lastAnd = 2*((int)i-1);
}
litObjv[2 * (objc - 2) - 1] = objv[objc - 1];
nodes[2 * (objc - 2) - 1].lexeme = lexeme;
nodes[2 * (objc - 2) - 1].mark = MARK_LEFT;
nodes[2 * (objc - 2) - 1].left = OT_LITERAL;
nodes[2 * (objc - 2) - 1].right = OT_LITERAL;
|
| ︙ | ︙ | |||
2727 2728 2729 2730 2731 2732 2733 |
*----------------------------------------------------------------------
*/
int
TclVariadicOpCmd(
void *clientData,
Tcl_Interp *interp,
| | | 2728 2729 2730 2731 2732 2733 2734 2735 2736 2737 2738 2739 2740 2741 2742 |
*----------------------------------------------------------------------
*/
int
TclVariadicOpCmd(
void *clientData,
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const objv[])
{
TclOpCmdClientData *occdPtr = (TclOpCmdClientData *)clientData;
unsigned char lexeme;
int code;
if (objc < 2) {
|
| ︙ | ︙ | |||
2787 2788 2789 2790 2791 2792 2793 |
Tcl_DecrRefCount(litObjv[decrMe]);
return code;
} else {
Tcl_Obj *const *litObjv = objv + 1;
OpNode *nodes = (OpNode *)TclStackAlloc(interp,
(objc - 1) * sizeof(OpNode));
| > | | | | | | 2788 2789 2790 2791 2792 2793 2794 2795 2796 2797 2798 2799 2800 2801 2802 2803 2804 2805 2806 2807 2808 2809 2810 2811 2812 2813 2814 2815 2816 2817 2818 2819 2820 2821 2822 2823 2824 2825 2826 2827 |
Tcl_DecrRefCount(litObjv[decrMe]);
return code;
} else {
Tcl_Obj *const *litObjv = objv + 1;
OpNode *nodes = (OpNode *)TclStackAlloc(interp,
(objc - 1) * sizeof(OpNode));
Tcl_Size i;
int lastOp = OT_LITERAL;
nodes[0].lexeme = START;
nodes[0].mark = MARK_RIGHT;
if (lexeme == EXPON) {
for (i=objc-2; i>0; i--) {
nodes[i].lexeme = lexeme;
nodes[i].mark = MARK_LEFT;
nodes[i].left = OT_LITERAL;
nodes[i].right = lastOp;
if (lastOp >= 0) {
nodes[lastOp].p.parent = (int)i;
}
lastOp = (int)i;
}
} else {
for (i=1; i<objc-1; i++) {
nodes[i].lexeme = lexeme;
nodes[i].mark = MARK_LEFT;
nodes[i].left = lastOp;
if (lastOp >= 0) {
nodes[lastOp].p.parent = (int)i;
}
nodes[i].right = OT_LITERAL;
lastOp = (int)i;
}
}
nodes[0].right = lastOp;
nodes[lastOp].p.parent = 0;
code = ExecConstantExprTree(interp, nodes, 0, &litObjv);
|
| ︙ | ︙ | |||
2847 2848 2849 2850 2851 2852 2853 |
*----------------------------------------------------------------------
*/
int
TclNoIdentOpCmd(
void *clientData,
Tcl_Interp *interp,
| | | 2849 2850 2851 2852 2853 2854 2855 2856 2857 2858 2859 2860 2861 2862 2863 |
*----------------------------------------------------------------------
*/
int
TclNoIdentOpCmd(
void *clientData,
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const objv[])
{
TclOpCmdClientData *occdPtr = (TclOpCmdClientData *)clientData;
if (objc < 2) {
Tcl_WrongNumArgs(interp, 1, objv, occdPtr->expected);
return TCL_ERROR;
|
| ︙ | ︙ |
Changes to generic/tclCompile.h.
| ︙ | ︙ | |||
1229 1230 1231 1232 1233 1234 1235 | /* *---------------------------------------------------------------- * Procedures exported by tclBasic.c to be used within the engine. *---------------------------------------------------------------- */ | | | 1229 1230 1231 1232 1233 1234 1235 1236 1237 1238 1239 1240 1241 1242 1243 | /* *---------------------------------------------------------------- * Procedures exported by tclBasic.c to be used within the engine. *---------------------------------------------------------------- */ MODULE_SCOPE Tcl_ObjCmdProc2 TclNRInterpCoroutine; /* *---------------------------------------------------------------- * Procedures exported by the engine to be used by tclBasic.c *---------------------------------------------------------------- */ |
| ︙ | ︙ | |||
1350 1351 1352 1353 1354 1355 1356 | MODULE_SCOPE void TclPreserveByteCode(ByteCode *codePtr); MODULE_SCOPE int TclRegisterLiteralObj(CompileEnv *envPtr, Tcl_Obj *objPtr, int flags); MODULE_SCOPE void TclReleaseByteCode(ByteCode *codePtr); MODULE_SCOPE void TclReleaseLiteral(Tcl_Interp *interp, Tcl_Obj *objPtr); MODULE_SCOPE void TclInvalidateCmdLiteral(Tcl_Interp *interp, const char *name, Namespace *nsPtr); | | | | | | 1350 1351 1352 1353 1354 1355 1356 1357 1358 1359 1360 1361 1362 1363 1364 1365 1366 1367 | MODULE_SCOPE void TclPreserveByteCode(ByteCode *codePtr); MODULE_SCOPE int TclRegisterLiteralObj(CompileEnv *envPtr, Tcl_Obj *objPtr, int flags); MODULE_SCOPE void TclReleaseByteCode(ByteCode *codePtr); MODULE_SCOPE void TclReleaseLiteral(Tcl_Interp *interp, Tcl_Obj *objPtr); MODULE_SCOPE void TclInvalidateCmdLiteral(Tcl_Interp *interp, const char *name, Namespace *nsPtr); MODULE_SCOPE Tcl_ObjCmdProc2 TclSingleOpCmd; MODULE_SCOPE Tcl_ObjCmdProc2 TclSortingOpCmd; MODULE_SCOPE Tcl_ObjCmdProc2 TclVariadicOpCmd; MODULE_SCOPE Tcl_ObjCmdProc2 TclNoIdentOpCmd; #ifdef TCL_COMPILE_DEBUG MODULE_SCOPE void TclVerifyGlobalLiteralTable(Interp *iPtr); MODULE_SCOPE void TclVerifyLocalLiteralTable(CompileEnv *envPtr); #endif MODULE_SCOPE int TclWordKnownAtCompileTime(Tcl_Token *tokenPtr, Tcl_Obj *valuePtr); MODULE_SCOPE void TclLogCommandInfo(Tcl_Interp *interp, |
| ︙ | ︙ |
Changes to generic/tclConfig.c.
| ︙ | ︙ | |||
37 38 39 40 41 42 43 |
char *encoding;
} QCCD;
/*
* Static functions in this file:
*/
| | | 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 |
char *encoding;
} QCCD;
/*
* Static functions in this file:
*/
static Tcl_ObjCmdProc2 QueryConfigObjCmd;
static Tcl_CmdDeleteProc QueryConfigDelete;
static Tcl_InterpDeleteProc ConfigDictDeleteProc;
static Tcl_Obj * GetConfigDict(Tcl_Interp *interp);
/*
*----------------------------------------------------------------------
*
|
| ︙ | ︙ | |||
159 160 161 162 163 164 165 |
Tcl_GetStringResult(interp), "Tcl_RegisterConfig",
"Unable to create namespace for package configuration.");
}
}
TclDStringAppendLiteral(&cmdName, "::pkgconfig");
| | | 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 |
Tcl_GetStringResult(interp), "Tcl_RegisterConfig",
"Unable to create namespace for package configuration.");
}
}
TclDStringAppendLiteral(&cmdName, "::pkgconfig");
if (Tcl_CreateObjCommand2(interp, Tcl_DStringValue(&cmdName),
QueryConfigObjCmd, cdPtr, QueryConfigDelete) == NULL) {
Tcl_Panic("%s: %s", "Tcl_RegisterConfig",
"Unable to create query command for package configuration");
}
Tcl_DStringFree(&cmdName);
}
|
| ︙ | ︙ | |||
189 190 191 192 193 194 195 |
*----------------------------------------------------------------------
*/
static int
QueryConfigObjCmd(
void *clientData,
Tcl_Interp *interp,
| | | 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 |
*----------------------------------------------------------------------
*/
static int
QueryConfigObjCmd(
void *clientData,
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const *objv)
{
QCCD *cdPtr = (QCCD *)clientData;
Tcl_Obj *pkgName = cdPtr->pkg;
Tcl_Obj *pDB, *pkgDict, *val, *listPtr;
Tcl_Size m, n = 0;
static const char *const subcmdStrings[] = {
|
| ︙ | ︙ |
Changes to generic/tclDecls.h.
| ︙ | ︙ | |||
29 30 31 32 33 34 35 36 37 38 39 40 41 42 | # define TCL_DEPRECATED(msg) EXTERN TCL_DEPRECATED_API(msg) #elif defined(TCL_NO_DEPRECATED) # define TCL_DEPRECATED(msg) MODULE_SCOPE #else # define TCL_DEPRECATED(msg) EXTERN #endif /* * WARNING: This file is automatically generated by the tools/genStubs.tcl * script. Any modifications to the function declarations below should be made * in the generic/tcl.decls script. */ | > > > > > | 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 | # define TCL_DEPRECATED(msg) EXTERN TCL_DEPRECATED_API(msg) #elif defined(TCL_NO_DEPRECATED) # define TCL_DEPRECATED(msg) MODULE_SCOPE #else # define TCL_DEPRECATED(msg) EXTERN #endif #ifdef TCL_NO_DEPRECATED # define Tcl_ObjCmdProc void # define Tcl_CmdTraceProc void # define Tcl_CmdObjTraceProc void #endif /* TCL_NO_DEPRECATED */ /* * WARNING: This file is automatically generated by the tools/genStubs.tcl * script. Any modifications to the function declarations below should be made * in the generic/tcl.decls script. */ |
| ︙ | ︙ | |||
3956 3957 3958 3959 3960 3961 3962 3963 3964 3965 3966 3967 3968 3969 | #endif /* defined(USE_TCL_STUBS) */ /* !END!: Do not edit above this line. */ #undef TclUnusedStubEntry #ifdef _WIN32 # undef Tcl_CreateFileHandler # undef Tcl_DeleteFileHandler # undef Tcl_GetOpenFile #endif #undef TCL_STORAGE_CLASS | > > > > > > | 3961 3962 3963 3964 3965 3966 3967 3968 3969 3970 3971 3972 3973 3974 3975 3976 3977 3978 3979 3980 | #endif /* defined(USE_TCL_STUBS) */ /* !END!: Do not edit above this line. */ #undef TclUnusedStubEntry #ifdef TCL_NO_DEPRECATED # undef Tcl_ObjCmdProc # undef Tcl_CmdTraceProc # undef Tcl_CmdObjTraceProc #endif /* TCL_NO_DEPRECATED */ #ifdef _WIN32 # undef Tcl_CreateFileHandler # undef Tcl_DeleteFileHandler # undef Tcl_GetOpenFile #endif #undef TCL_STORAGE_CLASS |
| ︙ | ︙ | |||
4183 4184 4185 4186 4187 4188 4189 |
#define Tcl_GlobalEvalObj(interp, objPtr) \
Tcl_EvalObjEx(interp, objPtr, TCL_EVAL_GLOBAL)
#define Tcl_Close(interp, chan) Tcl_CloseEx(interp, chan, 0)
#undef TclUtfCharComplete
#undef TclUtfNext
#undef TclUtfPrev
| | > > > > > > | 4194 4195 4196 4197 4198 4199 4200 4201 4202 4203 4204 4205 4206 4207 4208 4209 4210 4211 4212 4213 4214 |
#define Tcl_GlobalEvalObj(interp, objPtr) \
Tcl_EvalObjEx(interp, objPtr, TCL_EVAL_GLOBAL)
#define Tcl_Close(interp, chan) Tcl_CloseEx(interp, chan, 0)
#undef TclUtfCharComplete
#undef TclUtfNext
#undef TclUtfPrev
#ifdef TCL_NO_DEPRECATED
# undef Tcl_CreateObjCommand
# undef Tcl_CreateTrace
# undef Tcl_CreateObjTrace
# undef Tcl_NRCallObjProc
# undef Tcl_NRCreateCommand
#else
# define Tcl_CreateSlave Tcl_CreateChild
# define Tcl_GetSlave Tcl_GetChild
# define Tcl_GetMaster Tcl_GetParent
#endif
/* Protect those 11 functions, make them useless through the stub table */
#undef TclGetStringFromObj
|
| ︙ | ︙ | |||
4286 4287 4288 4289 4290 4291 4292 4293 4294 4295 4296 4297 4298 | # define Tcl_GetAliasObj(interp, childCmd, targetInterpPtr, targetCmdPtr, objcPtr, objv) (sizeof(*(objcPtr)) <= sizeof(int) ? \ tclStubsPtr->tclGetAliasObj((interp), (childCmd), (targetInterpPtr), (targetCmdPtr), (objcPtr), (objv)) : \ tclStubsPtr->tcl_GetAliasObj((interp), (childCmd), (targetInterpPtr), (targetCmdPtr), (Tcl_Size *)(void *)(objcPtr), (objv))) # endif /* defined(USE_TCL_STUBS) */ #endif /* defined(TCL_8_API) */ #define Tcl_GetByteArrayFromObj(objPtr, sizePtr) \ Tcl_GetBytesFromObj(NULL, (objPtr), (sizePtr)) #if TCL_MINOR_VERSION < 1 # undef Tcl_IsEmpty #endif #endif /* _TCLDECLS */ | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 4303 4304 4305 4306 4307 4308 4309 4310 4311 4312 4313 4314 4315 4316 4317 4318 4319 4320 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 |
# define Tcl_GetAliasObj(interp, childCmd, targetInterpPtr, targetCmdPtr, objcPtr, objv) (sizeof(*(objcPtr)) <= sizeof(int) ? \
tclStubsPtr->tclGetAliasObj((interp), (childCmd), (targetInterpPtr), (targetCmdPtr), (objcPtr), (objv)) : \
tclStubsPtr->tcl_GetAliasObj((interp), (childCmd), (targetInterpPtr), (targetCmdPtr), (Tcl_Size *)(void *)(objcPtr), (objv)))
# endif /* defined(USE_TCL_STUBS) */
#endif /* defined(TCL_8_API) */
#define Tcl_GetByteArrayFromObj(objPtr, sizePtr) \
Tcl_GetBytesFromObj(NULL, (objPtr), (sizePtr))
#if defined(__STDC_VERSION__) && (__STDC_VERSION__ >= 201112L)
/* Select method based on type of argument. */
#define TclProc2Generic(typePtr, impl) \
_Generic(typePtr, Tcl_ObjCmdProc2 *: impl ## 2, default: impl)
#define TclTraceProc2Generic(typePtr, impl) \
_Generic(typePtr, Tcl_CmdObjTraceProc2 *: impl ## 2, default: impl)
#ifdef USE_TCL_STUBS
#undef Tcl_CreateObjCommand
#define Tcl_CreateObjCommand(interp, cmdName, typePtr, clientData, deleteProc) \
(TclProc2Generic((typePtr), tclStubsPtr->tcl_CreateObjCommand) \
((interp), (cmdName), (typePtr), (clientData), (deleteProc)))
#undef Tcl_CreateObjTrace
#define Tcl_CreateObjTrace(interp, level, flags, typePtr, clientData, deleteProc) \
(TclTraceProc2Generic((typePtr), tclStubsPtr->tcl_CreateObjTrace) \
((interp), (level), (flags), (typePtr), (clientData), (deleteProc)))
#undef Tcl_NRCreateCommand
#define Tcl_NRCreateCommand(interp, cmdName, typePtr, nreProc, clientData, deleteProc) \
(TclProc2Generic((typePtr), tclStubsPtr->tcl_NRCreateCommand) \
((interp), (cmdName), (typePtr), (nreProc), (clientData), (deleteProc)))
#undef Tcl_NRCallObjProc
#define Tcl_NRCallObjProc(interp, typePtr, clientData, objc, objv) \
(TclProc2Generic((typePtr), tclStubsPtr->tcl_NRCallObjProc) \
((interp), (typePtr), (clientData), (objc), (objv)))
#else
#define Tcl_CreateObjCommand(interp, cmdName, typePtr, clientData, deleteProc) \
(TclProc2Generic((typePtr), Tcl_CreateObjCommand) \
((interp), (cmdName), (typePtr), (clientData), (deleteProc)))
#define Tcl_CreateObjTrace(interp, level, flags, typePtr, clientData, deleteProc) \
(TclTraceProc2Generic((typePtr), Tcl_CreateObjTrace) \
((interp), (level), (flags), (typePtr), (clientData), (deleteProc)))
#define Tcl_NRCreateCommand(interp, cmdName, typePtr, nreProc, clientData, deleteProc) \
(TclProc2Generic((typePtr), Tcl_NRCreateCommand) \
((interp), (cmdName), (typePtr), (nreProc), (clientData), (deleteProc)))
#define Tcl_NRCallObjProc(interp, typePtr, clientData, objc, objv) \
(TclProc2Generic((typePtr), Tcl_NRCallObjProc) \
((interp), (typePtr), (clientData), (objc), (objv)))
#endif
#endif
#if TCL_MINOR_VERSION < 1
# undef Tcl_IsEmpty
#endif
#endif /* _TCLDECLS */
|
Changes to generic/tclDictObj.c.
| ︙ | ︙ | |||
19 20 21 22 23 24 25 | struct Dict; /* * Prototypes for functions defined later in this file: */ static void DeleteDict(struct Dict *dict); | | | | | | | | | | | | | | | | | | | | | | | 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 | struct Dict; /* * Prototypes for functions defined later in this file: */ static void DeleteDict(struct Dict *dict); static Tcl_ObjCmdProc2 DictAppendCmd; static Tcl_ObjCmdProc2 DictCreateCmd; static Tcl_ObjCmdProc2 DictExistsCmd; static Tcl_ObjCmdProc2 DictFilterCmd; static Tcl_ObjCmdProc2 DictGetCmd; static Tcl_ObjCmdProc2 DictGetDefCmd; static Tcl_ObjCmdProc2 DictIncrCmd; static Tcl_ObjCmdProc2 DictInfoCmd; static Tcl_ObjCmdProc2 DictKeysCmd; static Tcl_ObjCmdProc2 DictLappendCmd; static Tcl_ObjCmdProc2 DictMergeCmd; static Tcl_ObjCmdProc2 DictRemoveCmd; static Tcl_ObjCmdProc2 DictReplaceCmd; static Tcl_ObjCmdProc2 DictSetCmd; static Tcl_ObjCmdProc2 DictSizeCmd; static Tcl_ObjCmdProc2 DictUnsetCmd; static Tcl_ObjCmdProc2 DictUpdateCmd; static Tcl_ObjCmdProc2 DictValuesCmd; static Tcl_ObjCmdProc2 DictWithCmd; static Tcl_DupInternalRepProc DupDictInternalRep; static Tcl_FreeInternalRepProc FreeDictInternalRep; static void InvalidateDictChain(Tcl_Obj *dictObj); static Tcl_SetFromAnyProc SetDictFromAny; static Tcl_UpdateStringProc UpdateStringOfDict; static Tcl_AllocHashEntryProc AllocChainEntry; static inline void InitChainTable(struct Dict *dict); static inline void DeleteChainTable(struct Dict *dict); static inline Tcl_HashEntry * CreateChainEntry(struct Dict *dict, Tcl_Obj *keyPtr, int *newPtr); static inline int DeleteChainEntry(struct Dict *dict, Tcl_Obj *keyPtr); static Tcl_NRPostProc FinalizeDictUpdate; static Tcl_NRPostProc FinalizeDictWith; static Tcl_ObjCmdProc2 DictForNRCmd; static Tcl_ObjCmdProc2 DictMapNRCmd; static Tcl_NRPostProc DictForLoopCallback; static Tcl_NRPostProc DictMapLoopCallback; /* * Table of dict subcommand names and implementations. */ |
| ︙ | ︙ | |||
1656 1657 1658 1659 1660 1661 1662 |
*----------------------------------------------------------------------
*/
static int
DictCreateCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | | 1656 1657 1658 1659 1660 1661 1662 1663 1664 1665 1666 1667 1668 1669 1670 1671 1672 1673 1674 |
*----------------------------------------------------------------------
*/
static int
DictCreateCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const *objv)
{
Tcl_Obj *dictObj;
Tcl_Size i;
/*
* Must have an even number of arguments; note that number of preceding
* arguments (i.e. "dict create" is also even, which makes this much
* easier.)
*/
|
| ︙ | ︙ | |||
1706 1707 1708 1709 1710 1711 1712 |
*----------------------------------------------------------------------
*/
static int
DictGetCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | 1706 1707 1708 1709 1710 1711 1712 1713 1714 1715 1716 1717 1718 1719 1720 |
*----------------------------------------------------------------------
*/
static int
DictGetCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const *objv)
{
Tcl_Obj *dictPtr, *valuePtr = NULL;
int result;
if (objc < 2) {
Tcl_WrongNumArgs(interp, 1, objv, "dictionary ?key ...?");
|
| ︙ | ︙ | |||
1799 1800 1801 1802 1803 1804 1805 |
*----------------------------------------------------------------------
*/
static int
DictGetDefCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | | 1799 1800 1801 1802 1803 1804 1805 1806 1807 1808 1809 1810 1811 1812 1813 1814 1815 1816 1817 1818 |
*----------------------------------------------------------------------
*/
static int
DictGetDefCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const *objv)
{
Tcl_Obj *dictPtr, *keyPtr, *valuePtr, *defaultPtr;
Tcl_Obj *const *keyPath;
Tcl_Size numKeys;
if (objc < 4) {
Tcl_WrongNumArgs(interp, 1, objv, "dictionary ?key ...? key default");
return TCL_ERROR;
}
/*
|
| ︙ | ︙ | |||
1864 1865 1866 1867 1868 1869 1870 |
*----------------------------------------------------------------------
*/
static int
DictReplaceCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | | 1864 1865 1866 1867 1868 1869 1870 1871 1872 1873 1874 1875 1876 1877 1878 1879 1880 1881 1882 |
*----------------------------------------------------------------------
*/
static int
DictReplaceCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const *objv)
{
Tcl_Obj *dictPtr;
Tcl_Size i;
if ((objc < 2) || (objc & 1)) {
Tcl_WrongNumArgs(interp, 1, objv, "dictionary ?key value ...?");
return TCL_ERROR;
}
dictPtr = objv[1];
|
| ︙ | ︙ | |||
1912 1913 1914 1915 1916 1917 1918 |
*----------------------------------------------------------------------
*/
static int
DictRemoveCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | | 1912 1913 1914 1915 1916 1917 1918 1919 1920 1921 1922 1923 1924 1925 1926 1927 1928 1929 1930 |
*----------------------------------------------------------------------
*/
static int
DictRemoveCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const *objv)
{
Tcl_Obj *dictPtr;
Tcl_Size i;
if (objc < 2) {
Tcl_WrongNumArgs(interp, 1, objv, "dictionary ?key ...?");
return TCL_ERROR;
}
dictPtr = objv[1];
|
| ︙ | ︙ | |||
1960 1961 1962 1963 1964 1965 1966 |
*----------------------------------------------------------------------
*/
static int
DictMergeCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | | 1960 1961 1962 1963 1964 1965 1966 1967 1968 1969 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 |
*----------------------------------------------------------------------
*/
static int
DictMergeCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const *objv)
{
Tcl_Obj *targetObj, *keyObj = NULL, *valueObj = NULL;
int done, allocatedDict = 0;
Tcl_Size i;
Tcl_DictSearch search;
if (objc == 1) {
/*
* No dictionary arguments; return default (empty value).
*/
|
| ︙ | ︙ | |||
2047 2048 2049 2050 2051 2052 2053 |
*----------------------------------------------------------------------
*/
static int
DictKeysCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | 2047 2048 2049 2050 2051 2052 2053 2054 2055 2056 2057 2058 2059 2060 2061 |
*----------------------------------------------------------------------
*/
static int
DictKeysCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const *objv)
{
Tcl_Obj *listPtr;
const char *pattern = NULL;
if (objc!=2 && objc!=3) {
Tcl_WrongNumArgs(interp, 1, objv, "dictionary ?pattern?");
|
| ︙ | ︙ | |||
2126 2127 2128 2129 2130 2131 2132 |
*----------------------------------------------------------------------
*/
static int
DictValuesCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | 2126 2127 2128 2129 2130 2131 2132 2133 2134 2135 2136 2137 2138 2139 2140 |
*----------------------------------------------------------------------
*/
static int
DictValuesCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const *objv)
{
Tcl_Obj *valuePtr = NULL, *listPtr;
Tcl_DictSearch search;
int done;
const char *pattern;
|
| ︙ | ︙ | |||
2186 2187 2188 2189 2190 2191 2192 |
*----------------------------------------------------------------------
*/
static int
DictSizeCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | 2186 2187 2188 2189 2190 2191 2192 2193 2194 2195 2196 2197 2198 2199 2200 |
*----------------------------------------------------------------------
*/
static int
DictSizeCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const *objv)
{
int result;
Tcl_Size size;
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "dictionary");
|
| ︙ | ︙ | |||
2279 2280 2281 2282 2283 2284 2285 |
*----------------------------------------------------------------------
*/
static int
DictExistsCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | 2279 2280 2281 2282 2283 2284 2285 2286 2287 2288 2289 2290 2291 2292 2293 |
*----------------------------------------------------------------------
*/
static int
DictExistsCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const *objv)
{
Tcl_Obj *dictPtr, *valuePtr;
if (objc < 3) {
Tcl_WrongNumArgs(interp, 1, objv, "dictionary key ?key ...?");
return TCL_ERROR;
|
| ︙ | ︙ | |||
2321 2322 2323 2324 2325 2326 2327 |
*----------------------------------------------------------------------
*/
static int
DictInfoCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | 2321 2322 2323 2324 2325 2326 2327 2328 2329 2330 2331 2332 2333 2334 2335 |
*----------------------------------------------------------------------
*/
static int
DictInfoCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const *objv)
{
Dict *dict;
char *statsStr;
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "dictionary");
|
| ︙ | ︙ | |||
2365 2366 2367 2368 2369 2370 2371 |
*----------------------------------------------------------------------
*/
static int
DictIncrCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | 2365 2366 2367 2368 2369 2370 2371 2372 2373 2374 2375 2376 2377 2378 2379 |
*----------------------------------------------------------------------
*/
static int
DictIncrCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const *objv)
{
int code = TCL_OK;
Tcl_Obj *dictPtr, *valuePtr = NULL;
if (objc < 3 || objc > 4) {
Tcl_WrongNumArgs(interp, 1, objv, "dictVarName key ?increment?");
|
| ︙ | ︙ | |||
2486 2487 2488 2489 2490 2491 2492 |
*----------------------------------------------------------------------
*/
static int
DictLappendCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | | 2486 2487 2488 2489 2490 2491 2492 2493 2494 2495 2496 2497 2498 2499 2500 2501 2502 2503 2504 2505 |
*----------------------------------------------------------------------
*/
static int
DictLappendCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const *objv)
{
Tcl_Obj *dictPtr, *valuePtr, *resultPtr;
int allocatedDict = 0, allocatedValue = 0;
Tcl_Size i;
if (objc < 3) {
Tcl_WrongNumArgs(interp, 1, objv, "dictVarName key ?value ...?");
return TCL_ERROR;
}
dictPtr = Tcl_ObjGetVar2(interp, objv[1], NULL, 0);
|
| ︙ | ︙ | |||
2574 2575 2576 2577 2578 2579 2580 |
*----------------------------------------------------------------------
*/
static int
DictAppendCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | 2574 2575 2576 2577 2578 2579 2580 2581 2582 2583 2584 2585 2586 2587 2588 |
*----------------------------------------------------------------------
*/
static int
DictAppendCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const *objv)
{
Tcl_Obj *dictPtr, *valuePtr, *resultPtr;
int allocatedDict = 0;
if (objc < 3) {
Tcl_WrongNumArgs(interp, 1, objv, "dictVarName key ?value ...?");
|
| ︙ | ︙ | |||
2676 2677 2678 2679 2680 2681 2682 |
*----------------------------------------------------------------------
*/
static int
DictForNRCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | 2676 2677 2678 2679 2680 2681 2682 2683 2684 2685 2686 2687 2688 2689 2690 |
*----------------------------------------------------------------------
*/
static int
DictForNRCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const *objv)
{
Interp *iPtr = (Interp *) interp;
Tcl_Obj *scriptObj, *keyVarObj, *valueVarObj;
Tcl_Obj **varv, *keyObj, *valueObj;
Tcl_DictSearch *searchPtr;
Tcl_Size varc;
|
| ︙ | ︙ | |||
2872 2873 2874 2875 2876 2877 2878 |
*----------------------------------------------------------------------
*/
static int
DictMapNRCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | 2872 2873 2874 2875 2876 2877 2878 2879 2880 2881 2882 2883 2884 2885 2886 |
*----------------------------------------------------------------------
*/
static int
DictMapNRCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const *objv)
{
Interp *iPtr = (Interp *) interp;
Tcl_Obj **varv, *keyObj, *valueObj;
DictMapStorage *storagePtr;
Tcl_Size varc;
int done;
|
| ︙ | ︙ | |||
3085 3086 3087 3088 3089 3090 3091 |
*----------------------------------------------------------------------
*/
static int
DictSetCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | 3085 3086 3087 3088 3089 3090 3091 3092 3093 3094 3095 3096 3097 3098 3099 |
*----------------------------------------------------------------------
*/
static int
DictSetCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const *objv)
{
Tcl_Obj *dictPtr, *resultPtr;
int result, allocatedDict = 0;
if (objc < 4) {
Tcl_WrongNumArgs(interp, 1, objv, "dictVarName key ?key ...? value");
|
| ︙ | ︙ | |||
3145 3146 3147 3148 3149 3150 3151 |
*----------------------------------------------------------------------
*/
static int
DictUnsetCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | 3145 3146 3147 3148 3149 3150 3151 3152 3153 3154 3155 3156 3157 3158 3159 |
*----------------------------------------------------------------------
*/
static int
DictUnsetCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const *objv)
{
Tcl_Obj *dictPtr, *resultPtr;
int result, allocatedDict = 0;
if (objc < 3) {
Tcl_WrongNumArgs(interp, 1, objv, "dictVarName key ?key ...?");
|
| ︙ | ︙ | |||
3204 3205 3206 3207 3208 3209 3210 |
*----------------------------------------------------------------------
*/
static int
DictFilterCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | 3204 3205 3206 3207 3208 3209 3210 3211 3212 3213 3214 3215 3216 3217 3218 |
*----------------------------------------------------------------------
*/
static int
DictFilterCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const *objv)
{
Interp *iPtr = (Interp *) interp;
static const char *const filters[] = {
"key", "script", "value", NULL
};
enum FilterTypes {
|
| ︙ | ︙ | |||
3278 3279 3280 3281 3282 3283 3284 |
/*
* Can't optimize this match for trivial globbing: would disturb
* order.
*/
resultObj = Tcl_NewDictObj();
while (!done) {
| | | 3278 3279 3280 3281 3282 3283 3284 3285 3286 3287 3288 3289 3290 3291 3292 |
/*
* Can't optimize this match for trivial globbing: would disturb
* order.
*/
resultObj = Tcl_NewDictObj();
while (!done) {
Tcl_Size i;
for (i=3 ; i<objc ; i++) {
pattern = TclGetString(objv[i]);
if (Tcl_StringMatch(TclGetString(keyObj), pattern)) {
Tcl_DictObjPut(NULL, resultObj, keyObj, valueObj);
break; /* stop inner loop */
}
|
| ︙ | ︙ | |||
3304 3305 3306 3307 3308 3309 3310 |
if (Tcl_DictObjFirst(interp, objv[1], &search,
&keyObj, &valueObj, &done) != TCL_OK) {
return TCL_ERROR;
}
resultObj = Tcl_NewDictObj();
while (!done) {
| | | 3304 3305 3306 3307 3308 3309 3310 3311 3312 3313 3314 3315 3316 3317 3318 |
if (Tcl_DictObjFirst(interp, objv[1], &search,
&keyObj, &valueObj, &done) != TCL_OK) {
return TCL_ERROR;
}
resultObj = Tcl_NewDictObj();
while (!done) {
Tcl_Size i;
for (i=3 ; i<objc ; i++) {
pattern = TclGetString(objv[i]);
if (Tcl_StringMatch(TclGetString(valueObj), pattern)) {
Tcl_DictObjPut(NULL, resultObj, keyObj, valueObj);
break; /* stop inner loop */
}
|
| ︙ | ︙ | |||
3489 3490 3491 3492 3493 3494 3495 |
*----------------------------------------------------------------------
*/
static int
DictUpdateCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | < | | 3489 3490 3491 3492 3493 3494 3495 3496 3497 3498 3499 3500 3501 3502 3503 3504 3505 3506 3507 3508 |
*----------------------------------------------------------------------
*/
static int
DictUpdateCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const *objv)
{
Interp *iPtr = (Interp *) interp;
Tcl_Obj *dictPtr, *objPtr;
Tcl_Size i, dummy;
if (objc < 5 || !(objc & 1)) {
Tcl_WrongNumArgs(interp, 1, objv,
"dictVarName key varName ?key varName ...? script");
return TCL_ERROR;
}
|
| ︙ | ︙ | |||
3648 3649 3650 3651 3652 3653 3654 |
*----------------------------------------------------------------------
*/
static int
DictWithCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | 3647 3648 3649 3650 3651 3652 3653 3654 3655 3656 3657 3658 3659 3660 3661 |
*----------------------------------------------------------------------
*/
static int
DictWithCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const *objv)
{
Interp *iPtr = (Interp *) interp;
Tcl_Obj *dictPtr, *keysPtr, *pathPtr;
if (objc < 3) {
Tcl_WrongNumArgs(interp, 1, objv, "dictVarName ?key ...? script");
|
| ︙ | ︙ |
Changes to generic/tclDisassemble.c.
| ︙ | ︙ | |||
1349 1350 1351 1352 1353 1354 1355 |
*----------------------------------------------------------------------
*/
int
Tcl_DisassembleObjCmd(
void *clientData, /* What type of operation. */
Tcl_Interp *interp, /* Current interpreter. */
| | | 1349 1350 1351 1352 1353 1354 1355 1356 1357 1358 1359 1360 1361 1362 1363 |
*----------------------------------------------------------------------
*/
int
Tcl_DisassembleObjCmd(
void *clientData, /* What type of operation. */
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
static const char *const types[] = {
"constructor", "destructor",
"lambda", "method", "objmethod", "proc", "script", NULL
};
enum Types {
|
| ︙ | ︙ |
Changes to generic/tclEnsemble.c.
| ︙ | ︙ | |||
14 15 16 17 18 19 20 | #include "tclCompile.h" /* * Declarations for functions local to this file: */ static Tcl_Command InitEnsembleFromOptions(Tcl_Interp *interp, | | | | | 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 | #include "tclCompile.h" /* * Declarations for functions local to this file: */ static Tcl_Command InitEnsembleFromOptions(Tcl_Interp *interp, Tcl_Size objc, Tcl_Obj *const objv[]); static int ReadOneEnsembleOption(Tcl_Interp *interp, Tcl_Command token, Tcl_Obj *optionObj); static int ReadAllEnsembleOptions(Tcl_Interp *interp, Tcl_Command token); static int SetEnsembleConfigOptions(Tcl_Interp *interp, Tcl_Command token, Tcl_Size objc, Tcl_Obj *const objv[]); static inline int EnsembleUnknownCallback(Tcl_Interp *interp, EnsembleConfig *ensemblePtr, Tcl_Size objc, Tcl_Obj *const objv[], Tcl_Obj **prefixObjPtr); static int NsEnsembleImplementationCmdNR(void *clientData, Tcl_Interp *interp,Tcl_Size objc,Tcl_Obj *const objv[]); static void BuildEnsembleConfig(EnsembleConfig *ensemblePtr); static int NsEnsembleStringOrder(const void *strPtr1, const void *strPtr2); static void DeleteEnsembleConfig(void *clientData); static void MakeCachedEnsembleCommand(Tcl_Obj *objPtr, EnsembleConfig *ensemblePtr, Tcl_HashEntry *hPtr, Tcl_Obj *fix); |
| ︙ | ︙ | |||
147 148 149 150 151 152 153 |
*----------------------------------------------------------------------
*/
int
TclNamespaceEnsembleCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 |
*----------------------------------------------------------------------
*/
int
TclNamespaceEnsembleCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const objv[])
{
Namespace *nsPtr = (Namespace *) TclGetCurrentNamespace(interp);
Tcl_Command token; /* The ensemble command. */
enum EnsSubcmds index;
if (nsPtr == NULL || nsPtr->flags & NS_DEAD) {
|
| ︙ | ︙ | |||
254 255 256 257 258 259 260 |
* options are supported.
*
*----------------------------------------------------------------------
*/
static Tcl_Command
InitEnsembleFromOptions(
Tcl_Interp *interp,
| | | 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 |
* options are supported.
*
*----------------------------------------------------------------------
*/
static Tcl_Command
InitEnsembleFromOptions(
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const objv[])
{
Namespace *nsPtr = (Namespace *) TclGetCurrentNamespace(interp);
Namespace *cxtPtr = nsPtr->parentPtr;
Namespace *altFoundNsPtr, *actualCxtPtr;
const char *name = nsPtr->name;
Tcl_Size len;
|
| ︙ | ︙ | |||
869 870 871 872 873 874 875 |
static inline EnsembleConfig *
GetEnsembleFromCommand(
Tcl_Interp *interp, /* Where to report an error. May be NULL. */
Tcl_Command token) /* What to check for ensemble-ness. */
{
Command *cmdPtr = (Command *) token;
| | | | 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892 |
static inline EnsembleConfig *
GetEnsembleFromCommand(
Tcl_Interp *interp, /* Where to report an error. May be NULL. */
Tcl_Command token) /* What to check for ensemble-ness. */
{
Command *cmdPtr = (Command *) token;
if (cmdPtr->objProc2 != TclEnsembleImplementationCmd) {
if (interp != NULL) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"command is not an ensemble", TCL_AUTO_LENGTH));
Tcl_SetErrorCode(interp,
"TCL", "ENSEMBLE", "NOT_ENSEMBLE", (char *)NULL);
}
return NULL;
}
return (EnsembleConfig *)cmdPtr->objClientData2;
}
/*
*----------------------------------------------------------------------
*
* BumpEpochIfNecessary --
*
|
| ︙ | ︙ | |||
1481 1482 1483 1484 1485 1486 1487 |
Tcl_Command token;
token = Tcl_FindCommand(interp, TclGetString(cmdNameObj), NULL, flags);
if (token == NULL) {
return NULL;
}
| | | | 1481 1482 1483 1484 1485 1486 1487 1488 1489 1490 1491 1492 1493 1494 1495 1496 1497 1498 1499 1500 1501 1502 1503 1504 |
Tcl_Command token;
token = Tcl_FindCommand(interp, TclGetString(cmdNameObj), NULL, flags);
if (token == NULL) {
return NULL;
}
if (((Command *) token)->objProc2 != TclEnsembleImplementationCmd) {
/*
* Reuse existing infrastructure for following import link chains
* rather than duplicating it.
*/
token = TclGetOriginalCommand(token);
if (token == NULL ||
((Command *) token)->objProc2 != TclEnsembleImplementationCmd) {
if (flags & TCL_LEAVE_ERR_MSG) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"\"%s\" is not an ensemble command",
TclGetString(cmdNameObj)));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ENSEMBLE",
TclGetString(cmdNameObj), (char *)NULL);
}
|
| ︙ | ︙ | |||
1528 1529 1530 1531 1532 1533 1534 |
int
Tcl_IsEnsemble(
Tcl_Command token) /* The command to check. */
{
Command *cmdPtr = (Command *) token;
| | | | 1528 1529 1530 1531 1532 1533 1534 1535 1536 1537 1538 1539 1540 1541 1542 1543 1544 1545 1546 |
int
Tcl_IsEnsemble(
Tcl_Command token) /* The command to check. */
{
Command *cmdPtr = (Command *) token;
if (cmdPtr->objProc2 == TclEnsembleImplementationCmd) {
return 1;
}
cmdPtr = (Command *) TclGetOriginalCommand((Tcl_Command) cmdPtr);
if (cmdPtr == NULL || cmdPtr->objProc2 != TclEnsembleImplementationCmd) {
return 0;
}
return 1;
}
/*
*----------------------------------------------------------------------
|
| ︙ | ︙ | |||
1664 1665 1666 1667 1668 1669 1670 |
TclNewObj(mapDict);
for (i=0 ; map[i].name != NULL ; i++) {
TclNewStringObj(toObj, Tcl_DStringValue(&buf),
Tcl_DStringLength(&buf));
Tcl_AppendToObj(toObj, map[i].name, TCL_AUTO_LENGTH);
TclDictPut(NULL, mapDict, map[i].name, toObj);
| | | | | | | 1664 1665 1666 1667 1668 1669 1670 1671 1672 1673 1674 1675 1676 1677 1678 1679 1680 1681 1682 1683 1684 1685 1686 1687 1688 1689 1690 1691 1692 1693 1694 1695 1696 1697 1698 1699 1700 1701 1702 1703 1704 1705 1706 |
TclNewObj(mapDict);
for (i=0 ; map[i].name != NULL ; i++) {
TclNewStringObj(toObj, Tcl_DStringValue(&buf),
Tcl_DStringLength(&buf));
Tcl_AppendToObj(toObj, map[i].name, TCL_AUTO_LENGTH);
TclDictPut(NULL, mapDict, map[i].name, toObj);
if (map[i].proc2 || map[i].nreProc2) {
/*
* If the command is unsafe, hide it when we're in a safe
* interpreter. The code to do this is really hokey! It also
* doesn't work properly yet; this function is always
* currently called before the safe-interp flag is set so the
* Tcl_IsSafe check fails.
*/
if (map[i].unsafe && Tcl_IsSafe(interp)) {
cmdPtr = (Command *)
Tcl_NRCreateCommand2(interp, "___tmp", map[i].proc2,
map[i].nreProc2, map[i].clientData, NULL);
Tcl_DStringSetLength(&hiddenBuf, hiddenLen);
if (Tcl_HideCommand(interp, "___tmp",
Tcl_DStringAppend(&hiddenBuf, map[i].name,
TCL_AUTO_LENGTH))) {
Tcl_Panic("%s", Tcl_GetStringResult(interp));
}
/* don't compile unsafe subcommands in safe interp */
cmdPtr->compileProc = NULL;
} else {
/*
* Not hidden, so just create it. Yay!
*/
cmdPtr = (Command *)
Tcl_NRCreateCommand2(interp, TclGetString(toObj),
map[i].proc2, map[i].nreProc2, map[i].clientData,
NULL);
cmdPtr->compileProc = map[i].compileProc;
}
}
}
Tcl_SetEnsembleMappingDict(interp, ensemble, mapDict);
}
|
| ︙ | ︙ | |||
1735 1736 1737 1738 1739 1740 1741 |
*----------------------------------------------------------------------
*/
int
TclEnsembleImplementationCmd(
void *clientData,
Tcl_Interp *interp,
| | | | | 1735 1736 1737 1738 1739 1740 1741 1742 1743 1744 1745 1746 1747 1748 1749 1750 1751 1752 1753 1754 1755 1756 1757 1758 1759 1760 |
*----------------------------------------------------------------------
*/
int
TclEnsembleImplementationCmd(
void *clientData,
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const objv[])
{
return Tcl_NRCallObjProc2(interp, NsEnsembleImplementationCmdNR,
clientData, objc, objv);
}
static int
NsEnsembleImplementationCmdNR(
void *clientData, /* The ensemble this is the impl. of. */
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const objv[])
{
EnsembleConfig *ensemblePtr = (EnsembleConfig *) clientData;
/* The ensemble itself. */
Tcl_Obj *prefixObj; /* An object containing the prefix words of
* the command that implements the
* subcommand. */
|
| ︙ | ︙ | |||
2343 2344 2345 2346 2347 2348 2349 |
* ----------------------------------------------------------------------
*/
static inline int
EnsembleUnknownCallback(
Tcl_Interp *interp,
EnsembleConfig *ensemblePtr,/* The ensemble structure. */
| | | 2343 2344 2345 2346 2347 2348 2349 2350 2351 2352 2353 2354 2355 2356 2357 |
* ----------------------------------------------------------------------
*/
static inline int
EnsembleUnknownCallback(
Tcl_Interp *interp,
EnsembleConfig *ensemblePtr,/* The ensemble structure. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[], /* Actual arguments. */
Tcl_Obj **prefixObjPtr) /* Where to write the prefix suggested by the
* unknown callback. Must not be NULL. Only has
* a meaningful value on TCL_OK. */
{
Tcl_Size paramc;
int result;
|
| ︙ | ︙ | |||
3223 3224 3225 3226 3227 3228 3229 |
/*
* See whether we have a nested ensemble. If we do, we can go round the
* mulberry bush again, consuming the next word.
*/
if (cmdPtr->compileProc == TclCompileEnsemble) {
tokenPtr = TokenAfter(tokenPtr);
| | | 3223 3224 3225 3226 3227 3228 3229 3230 3231 3232 3233 3234 3235 3236 3237 |
/*
* See whether we have a nested ensemble. If we do, we can go round the
* mulberry bush again, consuming the next word.
*/
if (cmdPtr->compileProc == TclCompileEnsemble) {
tokenPtr = TokenAfter(tokenPtr);
if (parsePtr->numWords < depth + 1
|| tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
/*
* Too hard because the user has done something unpleasant like
* omitting the sub-ensemble's command name or used a non-constant
* name for a sub-ensemble's command name; we respond by bailing
* out completely (this is a rare case). [Bug 6d2f249a01]
*/
|
| ︙ | ︙ | |||
3522 3523 3524 3525 3526 3527 3528 3529 3530 3531 3532 3533 3534 3535 |
Tcl_Parse *parsePtr, /* Points to a parse structure for the command
* created by Tcl_ParseCommand. */
Command *cmdPtr, /* Points to definition of command being
* compiled. */
CompileEnv *envPtr) /* Holds resulting instructions. */
{
Tcl_Obj *objPtr;
TclNewObj(objPtr);
Tcl_IncrRefCount(objPtr);
Tcl_GetCommandFullName(interp, (Tcl_Command) cmdPtr, objPtr);
TclCompileInvocation(interp, parsePtr->tokenPtr, objPtr,
parsePtr->numWords, envPtr);
Tcl_DecrRefCount(objPtr);
| > > > > | 3522 3523 3524 3525 3526 3527 3528 3529 3530 3531 3532 3533 3534 3535 3536 3537 3538 3539 |
Tcl_Parse *parsePtr, /* Points to a parse structure for the command
* created by Tcl_ParseCommand. */
Command *cmdPtr, /* Points to definition of command being
* compiled. */
CompileEnv *envPtr) /* Holds resulting instructions. */
{
Tcl_Obj *objPtr;
if (parsePtr->numWords > INT_MAX) {
return TCL_ERROR;
}
TclNewObj(objPtr);
Tcl_IncrRefCount(objPtr);
Tcl_GetCommandFullName(interp, (Tcl_Command) cmdPtr, objPtr);
TclCompileInvocation(interp, parsePtr->tokenPtr, objPtr,
parsePtr->numWords, envPtr);
Tcl_DecrRefCount(objPtr);
|
| ︙ | ︙ | |||
3745 3746 3747 3748 3749 3750 3751 |
{
/*
* Verify that the number of arguments is correct; that's the only case
* that we know will avoid the call to Tcl_WrongNumArgs() at invoke time,
* which is the only code that sees the shenanigans of ensemble dispatch.
*/
| | | 3749 3750 3751 3752 3753 3754 3755 3756 3757 3758 3759 3760 3761 3762 3763 |
{
/*
* Verify that the number of arguments is correct; that's the only case
* that we know will avoid the call to Tcl_WrongNumArgs() at invoke time,
* which is the only code that sees the shenanigans of ensemble dispatch.
*/
if (parsePtr->numWords < 1) {
return TCL_ERROR;
}
return CompileBasicNArgCommand(interp, parsePtr, cmdPtr, envPtr);
}
int
|
| ︙ | ︙ | |||
3767 3768 3769 3770 3771 3772 3773 |
{
/*
* Verify that the number of arguments is correct; that's the only case
* that we know will avoid the call to Tcl_WrongNumArgs() at invoke time,
* which is the only code that sees the shenanigans of ensemble dispatch.
*/
| | | 3771 3772 3773 3774 3775 3776 3777 3778 3779 3780 3781 3782 3783 3784 3785 |
{
/*
* Verify that the number of arguments is correct; that's the only case
* that we know will avoid the call to Tcl_WrongNumArgs() at invoke time,
* which is the only code that sees the shenanigans of ensemble dispatch.
*/
if (parsePtr->numWords < 2) {
return TCL_ERROR;
}
return CompileBasicNArgCommand(interp, parsePtr, cmdPtr, envPtr);
}
int
|
| ︙ | ︙ | |||
3789 3790 3791 3792 3793 3794 3795 |
{
/*
* Verify that the number of arguments is correct; that's the only case
* that we know will avoid the call to Tcl_WrongNumArgs() at invoke time,
* which is the only code that sees the shenanigans of ensemble dispatch.
*/
| | | 3793 3794 3795 3796 3797 3798 3799 3800 3801 3802 3803 3804 3805 3806 3807 3808 3809 3810 3811 3812 3813 |
{
/*
* Verify that the number of arguments is correct; that's the only case
* that we know will avoid the call to Tcl_WrongNumArgs() at invoke time,
* which is the only code that sees the shenanigans of ensemble dispatch.
*/
if (parsePtr->numWords < 3) {
return TCL_ERROR;
}
return CompileBasicNArgCommand(interp, parsePtr, cmdPtr, envPtr);
}
/*
* Local Variables:
* mode: c
* c-basic-offset: 4
* fill-column: 78
* End:
*/
|
Changes to generic/tclEvent.c.
| ︙ | ︙ | |||
61 62 63 64 65 66 67 |
/*
* For each "vwait" event source a structure of the following type
* is used:
*/
typedef struct {
| | | | 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 |
/*
* For each "vwait" event source a structure of the following type
* is used:
*/
typedef struct {
Tcl_Size *donePtr; /* Pointer to flag to signal or NULL. */
Tcl_Size sequence; /* Order of occurrence. */
int mask; /* 0, or TCL_READABLE/TCL_WRITABLE. */
Tcl_Obj *sourceObj; /* Name of the event source, either a
* variable name or channel name. */
} VwaitItem;
/*
* For each exit handler created with a call to Tcl_Create(Late)ExitHandler
|
| ︙ | ︙ | |||
328 329 330 331 332 333 334 |
*----------------------------------------------------------------------
*/
int
TclDefaultBgErrorHandlerObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 |
*----------------------------------------------------------------------
*/
int
TclDefaultBgErrorHandlerObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_Obj *valuePtr;
Tcl_Obj *tempObjv[2];
int result, code, level;
Tcl_InterpState saved;
|
| ︙ | ︙ | |||
457 458 459 460 461 462 463 |
* barrage of error messages. The hidden "bgerror" command can be used
* by a security policy to interpose on such attacks and e.g. kill the
* applet after a few attempts.
*/
if (Tcl_IsSafe(interp)) {
Tcl_RestoreInterpState(interp, saved);
| | | 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 |
* barrage of error messages. The hidden "bgerror" command can be used
* by a security policy to interpose on such attacks and e.g. kill the
* applet after a few attempts.
*/
if (Tcl_IsSafe(interp)) {
Tcl_RestoreInterpState(interp, saved);
Tcl_NRCallObjProc2(interp, TclNRInvoke, NULL, 2, tempObjv);
} else {
Tcl_Channel errChannel = Tcl_GetStdChannel(TCL_STDERR);
if (errChannel != NULL) {
Tcl_Obj *resultPtr = Tcl_GetObjResult(interp);
Tcl_IncrRefCount(resultPtr);
|
| ︙ | ︙ | |||
1522 1523 1524 1525 1526 1527 1528 |
*----------------------------------------------------------------------
*/
int
Tcl_VwaitObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | > | | | 1522 1523 1524 1525 1526 1527 1528 1529 1530 1531 1532 1533 1534 1535 1536 1537 1538 1539 1540 1541 |
*----------------------------------------------------------------------
*/
int
Tcl_VwaitObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_Size i, done = 0, numItems = 0, timedOut = 0;
int foundEvent, any = 1, timeout = 0;
int extended = 0, result, mode, mask = TCL_ALL_EVENTS;
Tcl_InterpState saved = NULL;
Tcl_TimerToken timer = NULL;
Tcl_Time before, after;
Tcl_Channel chan;
Tcl_WideInt diff = -1;
VwaitItem localItems[32], *vwaitItems = localItems;
static const char *const vWaitOptionStrings[] = {
|
| ︙ | ︙ | |||
1624 1625 1626 1627 1628 1629 1630 |
result = Tcl_TraceVar2(interp, TclGetString(objv[i]), NULL,
TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
VwaitVarProc, &vwaitItems[numItems]);
if (result != TCL_OK) {
goto done;
}
vwaitItems[numItems].donePtr = &done;
| | | 1625 1626 1627 1628 1629 1630 1631 1632 1633 1634 1635 1636 1637 1638 1639 |
result = Tcl_TraceVar2(interp, TclGetString(objv[i]), NULL,
TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
VwaitVarProc, &vwaitItems[numItems]);
if (result != TCL_OK) {
goto done;
}
vwaitItems[numItems].donePtr = &done;
vwaitItems[numItems].sequence = TCL_INDEX_NONE;
vwaitItems[numItems].mask = 0;
vwaitItems[numItems].sourceObj = objv[i];
numItems++;
break;
case OPT_READABLE:
if (++i >= objc) {
goto needArg;
|
| ︙ | ︙ | |||
1648 1649 1650 1651 1652 1653 1654 | TclGetString(objv[i]))); result = TCL_ERROR; goto done; } Tcl_CreateChannelHandler(chan, TCL_READABLE, VwaitChannelReadProc, &vwaitItems[numItems]); vwaitItems[numItems].donePtr = &done; | | | 1649 1650 1651 1652 1653 1654 1655 1656 1657 1658 1659 1660 1661 1662 1663 |
TclGetString(objv[i])));
result = TCL_ERROR;
goto done;
}
Tcl_CreateChannelHandler(chan, TCL_READABLE,
VwaitChannelReadProc, &vwaitItems[numItems]);
vwaitItems[numItems].donePtr = &done;
vwaitItems[numItems].sequence = TCL_INDEX_NONE;
vwaitItems[numItems].mask = TCL_READABLE;
vwaitItems[numItems].sourceObj = objv[i];
numItems++;
break;
case OPT_WRITABLE:
if (++i >= objc) {
goto needArg;
|
| ︙ | ︙ | |||
1672 1673 1674 1675 1676 1677 1678 | TclGetString(objv[i]))); result = TCL_ERROR; goto done; } Tcl_CreateChannelHandler(chan, TCL_WRITABLE, VwaitChannelWriteProc, &vwaitItems[numItems]); vwaitItems[numItems].donePtr = &done; | | | 1673 1674 1675 1676 1677 1678 1679 1680 1681 1682 1683 1684 1685 1686 1687 | TclGetString(objv[i]))); result = TCL_ERROR; goto done; } Tcl_CreateChannelHandler(chan, TCL_WRITABLE, VwaitChannelWriteProc, &vwaitItems[numItems]); vwaitItems[numItems].donePtr = &done; vwaitItems[numItems].sequence = TCL_INDEX_NONE; vwaitItems[numItems].mask = TCL_WRITABLE; vwaitItems[numItems].sourceObj = objv[i]; numItems++; break; default: TCL_UNREACHABLE(); } |
| ︙ | ︙ | |||
1708 1709 1710 1711 1712 1713 1714 |
result = Tcl_TraceVar2(interp, TclGetString(objv[i]), NULL,
TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
VwaitVarProc, &vwaitItems[numItems]);
if (result != TCL_OK) {
break;
}
vwaitItems[numItems].donePtr = &done;
| | | 1709 1710 1711 1712 1713 1714 1715 1716 1717 1718 1719 1720 1721 1722 1723 |
result = Tcl_TraceVar2(interp, TclGetString(objv[i]), NULL,
TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
VwaitVarProc, &vwaitItems[numItems]);
if (result != TCL_OK) {
break;
}
vwaitItems[numItems].donePtr = &done;
vwaitItems[numItems].sequence = TCL_INDEX_NONE;
vwaitItems[numItems].mask = 0;
vwaitItems[numItems].sourceObj = objv[i];
numItems++;
}
if (result != TCL_OK) {
result = TCL_ERROR;
goto done;
|
| ︙ | ︙ | |||
1732 1733 1734 1735 1736 1737 1738 |
goto done;
}
}
}
if (timeout > 0) {
vwaitItems[numItems].donePtr = &timedOut;
| | | 1733 1734 1735 1736 1737 1738 1739 1740 1741 1742 1743 1744 1745 1746 1747 |
goto done;
}
}
}
if (timeout > 0) {
vwaitItems[numItems].donePtr = &timedOut;
vwaitItems[numItems].sequence = TCL_INDEX_NONE;
vwaitItems[numItems].mask = 0;
vwaitItems[numItems].sourceObj = NULL;
timer = Tcl_CreateTimerHandler(timeout, VwaitTimeoutProc,
&vwaitItems[numItems]);
Tcl_GetTime(&before);
} else {
timeout = 0;
|
| ︙ | ︙ | |||
1850 1851 1852 1853 1854 1855 1856 |
NULL, TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
VwaitVarProc, &vwaitItems[i]);
}
}
if (result == TCL_OK) {
if (extended) {
| | | 1851 1852 1853 1854 1855 1856 1857 1858 1859 1860 1861 1862 1863 1864 1865 |
NULL, TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
VwaitVarProc, &vwaitItems[i]);
}
}
if (result == TCL_OK) {
if (extended) {
Tcl_Size k;
Tcl_Obj *listObj, *keyObj;
TclNewObj(listObj);
for (k = 0; k < done; k++) {
for (i = 0; i < numItems; i++) {
if (vwaitItems[i].sequence != k) {
continue;
|
| ︙ | ︙ | |||
1977 1978 1979 1980 1981 1982 1983 |
*----------------------------------------------------------------------
*/
int
Tcl_UpdateObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 1978 1979 1980 1981 1982 1983 1984 1985 1986 1987 1988 1989 1990 1991 1992 |
*----------------------------------------------------------------------
*/
int
Tcl_UpdateObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
int flags = 0; /* Initialized to avoid compiler warning. */
static const char *const updateOptions[] = {"idletasks", NULL};
enum updateOptionsEnum {OPT_IDLETASKS} optionIndex;
if (objc == 1) {
|
| ︙ | ︙ |
Changes to generic/tclExecute.c.
| ︙ | ︙ | |||
670 671 672 673 674 675 676 | #define OUT_OF_MEMORY ((Tcl_Obj *) -4) /* * Declarations for local procedures to this file: */ #ifdef TCL_COMPILE_STATS | | | 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684 | #define OUT_OF_MEMORY ((Tcl_Obj *) -4) /* * Declarations for local procedures to this file: */ #ifdef TCL_COMPILE_STATS static Tcl_ObjCmdProc2 EvalStatsCmd; #endif /* TCL_COMPILE_STATS */ #ifdef TCL_COMPILE_DEBUG static const char * GetOpcodeName(const unsigned char *pc); static void PrintByteCodeInfo(ByteCode *codePtr); static const char * StringForResultCode(int result); static void ValidatePcAndStackTop(ByteCode *codePtr, const unsigned char *pc, size_t stackTop, |
| ︙ | ︙ | |||
813 814 815 816 817 818 819 |
#ifdef TCL_COMPILE_DEBUG
if (Tcl_LinkVar(interp, "tcl_traceExec", &tclTraceExec,
TCL_LINK_INT) != TCL_OK) {
Tcl_Panic("InitByteCodeExecution: can't create link for tcl_traceExec variable");
}
#endif
#ifdef TCL_COMPILE_STATS
| | | 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 |
#ifdef TCL_COMPILE_DEBUG
if (Tcl_LinkVar(interp, "tcl_traceExec", &tclTraceExec,
TCL_LINK_INT) != TCL_OK) {
Tcl_Panic("InitByteCodeExecution: can't create link for tcl_traceExec variable");
}
#endif
#ifdef TCL_COMPILE_STATS
Tcl_CreateObjCommand2(interp, "evalstats", EvalStatsCmd, NULL, NULL);
#endif /* TCL_COMPILE_STATS */
}
#else
static void
InitByteCodeExecution(
|
| ︙ | ︙ | |||
2719 2720 2721 2722 2723 2724 2725 |
}
case INST_UPLEVEL: {
Tcl_Obj *levelObj = OBJ_UNDER_TOS;
Tcl_Obj *scriptObj = OBJ_AT_TOS;
CallFrame *framePtr;
CmdFrame *invoker = NULL;
| | | 2719 2720 2721 2722 2723 2724 2725 2726 2727 2728 2729 2730 2731 2732 2733 |
}
case INST_UPLEVEL: {
Tcl_Obj *levelObj = OBJ_UNDER_TOS;
Tcl_Obj *scriptObj = OBJ_AT_TOS;
CallFrame *framePtr;
CmdFrame *invoker = NULL;
Tcl_Size word = 0;
TRACE("\"%.30s\" \"%.30s\" => ", O2S(levelObj), O2S(scriptObj));
if (TclObjGetFrame(interp, levelObj, &framePtr) == -1) {
TRACE_ERROR(interp);
goto gotError;
}
bcFramePtr->data.tebc.pc = (char *) pc;
|
| ︙ | ︙ | |||
3058 3059 3060 3061 3062 3063 3064 | ArgumentBCEnter(interp, codePtr, TD, pc, objc, objv); } DECACHE_STACK_INFO(); pc += pcAdjustment; TEBC_YIELD(); | < < < | < | 3058 3059 3060 3061 3062 3063 3064 3065 3066 3067 3068 3069 3070 3071 3072 3073 |
ArgumentBCEnter(interp, codePtr, TD, pc, objc, objv);
}
DECACHE_STACK_INFO();
pc += pcAdjustment;
TEBC_YIELD();
return TclNREvalObjv(interp, objc, objv,
TCL_EVAL_NOERR | TCL_EVAL_SOURCE_IN_FRAME, NULL);
case INST_INVOKE_REPLACE:
objc = TclGetUInt4AtPtr(pc + 1);
numArgs = TclGetUInt1AtPtr(pc + 5);
objPtr = POP_OBJECT();
objv = &OBJ_AT_DEPTH(objc - 1);
cleanup = objc;
|
| ︙ | ︙ | |||
4886 4887 4888 4889 4890 4891 4892 | // Update the context fields to point to the next impl contextPtr->skip = skip; contextPtr->index = newDepth; // Call the selected next method non-recursively const Method *mPtr = contextPtr->callPtr->chain[newDepth].mPtr; | > | > > > > > > > | > | 4882 4883 4884 4885 4886 4887 4888 4889 4890 4891 4892 4893 4894 4895 4896 4897 4898 4899 4900 4901 4902 4903 4904 4905 4906 4907 4908 |
// Update the context fields to point to the next impl
contextPtr->skip = skip;
contextPtr->index = newDepth;
// Call the selected next method non-recursively
const Method *mPtr = contextPtr->callPtr->chain[newDepth].mPtr;
#ifndef TCL_NO_DEPRECATED
if (mPtr->typePtr->version == TCL_OO_METHOD_VERSION_1) {
if (objc > INT_MAX) {
TRACE_ERROR(interp);
goto gotError;
}
// Ugly indirect cast
Tcl_MethodCallProc *callProc = (Tcl_MethodCallProc *)
(void *)mPtr->type2Ptr->callProc;
return callProc(mPtr->clientData, interp,
(Tcl_ObjectContext) contextPtr, (int)numArgs, objv);
}
#endif /* TCL_NO_DEPRECATED */
return mPtr->type2Ptr->callProc(mPtr->clientData, interp,
(Tcl_ObjectContext) contextPtr, numArgs, objv);
}
tclooFrameRequired:
TRACE_APPEND("ERROR: no TclOO call context\n");
CACHE_STACK_INFO();
|
| ︙ | ︙ | |||
10093 10094 10095 10096 10097 10098 10099 |
*----------------------------------------------------------------------
*/
static int
EvalStatsCmd(
TCL_UNUSED(void *), /* Unused. */
Tcl_Interp *interp, /* The current interpreter. */
| | | 10098 10099 10100 10101 10102 10103 10104 10105 10106 10107 10108 10109 10110 10111 10112 |
*----------------------------------------------------------------------
*/
static int
EvalStatsCmd(
TCL_UNUSED(void *), /* Unused. */
Tcl_Interp *interp, /* The current interpreter. */
Tcl_Size objc, /* The number of arguments. */
Tcl_Obj *const objv[]) /* The argument strings. */
{
Interp *iPtr = (Interp *) interp;
LiteralTable *globalTablePtr = &iPtr->literalTable;
ByteCodeStats *statsPtr = &iPtr->stats;
double totalCodeBytes, currentCodeBytes;
double totalLiteralBytes, currentLiteralBytes;
|
| ︙ | ︙ |
Changes to generic/tclFCmd.c.
| ︙ | ︙ | |||
18 19 20 21 22 23 24 | */ static int CopyRenameOneFile(Tcl_Interp *interp, Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr, int copyFlag, int force); static Tcl_Obj * FileBasename(Tcl_Interp *interp, Tcl_Obj *pathPtr); static int FileCopyRename(Tcl_Interp *interp, | | | | | 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 | */ static int CopyRenameOneFile(Tcl_Interp *interp, Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr, int copyFlag, int force); static Tcl_Obj * FileBasename(Tcl_Interp *interp, Tcl_Obj *pathPtr); static int FileCopyRename(Tcl_Interp *interp, Tcl_Size objc, Tcl_Obj *const objv[], int copyFlag); static size_t FileForceOption(Tcl_Interp *interp, Tcl_Size objc, Tcl_Obj *const objv[], int *forcePtr); /* *--------------------------------------------------------------------------- * * CheckFilenameEncodable * * This checks if a filename can be encoded on the target platform, |
| ︙ | ︙ | |||
74 75 76 77 78 79 80 |
*/
int
TclFileRenameCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Interp for error reporting or recursive
* calls in the case of a tricky rename. */
| | | 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 |
*/
int
TclFileRenameCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Interp for error reporting or recursive
* calls in the case of a tricky rename. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument strings passed to Tcl_FileCmd. */
{
return FileCopyRename(interp, objc, objv, 0);
}
/*
*---------------------------------------------------------------------------
|
| ︙ | ︙ | |||
103 104 105 106 107 108 109 |
*/
int
TclFileCopyCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Used for error reporting or recursive calls
* in the case of a tricky copy. */
| | | 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 |
*/
int
TclFileCopyCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Used for error reporting or recursive calls
* in the case of a tricky copy. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument strings passed to Tcl_FileCmd. */
{
return FileCopyRename(interp, objc, objv, 1);
}
/*
*---------------------------------------------------------------------------
|
| ︙ | ︙ | |||
129 130 131 132 133 134 135 |
*
*---------------------------------------------------------------------------
*/
static int
FileCopyRename(
Tcl_Interp *interp, /* Used for error reporting. */
| | | > | | 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 |
*
*---------------------------------------------------------------------------
*/
static int
FileCopyRename(
Tcl_Interp *interp, /* Used for error reporting. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[], /* Argument strings passed to Tcl_FileCmd. */
int copyFlag) /* If non-zero, copy source(s). Otherwise,
* rename them. */
{
int result, force;
Tcl_Size i;
Tcl_StatBuf statBuf;
Tcl_Obj *target;
i = FileForceOption(interp, objc - 1, objv + 1, &force);
if (i == TCL_INDEX_NONE) {
return TCL_ERROR;
}
i++;
if ((objc - i) < 2) {
Tcl_WrongNumArgs(interp, 1, objv,
"?-option value ...? source ?source ...? target");
return TCL_ERROR;
|
| ︙ | ︙ | |||
243 244 245 246 247 248 249 |
*----------------------------------------------------------------------
*/
int
TclFileMakeDirsCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Used for error reporting. */
| | | | | 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 |
*----------------------------------------------------------------------
*/
int
TclFileMakeDirsCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Used for error reporting. */
Tcl_Size objc, /* Number of arguments */
Tcl_Obj *const objv[]) /* Argument strings passed to Tcl_FileCmd. */
{
Tcl_Obj *errfile = NULL;
int result;
Tcl_Size i, j, pobjc;
Tcl_Obj *split = NULL;
Tcl_Obj *target = NULL;
Tcl_StatBuf statBuf;
result = TCL_OK;
for (i = 1; i < objc; i++) {
if (Tcl_FSConvertToPathType(interp, objv[i]) != TCL_OK) {
|
| ︙ | ︙ | |||
372 373 374 375 376 377 378 |
*----------------------------------------------------------------------
*/
int
TclFileDeleteCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Used for error reporting */
| | | > | | 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 |
*----------------------------------------------------------------------
*/
int
TclFileDeleteCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Used for error reporting */
Tcl_Size objc, /* Number of arguments */
Tcl_Obj *const objv[]) /* Argument strings passed to Tcl_FileCmd. */
{
int force, result;
Tcl_Size i;
Tcl_Obj *errfile;
Tcl_Obj *errorBuffer = NULL;
i = FileForceOption(interp, objc - 1, objv + 1, &force);
if (i == TCL_INDEX_NONE) {
return TCL_ERROR;
}
errfile = NULL;
result = TCL_OK;
for (i++ ; i < objc; i++) {
|
| ︙ | ︙ | |||
608 609 610 611 612 613 614 |
* -force is given. We now try to adjust permissions to ensure the
* operation succeeds. If we can't adjust permissions, we'll let the
* actual copy/rename return an error later.
*/
{
Tcl_Obj *perm;
| | | 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 |
* -force is given. We now try to adjust permissions to ensure the
* operation succeeds. If we can't adjust permissions, we'll let the
* actual copy/rename return an error later.
*/
{
Tcl_Obj *perm;
int index;
TclNewLiteralStringObj(perm, "u+w");
Tcl_IncrRefCount(perm);
if (TclFSFileAttrIndex(target, "-permissions", &index) == TCL_OK) {
Tcl_FSFileAttrsSet(NULL, index, target, perm);
}
Tcl_DecrRefCount(perm);
|
| ︙ | ︙ | |||
857 858 859 860 861 862 863 | * * Side effects: * None. * *--------------------------------------------------------------------------- */ | | | | > | | 859 860 861 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 |
*
* Side effects:
* None.
*
*---------------------------------------------------------------------------
*/
static size_t
FileForceOption(
Tcl_Interp *interp, /* Interp, for error return. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[], /* Argument strings. First command line
* option, if it exists, begins at 0. */
int *forcePtr) /* If the "-force" was specified, *forcePtr is
* filled with 1, otherwise with 0. */
{
int force, idx;
Tcl_Size i;
static const char *const options[] = {
"-force", "--", NULL
};
force = 0;
for (i = 0; i < objc; i++) {
if (TclGetString(objv[i])[0] != '-') {
break;
}
if (Tcl_GetIndexFromObj(interp, objv[i], options, "option", TCL_EXACT,
&idx) != TCL_OK) {
return TCL_INDEX_NONE;
}
if (idx == 0 /* -force */) {
force = 1;
} else { /* -- */
i++;
break;
}
|
| ︙ | ︙ | |||
981 982 983 984 985 986 987 |
*----------------------------------------------------------------------
*/
int
TclFileAttrsCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* The interpreter for error reporting. */
| | | 984 985 986 987 988 989 990 991 992 993 994 995 996 997 998 |
*----------------------------------------------------------------------
*/
int
TclFileAttrsCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* The interpreter for error reporting. */
Tcl_Size objc, /* Number of command line arguments. */
Tcl_Obj *const objv[]) /* The command line objects. */
{
int result;
const char *const *attributeStrings;
const char **attributeStringsAllocated = NULL;
Tcl_Obj *objStrings = NULL;
Tcl_Size numObjStrings = TCL_INDEX_NONE;
|
| ︙ | ︙ | |||
1134 1135 1136 1137 1138 1139 1140 |
}
Tcl_SetObjResult(interp, objPtr);
} else {
/*
* Set option/value pairs.
*/
| > | | 1137 1138 1139 1140 1141 1142 1143 1144 1145 1146 1147 1148 1149 1150 1151 1152 |
}
Tcl_SetObjResult(interp, objPtr);
} else {
/*
* Set option/value pairs.
*/
Tcl_Size i;
int index;
if (numObjStrings == 0) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"bad option \"%s\", there are no file attributes in this"
" filesystem", TclGetString(objv[0])));
Tcl_SetErrorCode(interp, "TCL","OPERATION","FATTR","NONE", (char *)NULL);
goto end;
|
| ︙ | ︙ | |||
1200 1201 1202 1203 1204 1205 1206 |
*----------------------------------------------------------------------
*/
int
TclFileLinkCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | 1204 1205 1206 1207 1208 1209 1210 1211 1212 1213 1214 1215 1216 1217 1218 |
*----------------------------------------------------------------------
*/
int
TclFileLinkCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const objv[])
{
Tcl_Obj *contents;
int index;
if (objc < 2 || objc > 4) {
Tcl_WrongNumArgs(interp, 1, objv, "?-linktype? linkname ?target?");
|
| ︙ | ︙ | |||
1357 1358 1359 1360 1361 1362 1363 |
*----------------------------------------------------------------------
*/
int
TclFileReadLinkCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | 1361 1362 1363 1364 1365 1366 1367 1368 1369 1370 1371 1372 1373 1374 1375 |
*----------------------------------------------------------------------
*/
int
TclFileReadLinkCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const objv[])
{
Tcl_Obj *contents;
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "name");
return TCL_ERROR;
|
| ︙ | ︙ | |||
1411 1412 1413 1414 1415 1416 1417 |
*---------------------------------------------------------------------------
*/
int
TclFileTemporaryCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | 1415 1416 1417 1418 1419 1420 1421 1422 1423 1424 1425 1426 1427 1428 1429 |
*---------------------------------------------------------------------------
*/
int
TclFileTemporaryCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const objv[])
{
Tcl_Obj *nameVarObj = NULL; /* Variable to store the name of the temporary
* file in. */
Tcl_Obj *nameObj = NULL; /* Object that will contain the filename. */
Tcl_Channel chan; /* The channel opened (RDWR) on the temporary
* file, or NULL if there's an error. */
|
| ︙ | ︙ | |||
1570 1571 1572 1573 1574 1575 1576 |
*---------------------------------------------------------------------------
*/
int
TclFileTempDirCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | 1574 1575 1576 1577 1578 1579 1580 1581 1582 1583 1584 1585 1586 1587 1588 |
*---------------------------------------------------------------------------
*/
int
TclFileTempDirCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const objv[])
{
Tcl_Obj *dirNameObj; /* Object that will contain the directory
* name. */
Tcl_Obj *baseDirObj = NULL, *nameBaseObj = NULL;
/* Pieces of template. Each piece is NULL if
* it is omitted. The platform temporary file
|
| ︙ | ︙ | |||
1715 1716 1717 1718 1719 1720 1721 |
*----------------------------------------------------------------------
*/
int
TclFileHomeCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | 1719 1720 1721 1722 1723 1724 1725 1726 1727 1728 1729 1730 1731 1732 1733 |
*----------------------------------------------------------------------
*/
int
TclFileHomeCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const objv[])
{
Tcl_Obj *homeDirObj;
if (objc != 1 && objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "?user?");
return TCL_ERROR;
|
| ︙ | ︙ | |||
1753 1754 1755 1756 1757 1758 1759 |
*----------------------------------------------------------------------
*/
int
TclFileTildeExpandCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | 1757 1758 1759 1760 1761 1762 1763 1764 1765 1766 1767 1768 1769 1770 1771 |
*----------------------------------------------------------------------
*/
int
TclFileTildeExpandCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const objv[])
{
Tcl_Obj *expandedPathObj;
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "path");
return TCL_ERROR;
|
| ︙ | ︙ |
Changes to generic/tclFileName.c.
| ︙ | ︙ | |||
1113 1114 1115 1116 1117 1118 1119 |
*----------------------------------------------------------------------
*/
int
Tcl_GlobObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | | | 1113 1114 1115 1116 1117 1118 1119 1120 1121 1122 1123 1124 1125 1126 1127 1128 1129 1130 1131 |
*----------------------------------------------------------------------
*/
int
Tcl_GlobObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
int globFlags, join, dir, result;
Tcl_Size i, length;
char *string;
const char *separators;
Tcl_Obj *typePtr, *look;
Tcl_Obj *pathOrDir = NULL;
Tcl_DString prefix;
static const char *const options[] = {
"-directory", "-join", "-nocomplain", "-path", "-tails",
|
| ︙ | ︙ |
Changes to generic/tclFileSystem.h.
| ︙ | ︙ | |||
19 20 21 22 23 24 25 | * The internal TclFS API provides routines for handling and manipulating * paths efficiently, taking direct advantage of the "path" Tcl_Obj type. * * These functions are not exported at all at present. */ MODULE_SCOPE int TclFSCwdPointerEquals(Tcl_Obj **pathPtrPtr); | | | | 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 | * The internal TclFS API provides routines for handling and manipulating * paths efficiently, taking direct advantage of the "path" Tcl_Obj type. * * These functions are not exported at all at present. */ MODULE_SCOPE int TclFSCwdPointerEquals(Tcl_Obj **pathPtrPtr); MODULE_SCOPE Tcl_Size TclFSNormalizeToUniquePath(Tcl_Interp *interp, Tcl_Obj *pathPtr, Tcl_Size startAt); MODULE_SCOPE Tcl_Obj * TclFSMakePathRelative(Tcl_Interp *interp, Tcl_Obj *pathPtr, Tcl_Obj *cwdPtr); MODULE_SCOPE int TclFSEnsureEpochOk(Tcl_Obj *pathPtr, const Tcl_Filesystem **fsPtrPtr); MODULE_SCOPE void TclFSSetPathDetails(Tcl_Obj *pathPtr, const Tcl_Filesystem *fsPtr, void *clientData); MODULE_SCOPE Tcl_Obj * TclFSNormalizeAbsolutePath(Tcl_Interp *interp, |
| ︙ | ︙ |
Changes to generic/tclHistory.c.
| ︙ | ︙ | |||
141 142 143 144 145 146 147 |
/*
* Do not call [history] if it has been replaced by an empty proc
*/
result = Tcl_GetCommandInfo(interp, "::history", &info);
if (result && (info.deleteProc == TclProcDeleteProc)) {
| | | 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 |
/*
* Do not call [history] if it has been replaced by an empty proc
*/
result = Tcl_GetCommandInfo(interp, "::history", &info);
if (result && (info.deleteProc == TclProcDeleteProc)) {
Proc *procPtr = (Proc *) info.objClientData2;
call = (procPtr->cmdPtr->compileProc != TclCompileNoOp);
}
if (call) {
Tcl_Obj *list[3];
/*
|
| ︙ | ︙ |
Changes to generic/tclIO.c.
| ︙ | ︙ | |||
1651 1652 1653 1654 1655 1656 1657 |
/*
* Set all the bits that are part of the stack-independent state
* information for the channel.
*/
if (chanName != NULL) {
| | | 1651 1652 1653 1654 1655 1656 1657 1658 1659 1660 1661 1662 1663 1664 1665 |
/*
* Set all the bits that are part of the stack-independent state
* information for the channel.
*/
if (chanName != NULL) {
size_t len = strlen(chanName) + 1;
/*
* Make sure we allocate at least 7 bytes, so it fits for "stdout"
* later.
*/
tmp = (char *)Tcl_Alloc((len < 7) ? 7 : len);
|
| ︙ | ︙ | |||
2809 2810 2811 2812 2813 2814 2815 | bufPtr = statePtr->outQueueHead; /* * Produce the output on the channel. */ PreserveChannelBuffer(bufPtr); | | | 2809 2810 2811 2812 2813 2814 2815 2816 2817 2818 2819 2820 2821 2822 2823 | bufPtr = statePtr->outQueueHead; /* * Produce the output on the channel. */ PreserveChannelBuffer(bufPtr); written = (int)ChanWrite(chanPtr, RemovePoint(bufPtr), BytesLeft(bufPtr), &errorCode); /* * If the write failed completely attempt to start the asynchronous * flush mechanism and break out of this loop - do not attempt to * write any more output at this time. */ |
| ︙ | ︙ | |||
9237 9238 9239 9240 9241 9242 9243 |
*/
int
Tcl_FileEventObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Interpreter in which the channel for which
* to create the handler is found. */
| | | 9237 9238 9239 9240 9241 9242 9243 9244 9245 9246 9247 9248 9249 9250 9251 |
*/
int
Tcl_FileEventObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Interpreter in which the channel for which
* to create the handler is found. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Channel *chanPtr; /* The channel to create the handler for. */
ChannelState *statePtr; /* State info for channel */
Tcl_Channel chan; /* The opaque type for the channel. */
const char *chanName;
int modeIndex; /* Index of mode argument. */
|
| ︙ | ︙ |
Changes to generic/tclIOCmd.c.
| ︙ | ︙ | |||
43 44 45 46 47 48 49 | /* * Static functions for this file: */ static Tcl_ExitProc FinalizeIOCmdTSD; static Tcl_TcpAcceptProc AcceptCallbackProc; | | | | | | 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 | /* * Static functions for this file: */ static Tcl_ExitProc FinalizeIOCmdTSD; static Tcl_TcpAcceptProc AcceptCallbackProc; static Tcl_ObjCmdProc2 ChanIsBinaryCmd; static Tcl_ObjCmdProc2 ChanPendingObjCmd; static Tcl_ObjCmdProc2 ChanPipeObjCmd; static Tcl_ObjCmdProc2 ChanTruncateObjCmd; static void RegisterTcpServerInterpCleanup( Tcl_Interp *interp, AcceptCallback *acceptCallbackPtr); static Tcl_InterpDeleteProc TcpAcceptCallbacksDeleteProc; static void TcpServerCloseProc(void *callbackData); static void UnregisterTcpServerInterpCleanupProc( Tcl_Interp *interp, |
| ︙ | ︙ | |||
134 135 136 137 138 139 140 |
*----------------------------------------------------------------------
*/
int
Tcl_PutsObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 |
*----------------------------------------------------------------------
*/
int
Tcl_PutsObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_Channel chan; /* The channel to puts on. */
Tcl_Obj *string; /* String to write. */
Tcl_Obj *chanObjPtr = NULL; /* channel object. */
int newline; /* Add a newline at end? */
Tcl_Size result; /* Result of puts operation. */
|
| ︙ | ︙ | |||
247 248 249 250 251 252 253 |
*----------------------------------------------------------------------
*/
int
Tcl_FlushObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 |
*----------------------------------------------------------------------
*/
int
Tcl_FlushObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_Obj *chanObjPtr;
Tcl_Channel chan; /* The channel to flush on. */
int mode;
if (objc != 2) {
|
| ︙ | ︙ | |||
311 312 313 314 315 316 317 |
*----------------------------------------------------------------------
*/
int
Tcl_GetsObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 |
*----------------------------------------------------------------------
*/
int
Tcl_GetsObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_Channel chan; /* The channel to read from. */
Tcl_Size lineLen; /* Length of line just read. */
int mode; /* Mode in which channel is opened. */
Tcl_Obj *linePtr, *chanObjPtr;
int code = TCL_OK;
|
| ︙ | ︙ | |||
397 398 399 400 401 402 403 |
*----------------------------------------------------------------------
*/
int
Tcl_ReadObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | > | 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 |
*----------------------------------------------------------------------
*/
int
Tcl_ReadObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_Channel chan; /* The channel to read from. */
int newline; /* Discard newline at end? */
Tcl_WideInt toRead; /* How many bytes to read? */
Tcl_Size charactersRead; /* How many characters were read? */
int mode; /* Mode in which channel is opened. */
Tcl_Size i;
Tcl_Obj *resultPtr, *chanObjPtr;
if ((objc != 2) && (objc != 3)) {
Interp *iPtr;
argerror:
iPtr = (Interp *) interp;
|
| ︙ | ︙ | |||
534 535 536 537 538 539 540 |
*----------------------------------------------------------------------
*/
int
Tcl_SeekObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 |
*----------------------------------------------------------------------
*/
int
Tcl_SeekObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_Channel chan; /* The channel to tell on. */
Tcl_WideInt offset; /* Where to seek? */
int mode; /* How to seek? */
Tcl_WideInt result; /* Of calling Tcl_Seek. */
int optionIndex;
|
| ︙ | ︙ | |||
609 610 611 612 613 614 615 |
*----------------------------------------------------------------------
*/
int
Tcl_TellObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 |
*----------------------------------------------------------------------
*/
int
Tcl_TellObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_Channel chan; /* The channel to tell on. */
Tcl_WideInt newLoc;
int code;
if (objc != 2) {
|
| ︙ | ︙ | |||
670 671 672 673 674 675 676 |
*----------------------------------------------------------------------
*/
int
Tcl_CloseObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 671 672 673 674 675 676 677 678 679 680 681 682 683 684 685 |
*----------------------------------------------------------------------
*/
int
Tcl_CloseObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_Channel chan; /* The channel to close. */
static const char *const dirOptions[] = {
"read", "write", NULL
};
static const int dirArray[] = {TCL_CLOSE_READ, TCL_CLOSE_WRITE};
|
| ︙ | ︙ | |||
778 779 780 781 782 783 784 |
*----------------------------------------------------------------------
*/
int
Tcl_FconfigureObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | | 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 |
*----------------------------------------------------------------------
*/
int
Tcl_FconfigureObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
const char *optionName, *valueName;
Tcl_Channel chan; /* The channel to set a mode on. */
Tcl_Size i; /* Iterate over arg-value pairs. */
if ((objc < 2) || (((objc % 2) == 1) && (objc != 3))) {
Tcl_WrongNumArgs(interp, 1, objv, "channel ?-option value ...?");
return TCL_ERROR;
}
if (TclGetChannelFromObj(interp, objv[1], &chan, NULL, 0) != TCL_OK) {
|
| ︙ | ︙ | |||
853 854 855 856 857 858 859 |
*---------------------------------------------------------------------------
*/
int
Tcl_EofObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 854 855 856 857 858 859 860 861 862 863 864 865 866 867 868 |
*---------------------------------------------------------------------------
*/
int
Tcl_EofObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_Channel chan;
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "channel");
return TCL_ERROR;
|
| ︙ | ︙ | |||
893 894 895 896 897 898 899 |
*---------------------------------------------------------------------------
*/
static int
ChanIsBinaryCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 894 895 896 897 898 899 900 901 902 903 904 905 906 907 908 |
*---------------------------------------------------------------------------
*/
static int
ChanIsBinaryCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_Channel chan;
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "channel");
return TCL_ERROR;
|
| ︙ | ︙ | |||
932 933 934 935 936 937 938 |
*----------------------------------------------------------------------
*/
int
Tcl_ExecObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | | | 933 934 935 936 937 938 939 940 941 942 943 944 945 946 947 948 949 950 951 952 953 954 955 956 |
*----------------------------------------------------------------------
*/
int
Tcl_ExecObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_Obj *resultPtr;
const char **argv; /* An array for the string arguments. Stored
* on the _Tcl_ stack. */
const char *string;
Tcl_Channel chan;
int background, i, index, keepNewline, result, ignoreStderr;
Tcl_Size argc, length, skip;
static const char *const options[] = {
"-ignorestderr", "-keepnewline", "-encoding", "--", NULL
};
enum execOptionsEnum {
EXEC_IGNORESTDERR, EXEC_KEEPNEWLINE, EXEC_ENCODING, EXEC_LAST
};
Tcl_Obj *encodingObj = NULL;
|
| ︙ | ︙ | |||
1136 1137 1138 1139 1140 1141 1142 |
*---------------------------------------------------------------------------
*/
int
Tcl_FblockedObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 1137 1138 1139 1140 1141 1142 1143 1144 1145 1146 1147 1148 1149 1150 1151 |
*---------------------------------------------------------------------------
*/
int
Tcl_FblockedObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_Channel chan;
int mode;
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "channel");
|
| ︙ | ︙ | |||
1182 1183 1184 1185 1186 1187 1188 |
*----------------------------------------------------------------------
*/
int
Tcl_OpenObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 1183 1184 1185 1186 1187 1188 1189 1190 1191 1192 1193 1194 1195 1196 1197 |
*----------------------------------------------------------------------
*/
int
Tcl_OpenObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
int pipeline, prot;
const char *modeString, *what;
Tcl_Channel chan;
if ((objc < 2) || (objc > 4)) {
|
| ︙ | ︙ | |||
1558 1559 1560 1561 1562 1563 1564 |
*----------------------------------------------------------------------
*/
int
Tcl_SocketObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | | | 1559 1560 1561 1562 1563 1564 1565 1566 1567 1568 1569 1570 1571 1572 1573 1574 1575 1576 1577 1578 1579 1580 1581 1582 1583 1584 1585 |
*----------------------------------------------------------------------
*/
int
Tcl_SocketObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
static const char *const socketOptions[] = {
"-async", "-backlog", "-myaddr", "-myport", "-reuseaddr",
"-reuseport", "-server", NULL
};
enum socketOptionsEnum {
SKT_ASYNC, SKT_BACKLOG, SKT_MYADDR, SKT_MYPORT, SKT_REUSEADDR,
SKT_REUSEPORT, SKT_SERVER
} optionIndex;
int server = 0, myport = 0, async = 0, reusep = -1, reusea = -1, backlog = -1;
Tcl_Size a;
unsigned int flags = 0;
const char *host, *port, *myaddr = NULL;
Tcl_Obj *script = NULL;
Tcl_Channel chan;
TclInitSockets();
|
| ︙ | ︙ | |||
1809 1810 1811 1812 1813 1814 1815 |
*----------------------------------------------------------------------
*/
int
Tcl_FcopyObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | > | 1810 1811 1812 1813 1814 1815 1816 1817 1818 1819 1820 1821 1822 1823 1824 1825 1826 1827 1828 1829 |
*----------------------------------------------------------------------
*/
int
Tcl_FcopyObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_Channel inChan, outChan;
int mode, index;
Tcl_Size i;
Tcl_WideInt toRead;
Tcl_Obj *cmdPtr;
static const char *const switches[] = { "-size", "-command", NULL };
enum { FcopySize, FcopyCommand };
if ((objc < 3) || (objc > 7) || (objc == 4) || (objc == 6)) {
Tcl_WrongNumArgs(interp, 1, objv,
|
| ︙ | ︙ | |||
1906 1907 1908 1909 1910 1911 1912 |
*---------------------------------------------------------------------------
*/
static int
ChanPendingObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 1908 1909 1910 1911 1912 1913 1914 1915 1916 1917 1918 1919 1920 1921 1922 |
*---------------------------------------------------------------------------
*/
static int
ChanPendingObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_Channel chan;
static const char *const options[] = {"input", "output", NULL};
enum pendingOptionsEnum {PENDING_INPUT, PENDING_OUTPUT} index;
int mode;
|
| ︙ | ︙ | |||
1970 1971 1972 1973 1974 1975 1976 |
*----------------------------------------------------------------------
*/
static int
ChanTruncateObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 1982 1983 1984 1985 1986 |
*----------------------------------------------------------------------
*/
static int
ChanTruncateObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_Channel chan;
Tcl_WideInt length;
if ((objc < 2) || (objc > 3)) {
Tcl_WrongNumArgs(interp, 1, objv, "channel ?length?");
|
| ︙ | ︙ | |||
2043 2044 2045 2046 2047 2048 2049 |
*----------------------------------------------------------------------
*/
static int
ChanPipeObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 2045 2046 2047 2048 2049 2050 2051 2052 2053 2054 2055 2056 2057 2058 2059 |
*----------------------------------------------------------------------
*/
static int
ChanPipeObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_Channel rchan, wchan;
const char *channelNames[2];
Tcl_Obj *resultPtr;
if (objc != 1) {
|
| ︙ | ︙ | |||
2094 2095 2096 2097 2098 2099 2100 |
*----------------------------------------------------------------------
*/
int
TclChannelNamesCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | 2096 2097 2098 2099 2100 2101 2102 2103 2104 2105 2106 2107 2108 2109 2110 |
*----------------------------------------------------------------------
*/
int
TclChannelNamesCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const objv[])
{
if (objc < 1 || objc > 2) {
Tcl_WrongNumArgs(interp, 1, objv, "?pattern?");
return TCL_ERROR;
}
return Tcl_GetChannelNamesEx(interp,
|
| ︙ | ︙ |
Changes to generic/tclIORChan.c.
| ︙ | ︙ | |||
497 498 499 500 501 502 503 |
*----------------------------------------------------------------------
*/
int
TclChanCreateObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 |
*----------------------------------------------------------------------
*/
int
TclChanCreateObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const *objv)
{
ReflectedChannel *rcPtr; /* Instance data of the new channel */
Tcl_Obj *rcId; /* Handle of the new channel */
int mode; /* R/W mode of new channel. Has to match
* abilities of handler commands */
Tcl_Obj *cmdObj; /* Command prefix, list of words */
|
| ︙ | ︙ | |||
817 818 819 820 821 822 823 |
}
#endif
int
TclChanPostEventObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 |
}
#endif
int
TclChanPostEventObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const *objv)
{
/*
* Ensure -> HANDLER thread
*
* Syntax: chan postevent CHANNEL EVENTSPEC
* [0] [1] [2] [3]
|
| ︙ | ︙ | |||
1317 1318 1319 1320 1321 1322 1323 |
*errorCodePtr = EINVAL;
}
p.input.toRead = TCL_INDEX_NONE;
} else {
*errorCodePtr = EOK;
}
| | | 1317 1318 1319 1320 1321 1322 1323 1324 1325 1326 1327 1328 1329 1330 1331 |
*errorCodePtr = EINVAL;
}
p.input.toRead = TCL_INDEX_NONE;
} else {
*errorCodePtr = EOK;
}
return (int)p.input.toRead;
}
#endif
/* ASSERT: rcPtr->method & FLAG(METH_READ) */
/* ASSERT: rcPtr->mode & TCL_READABLE */
Tcl_Preserve(rcPtr);
|
| ︙ | ︙ | |||
1361 1362 1363 1364 1365 1366 1367 |
memcpy(buf, bytev, bytec);
}
stop:
Tcl_DecrRefCount(toReadObj);
Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */
Tcl_Release(rcPtr);
| | | 1361 1362 1363 1364 1365 1366 1367 1368 1369 1370 1371 1372 1373 1374 1375 |
memcpy(buf, bytev, bytec);
}
stop:
Tcl_DecrRefCount(toReadObj);
Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */
Tcl_Release(rcPtr);
return (int)bytec;
invalid:
*errorCodePtr = EINVAL;
error:
bytec = -1;
goto stop;
}
|
| ︙ | ︙ | |||
1426 1427 1428 1429 1430 1431 1432 |
*errorCodePtr = EINVAL;
}
p.output.toWrite = -1;
} else {
*errorCodePtr = EOK;
}
| | | 1426 1427 1428 1429 1430 1431 1432 1433 1434 1435 1436 1437 1438 1439 1440 |
*errorCodePtr = EINVAL;
}
p.output.toWrite = -1;
} else {
*errorCodePtr = EOK;
}
return (int)p.output.toWrite;
}
#endif
/* ASSERT: rcPtr->method & FLAG(METH_WRITE) */
/* ASSERT: rcPtr->mode & TCL_WRITABLE */
Tcl_Preserve(rcPtr);
|
| ︙ | ︙ |
Changes to generic/tclIORTrans.c.
| ︙ | ︙ | |||
132 133 134 135 136 137 138 |
* argv [0] ... [.] | [argc-2] [argc-1] | [argc] [argc+2]
* cmd ... pfx | method chan | detail1 detail2
* ~~~~ CT ~~~ ~~ CT ~~
*
* CT = Belongs to the 'Command handler Thread'.
*/
| | | 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 |
* argv [0] ... [.] | [argc-2] [argc-1] | [argc] [argc+2]
* cmd ... pfx | method chan | detail1 detail2
* ~~~~ CT ~~~ ~~ CT ~~
*
* CT = Belongs to the 'Command handler Thread'.
*/
Tcl_Size argc; /* Number of preallocated words - 2. */
Tcl_Obj **argv; /* Preallocated array for calling the handler.
* args[0] is placeholder for cmd word.
* Followed by the arguments in the prefix,
* plus 4 placeholders for method, channel,
* and at most two varying (method specific)
* words. */
int methods; /* Bitmask of supported methods. */
|
| ︙ | ︙ | |||
492 493 494 495 496 497 498 |
*----------------------------------------------------------------------
*/
int
TclChanPushObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 |
*----------------------------------------------------------------------
*/
int
TclChanPushObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const *objv)
{
ReflectedTransform *rtPtr; /* Instance data of the new (transform)
* channel. */
Tcl_Obj *chanObj; /* Handle of parent channel */
Tcl_Channel parentChan; /* Token of parent channel */
int mode; /* R/W mode of parent, later the new channel.
|
| ︙ | ︙ | |||
735 736 737 738 739 740 741 |
*----------------------------------------------------------------------
*/
int
TclChanPopObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 |
*----------------------------------------------------------------------
*/
int
TclChanPopObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const *objv)
{
/*
* Syntax: chan pop CHANNEL
* [0] [1] [2]
*
* Actually: rPop CHANNEL
|
| ︙ | ︙ | |||
1084 1085 1086 1087 1088 1089 1090 |
rtPtr->readIsDrained = 0;
while (toRead > 0) {
/*
* Loop until the request is satisfied (or no data available from
* below, possibly EOF).
*/
| | | 1084 1085 1086 1087 1088 1089 1090 1091 1092 1093 1094 1095 1096 1097 1098 |
rtPtr->readIsDrained = 0;
while (toRead > 0) {
/*
* Loop until the request is satisfied (or no data available from
* below, possibly EOF).
*/
copied = (int)ResultCopy(&rtPtr->result, UCHARP(buf), toRead);
toRead -= copied;
buf += copied;
gotBytes += copied;
if (toRead == 0) {
goto stop;
}
|
| ︙ | ︙ | |||
1132 1133 1134 1135 1136 1137 1138 |
} /* else: 'maxRead < 0' == Accept the current value of toRead */
}
if (toRead <= 0) {
goto stop;
}
| | | 1132 1133 1134 1135 1136 1137 1138 1139 1140 1141 1142 1143 1144 1145 1146 |
} /* else: 'maxRead < 0' == Accept the current value of toRead */
}
if (toRead <= 0) {
goto stop;
}
readBytes = (int)Tcl_ReadRaw(rtPtr->parent,
(char *) Tcl_SetByteArrayLength(bufObj, toRead), toRead);
if (readBytes < 0) {
if (Tcl_InputBlocked(rtPtr->parent) && (gotBytes > 0)) {
/*
* Down channel is blocked and offers zero additional bytes.
* The nonzero gotBytes already returned makes the total
|
| ︙ | ︙ | |||
1835 1836 1837 1838 1839 1840 1841 |
return resObj;
}
static void
FreeReflectedTransformArgs(
ReflectedTransform *rtPtr)
{
| | | 1835 1836 1837 1838 1839 1840 1841 1842 1843 1844 1845 1846 1847 1848 1849 |
return resObj;
}
static void
FreeReflectedTransformArgs(
ReflectedTransform *rtPtr)
{
Tcl_Size i, n = rtPtr->argc - 2;
if (n < 0) {
return;
}
Tcl_DecrRefCount(rtPtr->handle);
rtPtr->handle = NULL;
|
| ︙ | ︙ | |||
1906 1907 1908 1909 1910 1911 1912 |
InvokeTclMethod(
ReflectedTransform *rtPtr,
const char *method,
Tcl_Obj *argOneObj, /* NULL'able */
Tcl_Obj *argTwoObj, /* NULL'able */
Tcl_Obj **resultObjPtr) /* NULL'able */
{
| | | 1906 1907 1908 1909 1910 1911 1912 1913 1914 1915 1916 1917 1918 1919 1920 |
InvokeTclMethod(
ReflectedTransform *rtPtr,
const char *method,
Tcl_Obj *argOneObj, /* NULL'able */
Tcl_Obj *argTwoObj, /* NULL'able */
Tcl_Obj **resultObjPtr) /* NULL'able */
{
Tcl_Size cmdc; /* #words in constructed command */
Tcl_Obj *methObj = NULL; /* Method name in object form */
Tcl_InterpState sr; /* State of handler interp */
int result; /* Result code of method invocation */
Tcl_Obj *resObj = NULL; /* Result of method invocation. */
if (rtPtr->dead) {
/*
|
| ︙ | ︙ | |||
3001 3002 3003 3004 3005 3006 3007 |
} else if (rPtr->used == (size_t)toRead) {
/*
* We have just enough. Copy everything to the caller.
*/
memcpy(buf, rPtr->buf, toRead);
rPtr->used = 0;
| | | | | 3001 3002 3003 3004 3005 3006 3007 3008 3009 3010 3011 3012 3013 3014 3015 3016 3017 3018 3019 3020 3021 3022 3023 3024 3025 3026 3027 3028 3029 3030 3031 3032 3033 3034 3035 3036 |
} else if (rPtr->used == (size_t)toRead) {
/*
* We have just enough. Copy everything to the caller.
*/
memcpy(buf, rPtr->buf, toRead);
rPtr->used = 0;
copied = (int)toRead;
} else if (rPtr->used > (size_t)toRead) {
/*
* The internal buffer contains more than requested. Copy the
* requested subset to the caller, and shift the remaining bytes down.
*/
memcpy(buf, rPtr->buf, toRead);
memmove(rPtr->buf, rPtr->buf + toRead, rPtr->used - toRead);
rPtr->used -= toRead;
copied = (int)toRead;
} else {
/*
* There is not enough in the buffer to satisfy the caller, so take
* everything.
*/
memcpy(buf, rPtr->buf, rPtr->used);
toRead = rPtr->used;
rPtr->used = 0;
copied = (int)toRead;
}
/* -- common postwork code ------- */
return copied;
}
|
| ︙ | ︙ | |||
3094 3095 3096 3097 3098 3099 3100 |
unsigned char *buf,
int toWrite)
{
Tcl_Obj *bufObj;
Tcl_Obj *resObj;
Tcl_Size bytec = 0; /* Number of returned bytes */
unsigned char *bytev; /* Array of returned bytes */
| | | | 3094 3095 3096 3097 3098 3099 3100 3101 3102 3103 3104 3105 3106 3107 3108 3109 3110 3111 3112 3113 3114 3115 3116 3117 3118 |
unsigned char *buf,
int toWrite)
{
Tcl_Obj *bufObj;
Tcl_Obj *resObj;
Tcl_Size bytec = 0; /* Number of returned bytes */
unsigned char *bytev; /* Array of returned bytes */
Tcl_Size res;
/*
* Are we in the correct thread?
*/
#if TCL_THREADS
if (rtPtr->thread != Tcl_GetCurrentThread()) {
ForwardParam p;
p.transform.buf = (char *)buf;
p.transform.size = toWrite;
ForwardOpToOwnerThread(rtPtr, ForwardedOutput, &p);
if (p.base.code != TCL_OK) {
PassReceivedError(rtPtr->chan, &p);
*errorCodePtr = EINVAL;
|
| ︙ | ︙ | |||
3210 3211 3212 3213 3214 3215 3216 |
ReflectedTransform *rtPtr,
int *errorCodePtr,
int op)
{
Tcl_Obj *resObj;
Tcl_Size bytec = 0; /* Number of returned bytes */
unsigned char *bytev; /* Array of returned bytes */
| | | 3210 3211 3212 3213 3214 3215 3216 3217 3218 3219 3220 3221 3222 3223 3224 |
ReflectedTransform *rtPtr,
int *errorCodePtr,
int op)
{
Tcl_Obj *resObj;
Tcl_Size bytec = 0; /* Number of returned bytes */
unsigned char *bytev; /* Array of returned bytes */
Tcl_Size res;
/*
* Are we in the correct thread?
*/
#if TCL_THREADS
if (rtPtr->thread != Tcl_GetCurrentThread()) {
|
| ︙ | ︙ |
Changes to generic/tclIOSock.c.
| ︙ | ︙ | |||
125 126 127 128 129 130 131 |
int
TclSockMinimumBuffers(
void *sock, /* Socket file descriptor */
Tcl_Size size1) /* Minimum buffer size */
{
int current;
socklen_t len;
| | | 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 |
int
TclSockMinimumBuffers(
void *sock, /* Socket file descriptor */
Tcl_Size size1) /* Minimum buffer size */
{
int current;
socklen_t len;
int size = (int)size1;
if (size != size1) {
return TCL_ERROR;
}
len = sizeof(int);
getsockopt((SOCKET)(size_t)sock, SOL_SOCKET, SO_SNDBUF,
(char *) ¤t, &len);
|
| ︙ | ︙ |
Changes to generic/tclIOUtil.c.
| ︙ | ︙ | |||
1312 1313 1314 1315 1316 1317 1318 | * components into the pathname, this function does not return the correct * result. This may be possible with symbolic links on unix. * * *--------------------------------------------------------------------------- */ | | | | 1312 1313 1314 1315 1316 1317 1318 1319 1320 1321 1322 1323 1324 1325 1326 1327 1328 1329 1330 1331 |
* components into the pathname, this function does not return the correct
* result. This may be possible with symbolic links on unix.
*
*
*---------------------------------------------------------------------------
*/
Tcl_Size
TclFSNormalizeToUniquePath(
Tcl_Interp *interp, /* Used for error messages. */
Tcl_Obj *pathPtr, /* An Pathname to normalize in-place. Must be
* unshared. */
Tcl_Size startAt) /* Offset the string of pathPtr to start at.
* Must either be 0 or offset of a directory
* separator at the end of a pathname part that
* is already normalized, i.e. not the index of
* the byte just after the separator. */
{
FilesystemRecord *fsRecPtr, *firstFsRecPtr;
|
| ︙ | ︙ | |||
1380 1381 1382 1383 1384 1385 1386 | } /* * TODO: Always call the normalizePathProc here because it should * always exist. */ | | | | | | 1380 1381 1382 1383 1384 1385 1386 1387 1388 1389 1390 1391 1392 1393 1394 1395 1396 1397 1398 1399 1400 1401 1402 1403 1404 1405 1406 1407 1408 1409 1410 1411 1412 |
}
/*
* TODO: Always call the normalizePathProc here because it should
* always exist.
*/
if (fsRecPtr->fsPtr->normalizePathProc != NULL && startAt < INT_MAX) {
startAt = fsRecPtr->fsPtr->normalizePathProc(interp, pathPtr,
(int)startAt);
}
break;
}
}
for (fsRecPtr=firstFsRecPtr; fsRecPtr!=NULL; fsRecPtr=fsRecPtr->nextPtr) {
if (fsRecPtr->fsPtr == &tclNativeFilesystem) {
/*
* Skip the native system this time through.
*/
continue;
}
if (fsRecPtr->fsPtr->normalizePathProc != NULL && startAt < INT_MAX) {
startAt = fsRecPtr->fsPtr->normalizePathProc(interp, pathPtr,
(int)startAt);
}
/*
* This efficiency check could be added:
* if (retVal == length-of(pathPtr)) {break;}
* but there's not much benefit.
*/
|
| ︙ | ︙ | |||
2444 2445 2446 2447 2448 2449 2450 |
*----------------------------------------------------------------------
*/
int
TclFSFileAttrIndex(
Tcl_Obj *pathPtr, /* Pathname of the file. */
const char *attributeName, /* The name of the attribute. */
| | | 2444 2445 2446 2447 2448 2449 2450 2451 2452 2453 2454 2455 2456 2457 2458 |
*----------------------------------------------------------------------
*/
int
TclFSFileAttrIndex(
Tcl_Obj *pathPtr, /* Pathname of the file. */
const char *attributeName, /* The name of the attribute. */
int *indexPtr) /* A place to store the result. */
{
Tcl_Obj *listObj = NULL;
const char *const *attrTable;
/*
* Get the attribute table for the file.
*/
|
| ︙ | ︙ | |||
2488 2489 2490 2491 2492 2493 2494 |
if (TclListObjGetElements(NULL, listObj, &objc, &objv) != TCL_OK) {
TclDecrRefCount(listObj);
return TCL_ERROR;
}
for (i=0 ; i<objc ; i++) {
if (!strcmp(attributeName, TclGetString(objv[i]))) {
TclDecrRefCount(listObj);
| | | 2488 2489 2490 2491 2492 2493 2494 2495 2496 2497 2498 2499 2500 2501 2502 |
if (TclListObjGetElements(NULL, listObj, &objc, &objv) != TCL_OK) {
TclDecrRefCount(listObj);
return TCL_ERROR;
}
for (i=0 ; i<objc ; i++) {
if (!strcmp(attributeName, TclGetString(objv[i]))) {
TclDecrRefCount(listObj);
*indexPtr = (int)i;
return TCL_OK;
}
}
TclDecrRefCount(listObj);
return TCL_ERROR;
} else {
return TCL_ERROR;
|
| ︙ | ︙ | |||
3313 3314 3315 3316 3317 3318 3319 |
/*
* It might be necessary on some systems to set the appropriate permissions
* on the file. On Unix we could loop over the file attributes and set any
* that are called "-permissions" to 0o700, but just do it directly instead:
*/
{
| | | 3313 3314 3315 3316 3317 3318 3319 3320 3321 3322 3323 3324 3325 3326 3327 |
/*
* It might be necessary on some systems to set the appropriate permissions
* on the file. On Unix we could loop over the file attributes and set any
* that are called "-permissions" to 0o700, but just do it directly instead:
*/
{
int index;
Tcl_Obj *perm;
TclNewLiteralStringObj(perm, "0o700");
Tcl_IncrRefCount(perm);
if (TclFSFileAttrIndex(copyToPtr, "-permissions", &index) == TCL_OK) {
Tcl_FSFileAttrsSet(NULL, index, copyToPtr, perm);
}
|
| ︙ | ︙ |
Changes to generic/tclIcu.c.
| ︙ | ︙ | |||
552 553 554 555 556 557 558 |
*
*------------------------------------------------------------------------
*/
static int
IcuDetectObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 |
*
*------------------------------------------------------------------------
*/
static int
IcuDetectObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const objv[])
{
if (objc > 3) {
Tcl_WrongNumArgs(interp, 1 , objv, "?bytes ?-all??");
return TCL_ERROR;
}
|
| ︙ | ︙ | |||
598 599 600 601 602 603 604 |
*
*------------------------------------------------------------------------
*/
static int
IcuConverterNamesObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 |
*
*------------------------------------------------------------------------
*/
static int
IcuConverterNamesObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
if (objc != 1) {
Tcl_WrongNumArgs(interp, 1 , objv, "");
return TCL_ERROR;
}
|
| ︙ | ︙ | |||
648 649 650 651 652 653 654 |
*
*------------------------------------------------------------------------
*/
static int
IcuConverterAliasesObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 |
*
*------------------------------------------------------------------------
*/
static int
IcuConverterAliasesObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1 , objv, "convertername");
return TCL_ERROR;
}
if (ucnv_countAliases == NULL || ucnv_getAlias == NULL) {
|
| ︙ | ︙ | |||
950 951 952 953 954 955 956 |
/*
* Common function for parsing convert options.
*/
static int
IcuParseConvertOptions(
Tcl_Interp *interp,
| | | 950 951 952 953 954 955 956 957 958 959 960 961 962 963 964 |
/*
* Common function for parsing convert options.
*/
static int
IcuParseConvertOptions(
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const objv[],
int *strictPtr,
Tcl_Obj **failindexVarPtr)
{
if (objc < 3) {
Tcl_WrongNumArgs(interp, 1, objv, "?-profile PROFILE? ICUENCNAME STRING");
return TCL_ERROR;
|
| ︙ | ︙ | |||
1027 1028 1029 1030 1031 1032 1033 |
*
*------------------------------------------------------------------------
*/
static int
IcuConvertfromObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 1027 1028 1029 1030 1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 |
*
*------------------------------------------------------------------------
*/
static int
IcuConvertfromObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
int strict;
Tcl_Obj *failindexVar;
if (IcuParseConvertOptions(interp, objc, objv, &strict, &failindexVar) != TCL_OK) {
return TCL_ERROR;
|
| ︙ | ︙ | |||
1078 1079 1080 1081 1082 1083 1084 |
*
*------------------------------------------------------------------------
*/
static int
IcuConverttoObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 1078 1079 1080 1081 1082 1083 1084 1085 1086 1087 1088 1089 1090 1091 1092 |
*
*------------------------------------------------------------------------
*/
static int
IcuConverttoObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
int strict;
Tcl_Obj *failindexVar;
if (IcuParseConvertOptions(interp, objc, objv, &strict, &failindexVar) != TCL_OK) {
return TCL_ERROR;
|
| ︙ | ︙ | |||
1123 1124 1125 1126 1127 1128 1129 |
*
*------------------------------------------------------------------------
*/
static int
IcuNormalizeObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 1123 1124 1125 1126 1127 1128 1129 1130 1131 1132 1133 1134 1135 1136 1137 |
*
*------------------------------------------------------------------------
*/
static int
IcuNormalizeObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
static const char *optNames[] = {"-profile", "-mode", NULL};
enum { OPT_PROFILE, OPT_MODE } opt;
if (objc < 2) {
Tcl_WrongNumArgs(interp, 1, objv, "?-profile PROFILE? ?-mode MODE? STRING");
|
| ︙ | ︙ | |||
1478 1479 1480 1481 1482 1483 1484 |
* against self redefinition.
*/
if (icu_fns.libs[1] != NULL) {
/* Commands needing both libraries */
/* Ref count number of commands */
icu_fns.nopen += 3;
| | | | | | | | 1478 1479 1480 1481 1482 1483 1484 1485 1486 1487 1488 1489 1490 1491 1492 1493 1494 1495 1496 1497 1498 1499 1500 1501 1502 1503 1504 1505 1506 1507 1508 |
* against self redefinition.
*/
if (icu_fns.libs[1] != NULL) {
/* Commands needing both libraries */
/* Ref count number of commands */
icu_fns.nopen += 3;
Tcl_CreateObjCommand2(interp, "::tcl::unsupported::icu::convertto",
IcuConverttoObjCmd, 0, TclIcuCleanup);
Tcl_CreateObjCommand2(interp, "::tcl::unsupported::icu::convertfrom",
IcuConvertfromObjCmd, 0, TclIcuCleanup);
Tcl_CreateObjCommand2(interp, "::tcl::unsupported::icu::detect",
IcuDetectObjCmd, 0, TclIcuCleanup);
}
/* Commands needing only libs[0] (icuuc) */
/* Ref count number of commands */
icu_fns.nopen += 3; /* UPDATE AS CMDS ADDED/DELETED BELOW */
Tcl_CreateObjCommand2(interp, "::tcl::unsupported::icu::converters",
IcuConverterNamesObjCmd, 0, TclIcuCleanup);
Tcl_CreateObjCommand2(interp, "::tcl::unsupported::icu::aliases",
IcuConverterAliasesObjCmd, 0, TclIcuCleanup);
Tcl_CreateObjCommand2(interp, "::tcl::unsupported::icu::normalize",
IcuNormalizeObjCmd, 0, TclIcuCleanup);
}
Tcl_MutexUnlock(&icu_mutex);
}
/*
|
| ︙ | ︙ | |||
1521 1522 1523 1524 1525 1526 1527 |
*
*------------------------------------------------------------------------
*/
int
TclLoadIcuObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 1521 1522 1523 1524 1525 1526 1527 1528 1529 1530 1531 1532 1533 1534 1535 |
*
*------------------------------------------------------------------------
*/
int
TclLoadIcuObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
if (objc != 1) {
Tcl_WrongNumArgs(interp, 1 , objv, "");
return TCL_ERROR;
}
TclIcuInit(interp);
|
| ︙ | ︙ |
Changes to generic/tclIndexObj.c.
| ︙ | ︙ | |||
21 22 23 24 25 26 27 | static int GetIndexFromObjList(Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Obj *tableObjPtr, const char *msg, int flags, Tcl_Size *indexPtr); static void UpdateStringOfIndex(Tcl_Obj *objPtr); static void DupIndex(Tcl_Obj *srcPtr, Tcl_Obj *dupPtr); static void FreeIndex(Tcl_Obj *objPtr); | | | | | 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 |
static int GetIndexFromObjList(Tcl_Interp *interp,
Tcl_Obj *objPtr, Tcl_Obj *tableObjPtr,
const char *msg, int flags, Tcl_Size *indexPtr);
static void UpdateStringOfIndex(Tcl_Obj *objPtr);
static void DupIndex(Tcl_Obj *srcPtr, Tcl_Obj *dupPtr);
static void FreeIndex(Tcl_Obj *objPtr);
static Tcl_ObjCmdProc2 PrefixAllObjCmd;
static Tcl_ObjCmdProc2 PrefixLongestObjCmd;
static Tcl_ObjCmdProc2 PrefixMatchObjCmd;
static void PrintUsage(Tcl_Interp *interp,
const Tcl_ArgvInfo *argTable);
const EnsembleImplMap tclPrefixImplMap[] = {
{"all", PrefixAllObjCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0},
{"longest", PrefixLongestObjCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0},
{"match", PrefixMatchObjCmd, TclCompileBasicMin2ArgCmd, NULL, NULL, 0},
|
| ︙ | ︙ | |||
504 505 506 507 508 509 510 |
*----------------------------------------------------------------------
*/
static int
PrefixMatchObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 |
*----------------------------------------------------------------------
*/
static int
PrefixMatchObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
int flags = 0, result;
Tcl_Size errorLength, i;
Tcl_Obj *errorPtr = NULL;
const char *message = "option";
Tcl_Obj *tablePtr, *objPtr, *resultPtr;
|
| ︙ | ︙ | |||
628 629 630 631 632 633 634 |
*----------------------------------------------------------------------
*/
static int
PrefixAllObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 |
*----------------------------------------------------------------------
*/
static int
PrefixAllObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
int result;
Tcl_Size length, elemLength, tableObjc, t;
const char *string, *elemString;
Tcl_Obj **tableObjv, *resultPtr;
|
| ︙ | ︙ | |||
686 687 688 689 690 691 692 |
*----------------------------------------------------------------------
*/
static int
PrefixLongestObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 |
*----------------------------------------------------------------------
*/
static int
PrefixLongestObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
int result;
Tcl_Size i, length, elemLength, resultLength, tableObjc, t;
const char *string, *elemString, *resultString;
Tcl_Obj **tableObjv;
|
| ︙ | ︙ | |||
1173 1174 1175 1176 1177 1178 1179 |
srcIndex++;
objc--;
}
break;
}
case TCL_ARGV_GENFUNC: {
| < < < < < | 1173 1174 1175 1176 1177 1178 1179 1180 1181 1182 1183 1184 1185 1186 |
srcIndex++;
objc--;
}
break;
}
case TCL_ARGV_GENFUNC: {
Tcl_ArgvGenFuncProc *handlerProc = (Tcl_ArgvGenFuncProc *)
infoPtr->srcPtr;
gf_ret = handlerProc(infoPtr->clientData, interp, objc,
&objv[srcIndex], infoPtr->dstPtr);
if (gf_ret < 0) {
goto error;
|
| ︙ | ︙ |
Changes to generic/tclInt.decls.
| ︙ | ︙ | |||
504 505 506 507 508 509 510 |
}
declare 227 {
void TclSetNsPath(Namespace *nsPtr, Tcl_Size pathLength,
Tcl_Namespace *pathAry[])
}
declare 229 {
int TclPtrMakeUpvar(Tcl_Interp *interp, Var *otherP1Ptr,
| | | | 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 |
}
declare 227 {
void TclSetNsPath(Namespace *nsPtr, Tcl_Size pathLength,
Tcl_Namespace *pathAry[])
}
declare 229 {
int TclPtrMakeUpvar(Tcl_Interp *interp, Var *otherP1Ptr,
const char *myName, int myFlags, Tcl_Size index)
}
declare 230 {
Var *TclObjLookupVar(Tcl_Interp *interp, Tcl_Obj *part1Ptr,
const char *part2, int flags, const char *msg,
int createPart1, int createPart2, Var **arrayPtrPtr)
}
declare 231 {
int TclGetNamespaceFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
Tcl_Namespace **nsPtrPtr)
}
# Bits and pieces of TIP#280's guts
declare 232 {
int TclEvalObjEx(Tcl_Interp *interp, Tcl_Obj *objPtr, int flags,
const CmdFrame *invoker, Tcl_Size word)
}
declare 233 {
void TclGetSrcInfoForPc(CmdFrame *contextPtr)
}
# Exports for VarReform compat: Itcl, XOTcl like to peek into our varTables :(
declare 234 {
|
| ︙ | ︙ | |||
555 556 557 558 559 560 561 |
}
declare 240 {
int TclNRRunCallbacks(Tcl_Interp *interp, int result,
NRE_callback *rootPtr)
}
declare 241 {
int TclNREvalObjEx(Tcl_Interp *interp, Tcl_Obj *objPtr, int flags,
| | | 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 |
}
declare 240 {
int TclNRRunCallbacks(Tcl_Interp *interp, int result,
NRE_callback *rootPtr)
}
declare 241 {
int TclNREvalObjEx(Tcl_Interp *interp, Tcl_Obj *objPtr, int flags,
const CmdFrame *invoker, Tcl_Size word)
}
declare 242 {
int TclNREvalObjv(Tcl_Interp *interp, Tcl_Size objc,
Tcl_Obj *const objv[], int flags, Command *cmdPtr)
}
# Tcl_Obj leak detection support.
|
| ︙ | ︙ |
Changes to generic/tclInt.h.
| ︙ | ︙ | |||
1766 1767 1768 1769 1770 1771 1772 |
* Structure used in implementation of those core ensembles which are
* partially compiled. Used as an array of these, with a terminating field
* whose 'name' is NULL.
*/
typedef struct EnsembleImplMap {
const char *name; /* The name of the subcommand. */
| | | | 1766 1767 1768 1769 1770 1771 1772 1773 1774 1775 1776 1777 1778 1779 1780 1781 1782 |
* Structure used in implementation of those core ensembles which are
* partially compiled. Used as an array of these, with a terminating field
* whose 'name' is NULL.
*/
typedef struct EnsembleImplMap {
const char *name; /* The name of the subcommand. */
Tcl_ObjCmdProc2 *proc2; /* The implementation of the subcommand. */
CompileProc *compileProc; /* The compiler for the subcommand. */
Tcl_ObjCmdProc2 *nreProc2; /* NRE implementation of this command. */
void *clientData; /* Any clientData to give the command. */
int unsafe; /* Whether this command is to be hidden by
* default in a safe interpreter. */
} EnsembleImplMap;
/*
*----------------------------------------------------------------
|
| ︙ | ︙ | |||
1845 1846 1847 1848 1849 1850 1851 |
* instruction sequence. This structure can be
* freed when refCount becomes zero. */
Tcl_Size cmdEpoch; /* Incremented to invalidate any references
* that point to this command when it is
* renamed, deleted, hidden, or exposed. */
CompileProc *compileProc; /* Procedure called to compile command. NULL
* if no compile proc exists for command. */
| | | | | 1845 1846 1847 1848 1849 1850 1851 1852 1853 1854 1855 1856 1857 1858 1859 1860 1861 1862 1863 1864 1865 1866 1867 1868 1869 1870 1871 1872 1873 1874 1875 1876 1877 1878 |
* instruction sequence. This structure can be
* freed when refCount becomes zero. */
Tcl_Size cmdEpoch; /* Incremented to invalidate any references
* that point to this command when it is
* renamed, deleted, hidden, or exposed. */
CompileProc *compileProc; /* Procedure called to compile command. NULL
* if no compile proc exists for command. */
Tcl_ObjCmdProc2 *objProc2; /* Object-based command procedure. */
void *objClientData2; /* Arbitrary value passed to object proc. */
Tcl_CmdProc *proc; /* String-based command procedure. */
void *clientData; /* Arbitrary value passed to string proc. */
Tcl_CmdDeleteProc *deleteProc;
/* Procedure invoked when deleting command to,
* e.g., free all client data. */
void *deleteData; /* Arbitrary value passed to deleteProc. */
int flags; /* Miscellaneous bits of information about
* command. See below for definitions. */
ImportRef *importRefPtr; /* List of each imported Command created in
* another namespace when this command is
* imported. These imported commands redirect
* invocations back to this command. The list
* is used to remove all those imported
* commands when deleting this "real"
* command. */
CommandTrace *tracePtr; /* First in list of all traces set for this
* command. */
Tcl_ObjCmdProc2 *nreProc2; /* NRE implementation of this command. */
} Command;
/*
* Flag bits for commands.
*/
enum CommandFlags {
CMD_DYING = 0x01, /* The command is in the process of being
|
| ︙ | ︙ | |||
2016 2017 2018 2019 2020 2021 2022 |
/* Hash table used by tclBasic.c to keep track
* of hidden commands on a per-interp
* basis. */
void *interpInfo; /* Information used by tclInterp.c to keep
* track of parent/child interps on a
* per-interp basis. */
void (*optimizer)(void *envPtr);
| < < | 2016 2017 2018 2019 2020 2021 2022 2023 2024 2025 2026 2027 2028 2029 |
/* Hash table used by tclBasic.c to keep track
* of hidden commands on a per-interp
* basis. */
void *interpInfo; /* Information used by tclInterp.c to keep
* track of parent/child interps on a
* per-interp basis. */
void (*optimizer)(void *envPtr);
/*
* Information related to procedures and variables. See tclProc.c and
* tclVar.c for usage.
*/
Tcl_Size numLevels; /* Keeps track of how many nested calls to
* Tcl_Eval are in progress for this
|
| ︙ | ︙ | |||
3195 3196 3197 3198 3199 3200 3201 | /* *---------------------------------------------------------------- * Procedures shared among Tcl modules but not used by the outside world, * introduced by/for NRE. *---------------------------------------------------------------- */ | | | | | | | | | | | | | | | | | | | | | | | 3193 3194 3195 3196 3197 3198 3199 3200 3201 3202 3203 3204 3205 3206 3207 3208 3209 3210 3211 3212 3213 3214 3215 3216 3217 3218 3219 3220 3221 3222 3223 3224 3225 3226 3227 3228 3229 3230 3231 3232 | /* *---------------------------------------------------------------- * Procedures shared among Tcl modules but not used by the outside world, * introduced by/for NRE. *---------------------------------------------------------------- */ MODULE_SCOPE Tcl_ObjCmdProc2 TclNRApplyObjCmd; MODULE_SCOPE Tcl_ObjCmdProc2 TclNREvalObjCmd; MODULE_SCOPE Tcl_ObjCmdProc2 TclNRCatchObjCmd; MODULE_SCOPE Tcl_ObjCmdProc2 TclNRExprObjCmd; MODULE_SCOPE Tcl_ObjCmdProc2 TclNRForObjCmd; MODULE_SCOPE Tcl_ObjCmdProc2 TclNRForeachCmd; MODULE_SCOPE Tcl_ObjCmdProc2 TclNRIfObjCmd; MODULE_SCOPE Tcl_ObjCmdProc2 TclNRLmapCmd; MODULE_SCOPE Tcl_ObjCmdProc2 TclNRPackageObjCmd; MODULE_SCOPE Tcl_ObjCmdProc2 TclNRSourceObjCmd; MODULE_SCOPE Tcl_ObjCmdProc2 TclNRSubstObjCmd; MODULE_SCOPE Tcl_ObjCmdProc2 TclNRSwitchObjCmd; MODULE_SCOPE Tcl_ObjCmdProc2 TclNRTryObjCmd; MODULE_SCOPE Tcl_ObjCmdProc2 TclNRUplevelObjCmd; MODULE_SCOPE Tcl_NRPostProc TclUplevelCallback; MODULE_SCOPE Tcl_ObjCmdProc2 TclNRWhileObjCmd; MODULE_SCOPE Tcl_NRPostProc TclNRForIterCallback; MODULE_SCOPE Tcl_NRPostProc TclNRCoroutineActivateCallback; MODULE_SCOPE Tcl_ObjCmdProc2 TclNRTailcallObjCmd; MODULE_SCOPE Tcl_NRPostProc TclNRTailcallEval; MODULE_SCOPE Tcl_ObjCmdProc2 TclNRCoroutineObjCmd; MODULE_SCOPE Tcl_ObjCmdProc2 TclNRYieldObjCmd; MODULE_SCOPE Tcl_ObjCmdProc2 TclNRYieldmObjCmd; MODULE_SCOPE Tcl_ObjCmdProc2 TclNRYieldToObjCmd; MODULE_SCOPE Tcl_ObjCmdProc2 TclNRInvoke; MODULE_SCOPE Tcl_NRPostProc TclNRPostInvoke; MODULE_SCOPE Tcl_NRPostProc TclNRReleaseValues; MODULE_SCOPE void TclSetTailcall(Tcl_Interp *interp, Tcl_Obj *tailcallPtr); MODULE_SCOPE void TclPushTailcallPoint(Tcl_Interp *interp); |
| ︙ | ︙ | |||
3322 3323 3324 3325 3326 3327 3328 | MODULE_SCOPE void TclArgumentBCEnter(Tcl_Interp *interp, Tcl_Obj *objv[], Tcl_Size objc, void *codePtr, CmdFrame *cfPtr, Tcl_Size cmd, Tcl_Size pc); MODULE_SCOPE void TclArgumentBCRelease(Tcl_Interp *interp, CmdFrame *cfPtr); MODULE_SCOPE void TclArgumentGet(Tcl_Interp *interp, Tcl_Obj *obj, | | | | 3320 3321 3322 3323 3324 3325 3326 3327 3328 3329 3330 3331 3332 3333 3334 3335 3336 3337 3338 3339 3340 3341 3342 3343 3344 3345 3346 3347 3348 3349 3350 3351 | MODULE_SCOPE void TclArgumentBCEnter(Tcl_Interp *interp, Tcl_Obj *objv[], Tcl_Size objc, void *codePtr, CmdFrame *cfPtr, Tcl_Size cmd, Tcl_Size pc); MODULE_SCOPE void TclArgumentBCRelease(Tcl_Interp *interp, CmdFrame *cfPtr); MODULE_SCOPE void TclArgumentGet(Tcl_Interp *interp, Tcl_Obj *obj, CmdFrame **cfPtrPtr, Tcl_Size *wordPtr); MODULE_SCOPE bool TclAsyncNotifier(int sigNumber, Tcl_ThreadId threadId, void *clientData, signed char *flagPtr, signed char value); MODULE_SCOPE void TclAsyncMarkFromNotifier(void); MODULE_SCOPE double TclBignumToDouble(const void *bignum); MODULE_SCOPE int TclByteArrayMatch(const unsigned char *string, Tcl_Size strLen, const unsigned char *pattern, Tcl_Size ptnLen, int flags); MODULE_SCOPE double TclCeil(const void *a); MODULE_SCOPE void TclChannelPreserve(Tcl_Channel chan); MODULE_SCOPE void TclChannelRelease(Tcl_Channel chan); MODULE_SCOPE int TclChannelGetBlockingMode(Tcl_Channel chan); MODULE_SCOPE int TclCheckArrayTraces(Tcl_Interp *interp, Var *varPtr, Var *arrayPtr, Tcl_Obj *name, Tcl_Size index); MODULE_SCOPE int TclCheckEmptyString(Tcl_Obj *objPtr); MODULE_SCOPE int TclChanCaughtErrorBypass(Tcl_Interp *interp, Tcl_Channel chan); MODULE_SCOPE Tcl_ObjCmdProc2 TclChannelNamesCmd; MODULE_SCOPE int TclChanIsBinary(Tcl_Channel chan); MODULE_SCOPE Tcl_NRPostProc TclClearRootEnsemble; MODULE_SCOPE int TclCompareTwoNumbers(Tcl_Obj *valuePtr, Tcl_Obj *value2Ptr); MODULE_SCOPE ContLineLoc *TclContinuationsEnter(Tcl_Obj *objPtr, Tcl_Size num, Tcl_Size *loc); MODULE_SCOPE void TclContinuationsEnterDerived(Tcl_Obj *objPtr, |
| ︙ | ︙ | |||
3362 3363 3364 3365 3366 3367 3368 | MODULE_SCOPE int TclCopyNamespaceVariables(Tcl_Interp *interp, Namespace *originNs, Namespace *targetNs); MODULE_SCOPE int TclCreateConstantInNS(Tcl_Interp *interp, Namespace *nsPtr, Tcl_Obj *nameObj, Tcl_Obj *valueObj); MODULE_SCOPE Tcl_Command TclCreateObjCommandInNs(Tcl_Interp *interp, const char *cmdName, Tcl_Namespace *nsPtr, | | | 3360 3361 3362 3363 3364 3365 3366 3367 3368 3369 3370 3371 3372 3373 3374 | MODULE_SCOPE int TclCopyNamespaceVariables(Tcl_Interp *interp, Namespace *originNs, Namespace *targetNs); MODULE_SCOPE int TclCreateConstantInNS(Tcl_Interp *interp, Namespace *nsPtr, Tcl_Obj *nameObj, Tcl_Obj *valueObj); MODULE_SCOPE Tcl_Command TclCreateObjCommandInNs(Tcl_Interp *interp, const char *cmdName, Tcl_Namespace *nsPtr, Tcl_ObjCmdProc2 *proc, void *clientData, Tcl_CmdDeleteProc *deleteProc); MODULE_SCOPE Tcl_Command TclCreateEnsembleInNs(Tcl_Interp *interp, const char *name, Tcl_Namespace *nameNamespacePtr, Tcl_Namespace *ensembleNamespacePtr, int flags); MODULE_SCOPE void TclDeleteNamespaceVars(Namespace *nsPtr); MODULE_SCOPE void TclDeleteNamespaceChildren(Namespace *nsPtr); MODULE_SCOPE Tcl_Size TclDictGetSize(Tcl_Obj *dictPtr); |
| ︙ | ︙ | |||
3387 3388 3389 3390 3391 3392 3393 | const char *key, const char *value); MODULE_SCOPE int TclDictRemove(Tcl_Interp *interp, Tcl_Obj *dictPtr, const char *key); /* TIP #280 - Modified token based evaluation, with line information. */ MODULE_SCOPE int TclEvalEx(Tcl_Interp *interp, const char *script, Tcl_Size numBytes, int flags, int line, Tcl_Size *clNextOuter, const char *outerScript); | | | | | | | | | | | | | 3385 3386 3387 3388 3389 3390 3391 3392 3393 3394 3395 3396 3397 3398 3399 3400 3401 3402 3403 3404 3405 3406 3407 3408 3409 | const char *key, const char *value); MODULE_SCOPE int TclDictRemove(Tcl_Interp *interp, Tcl_Obj *dictPtr, const char *key); /* TIP #280 - Modified token based evaluation, with line information. */ MODULE_SCOPE int TclEvalEx(Tcl_Interp *interp, const char *script, Tcl_Size numBytes, int flags, int line, Tcl_Size *clNextOuter, const char *outerScript); MODULE_SCOPE Tcl_ObjCmdProc2 TclFileAttrsCmd; MODULE_SCOPE Tcl_ObjCmdProc2 TclFileCopyCmd; MODULE_SCOPE Tcl_ObjCmdProc2 TclFileDeleteCmd; MODULE_SCOPE Tcl_ObjCmdProc2 TclFileLinkCmd; MODULE_SCOPE Tcl_ObjCmdProc2 TclFileMakeDirsCmd; MODULE_SCOPE Tcl_ObjCmdProc2 TclFileReadLinkCmd; MODULE_SCOPE Tcl_ObjCmdProc2 TclFileRenameCmd; MODULE_SCOPE Tcl_ObjCmdProc2 TclFileTempDirCmd; MODULE_SCOPE Tcl_ObjCmdProc2 TclFileTemporaryCmd; MODULE_SCOPE Tcl_ObjCmdProc2 TclFileHomeCmd; MODULE_SCOPE Tcl_ObjCmdProc2 TclFileTildeExpandCmd; MODULE_SCOPE void TclCreateLateExitHandler(Tcl_ExitProc *proc, void *clientData); MODULE_SCOPE void TclDeleteLateExitHandler(Tcl_ExitProc *proc, void *clientData); MODULE_SCOPE char * TclDStringAppendObj(Tcl_DString *dsPtr, Tcl_Obj *objPtr); MODULE_SCOPE char * TclDStringAppendDString(Tcl_DString *dsPtr, |
| ︙ | ︙ | |||
3437 3438 3439 3440 3441 3442 3443 | MODULE_SCOPE void TclFinalizeThreadAlloc(void); MODULE_SCOPE void TclFinalizeThreadAllocThread(void); MODULE_SCOPE void TclFinalizeThreadData(int quick); MODULE_SCOPE void TclFinalizeThreadObjects(void); MODULE_SCOPE double TclFloor(const void *a); MODULE_SCOPE void TclFormatNaN(double value, char *buffer); MODULE_SCOPE int TclFSFileAttrIndex(Tcl_Obj *pathPtr, | | | | 3435 3436 3437 3438 3439 3440 3441 3442 3443 3444 3445 3446 3447 3448 3449 3450 3451 3452 | MODULE_SCOPE void TclFinalizeThreadAlloc(void); MODULE_SCOPE void TclFinalizeThreadAllocThread(void); MODULE_SCOPE void TclFinalizeThreadData(int quick); MODULE_SCOPE void TclFinalizeThreadObjects(void); MODULE_SCOPE double TclFloor(const void *a); MODULE_SCOPE void TclFormatNaN(double value, char *buffer); MODULE_SCOPE int TclFSFileAttrIndex(Tcl_Obj *pathPtr, const char *attributeName, int *indexPtr); MODULE_SCOPE Tcl_Command TclNRCreateCommandInNs(Tcl_Interp *interp, const char *cmdName, Tcl_Namespace *nsPtr, Tcl_ObjCmdProc2 *proc, Tcl_ObjCmdProc2 *nreProc, void *clientData, Tcl_CmdDeleteProc *deleteProc); MODULE_SCOPE int TclNREvalFile(Tcl_Interp *interp, Tcl_Obj *pathPtr, const char *encodingName); MODULE_SCOPE bool * TclGetAsyncReadyPtr(void); MODULE_SCOPE Tcl_Obj * TclGetBgErrorHandler(Tcl_Interp *interp); MODULE_SCOPE int TclGetChannelFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Channel *chanPtr, |
| ︙ | ︙ | |||
3470 3471 3472 3473 3474 3475 3476 | Tcl_WideInt *); MODULE_SCOPE int TclCompareStringKeys(void *keyPtr, Tcl_HashEntry *hPtr); MODULE_SCOPE size_t TclHashStringKey(Tcl_HashTable *tablePtr, void *keyPtr); MODULE_SCOPE int TclIncrObj(Tcl_Interp *interp, Tcl_Obj *valuePtr, Tcl_Obj *incrPtr); MODULE_SCOPE Tcl_Obj * TclIncrObjVar2(Tcl_Interp *interp, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, Tcl_Obj *incrPtr, int flags); | | | | | | | | | 3468 3469 3470 3471 3472 3473 3474 3475 3476 3477 3478 3479 3480 3481 3482 3483 3484 3485 3486 3487 3488 3489 | Tcl_WideInt *); MODULE_SCOPE int TclCompareStringKeys(void *keyPtr, Tcl_HashEntry *hPtr); MODULE_SCOPE size_t TclHashStringKey(Tcl_HashTable *tablePtr, void *keyPtr); MODULE_SCOPE int TclIncrObj(Tcl_Interp *interp, Tcl_Obj *valuePtr, Tcl_Obj *incrPtr); MODULE_SCOPE Tcl_Obj * TclIncrObjVar2(Tcl_Interp *interp, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, Tcl_Obj *incrPtr, int flags); MODULE_SCOPE Tcl_ObjCmdProc2 TclInfoExistsCmd; MODULE_SCOPE Tcl_ObjCmdProc2 TclInfoCoroutineCmd; MODULE_SCOPE Tcl_Obj * TclInfoFrame(Tcl_Interp *interp, CmdFrame *framePtr); MODULE_SCOPE Tcl_ObjCmdProc2 TclInfoGlobalsCmd; MODULE_SCOPE Tcl_ObjCmdProc2 TclInfoLocalsCmd; MODULE_SCOPE Tcl_ObjCmdProc2 TclInfoVarsCmd; MODULE_SCOPE Tcl_ObjCmdProc2 TclInfoConstsCmd; MODULE_SCOPE Tcl_ObjCmdProc2 TclInfoConstantCmd; MODULE_SCOPE void TclInitAlloc(void); MODULE_SCOPE void TclInitDbCkalloc(void); MODULE_SCOPE void TclInitDoubleConversion(void); MODULE_SCOPE void TclInitEmbeddedConfigurationInformation( Tcl_Interp *interp); MODULE_SCOPE void TclInitEncodingSubsystem(void); MODULE_SCOPE void TclInitIOSubsystem(void); |
| ︙ | ︙ | |||
3534 3535 3536 3537 3538 3539 3540 3541 3542 3543 3544 3545 3546 3547 | MODULE_SCOPE Tcl_Obj * TclNoErrorStack(Tcl_Interp *interp, Tcl_Obj *options); MODULE_SCOPE int TclNokia770Doubles(void); MODULE_SCOPE void TclNsDecrRefCount(Namespace *nsPtr); MODULE_SCOPE int TclNamespaceDeleted(Namespace *nsPtr); MODULE_SCOPE void TclObjVarErrMsg(Tcl_Interp *interp, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, const char *operation, const char *reason, Tcl_Size index); MODULE_SCOPE int TclObjUnsetVar2(Tcl_Interp *interp, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, int flags); MODULE_SCOPE Tcl_Size TclParseBackslash(const char *src, Tcl_Size numBytes, Tcl_Size *readPtr, char *dst); MODULE_SCOPE int TclParseNumber(Tcl_Interp *interp, Tcl_Obj *objPtr, const char *expected, const char *bytes, Tcl_Size numBytes, const char **endPtrPtr, int flags); | > > > > > > > > > | 3532 3533 3534 3535 3536 3537 3538 3539 3540 3541 3542 3543 3544 3545 3546 3547 3548 3549 3550 3551 3552 3553 3554 | MODULE_SCOPE Tcl_Obj * TclNoErrorStack(Tcl_Interp *interp, Tcl_Obj *options); MODULE_SCOPE int TclNokia770Doubles(void); MODULE_SCOPE void TclNsDecrRefCount(Namespace *nsPtr); MODULE_SCOPE int TclNamespaceDeleted(Namespace *nsPtr); MODULE_SCOPE void TclObjVarErrMsg(Tcl_Interp *interp, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, const char *operation, const char *reason, Tcl_Size index); #ifndef TCL_NO_DEPRECATED MODULE_SCOPE Tcl_ObjCmdProc TclObjInterpProc; #define TclObjInterpProc TclGetObjInterpProc() #endif MODULE_SCOPE Tcl_ObjCmdProc2 TclObjInterpProc2; #define TclObjInterpProc2 TclGetObjInterpProc2() MODULE_SCOPE int TclObjInvokeNamespace(Tcl_Interp *interp, Tcl_Size objc, Tcl_Obj *const objv[], Tcl_Namespace *nsPtr, int flags); MODULE_SCOPE int TclObjUnsetVar2(Tcl_Interp *interp, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, int flags); MODULE_SCOPE Tcl_Size TclParseBackslash(const char *src, Tcl_Size numBytes, Tcl_Size *readPtr, char *dst); MODULE_SCOPE int TclParseNumber(Tcl_Interp *interp, Tcl_Obj *objPtr, const char *expected, const char *bytes, Tcl_Size numBytes, const char **endPtrPtr, int flags); |
| ︙ | ︙ | |||
3677 3678 3679 3680 3681 3682 3683 | const char *trim, Tcl_Size numTrim, Tcl_Size *trimRight); MODULE_SCOPE Tcl_Size TclTrimLeft(const char *bytes, Tcl_Size numBytes, const char *trim, Tcl_Size numTrim); MODULE_SCOPE Tcl_Size TclTrimRight(const char *bytes, Tcl_Size numBytes, const char *trim, Tcl_Size numTrim); MODULE_SCOPE const char*TclGetCommandTypeName(Tcl_Command command); | < < < | | 3684 3685 3686 3687 3688 3689 3690 3691 3692 3693 3694 3695 3696 3697 3698 3699 | const char *trim, Tcl_Size numTrim, Tcl_Size *trimRight); MODULE_SCOPE Tcl_Size TclTrimLeft(const char *bytes, Tcl_Size numBytes, const char *trim, Tcl_Size numTrim); MODULE_SCOPE Tcl_Size TclTrimRight(const char *bytes, Tcl_Size numBytes, const char *trim, Tcl_Size numTrim); MODULE_SCOPE const char*TclGetCommandTypeName(Tcl_Command command); MODULE_SCOPE void TclRegisterCommandTypeName( Tcl_ObjCmdProc2 *implementationProc, const char *nameStr); MODULE_SCOPE int TclUtfCmp(const char *cs, const char *ct); MODULE_SCOPE int TclUtfCasecmp(const char *cs, const char *ct); MODULE_SCOPE int TclUtfCount(int ch); MODULE_SCOPE Tcl_Obj * TclpNativeToNormalized(void *clientData); MODULE_SCOPE Tcl_Obj * TclpFilesystemPathType(Tcl_Obj *pathPtr); MODULE_SCOPE int TclpDlopen(Tcl_Interp *interp, Tcl_Obj *pathPtr, |
| ︙ | ︙ | |||
3747 3748 3749 3750 3751 3752 3753 | /* *---------------------------------------------------------------- * Command procedures in the generic core: *---------------------------------------------------------------- */ | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | 3751 3752 3753 3754 3755 3756 3757 3758 3759 3760 3761 3762 3763 3764 3765 3766 3767 3768 3769 3770 3771 3772 3773 3774 3775 3776 3777 3778 3779 3780 3781 3782 3783 3784 3785 3786 3787 3788 3789 3790 3791 3792 3793 3794 3795 3796 3797 3798 3799 3800 3801 3802 3803 3804 3805 3806 3807 3808 3809 3810 3811 3812 3813 3814 3815 3816 3817 3818 3819 3820 3821 3822 3823 3824 3825 3826 3827 3828 3829 3830 3831 3832 3833 3834 3835 3836 3837 3838 3839 3840 3841 3842 3843 3844 3845 3846 3847 3848 3849 3850 3851 3852 3853 3854 3855 3856 3857 3858 3859 3860 3861 3862 3863 3864 3865 3866 3867 3868 3869 3870 3871 3872 3873 3874 3875 3876 | /* *---------------------------------------------------------------- * Command procedures in the generic core: *---------------------------------------------------------------- */ MODULE_SCOPE Tcl_ObjCmdProc2 Tcl_AfterObjCmd; MODULE_SCOPE Tcl_ObjCmdProc2 Tcl_AppendObjCmd; MODULE_SCOPE Tcl_ObjCmdProc2 Tcl_ApplyObjCmd; MODULE_SCOPE Tcl_ObjCmdProc2 Tcl_BreakObjCmd; MODULE_SCOPE Tcl_ObjCmdProc2 Tcl_CatchObjCmd; MODULE_SCOPE Tcl_ObjCmdProc2 Tcl_CdObjCmd; MODULE_SCOPE int TclSetUpChanCmd(Tcl_Interp *interp, Tcl_Command chanEnsemble); MODULE_SCOPE Tcl_ObjCmdProc2 TclChanCreateObjCmd; MODULE_SCOPE Tcl_ObjCmdProc2 TclChanPostEventObjCmd; MODULE_SCOPE Tcl_ObjCmdProc2 TclChanPopObjCmd; MODULE_SCOPE Tcl_ObjCmdProc2 TclChanPushObjCmd; MODULE_SCOPE void TclClockInit(Tcl_Interp *interp); MODULE_SCOPE Tcl_ObjCmdProc2 TclClockOldscanObjCmd; MODULE_SCOPE Tcl_ObjCmdProc2 Tcl_CloseObjCmd; MODULE_SCOPE Tcl_ObjCmdProc2 Tcl_ConcatObjCmd; MODULE_SCOPE Tcl_ObjCmdProc2 Tcl_ConstObjCmd; MODULE_SCOPE Tcl_ObjCmdProc2 Tcl_ContinueObjCmd; MODULE_SCOPE Tcl_TimerToken TclCreateAbsoluteTimerHandler( Tcl_Time *timePtr, Tcl_TimerProc *proc, void *clientData); MODULE_SCOPE Tcl_ObjCmdProc2 TclDefaultBgErrorHandlerObjCmd; MODULE_SCOPE int TclDictWithFinish(Tcl_Interp *interp, Var *varPtr, Var *arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, Tcl_Size index, Tcl_Size pathc, Tcl_Obj *const pathv[], Tcl_Obj *keysPtr); MODULE_SCOPE Tcl_Obj * TclDictWithInit(Tcl_Interp *interp, Tcl_Obj *dictPtr, Tcl_Size pathc, Tcl_Obj *const pathv[]); MODULE_SCOPE Tcl_ObjCmdProc2 Tcl_DisassembleObjCmd; MODULE_SCOPE Tcl_ObjCmdProc2 TclLoadIcuObjCmd; /* Assemble command function */ MODULE_SCOPE Tcl_ObjCmdProc2 Tcl_AssembleObjCmd; MODULE_SCOPE Tcl_ObjCmdProc2 TclNRAssembleObjCmd; MODULE_SCOPE Tcl_Command TclInitEncodingCmd(Tcl_Interp *interp); MODULE_SCOPE Tcl_ObjCmdProc2 Tcl_EofObjCmd; MODULE_SCOPE Tcl_ObjCmdProc2 Tcl_ErrorObjCmd; MODULE_SCOPE Tcl_ObjCmdProc2 Tcl_EvalObjCmd; MODULE_SCOPE Tcl_ObjCmdProc2 Tcl_ExecObjCmd; MODULE_SCOPE Tcl_ObjCmdProc2 Tcl_ExitObjCmd; MODULE_SCOPE Tcl_ObjCmdProc2 Tcl_ExprObjCmd; MODULE_SCOPE Tcl_ObjCmdProc2 Tcl_FblockedObjCmd; MODULE_SCOPE Tcl_ObjCmdProc2 Tcl_FconfigureObjCmd; MODULE_SCOPE Tcl_ObjCmdProc2 Tcl_FcopyObjCmd; MODULE_SCOPE Tcl_ObjCmdProc2 Tcl_FileEventObjCmd; MODULE_SCOPE Tcl_ObjCmdProc2 Tcl_FlushObjCmd; MODULE_SCOPE Tcl_ObjCmdProc2 Tcl_ForObjCmd; MODULE_SCOPE Tcl_ObjCmdProc2 Tcl_ForeachObjCmd; MODULE_SCOPE Tcl_ObjCmdProc2 Tcl_FormatObjCmd; MODULE_SCOPE Tcl_ObjCmdProc2 Tcl_GetsObjCmd; MODULE_SCOPE Tcl_ObjCmdProc2 Tcl_GlobalObjCmd; MODULE_SCOPE Tcl_ObjCmdProc2 Tcl_GlobObjCmd; MODULE_SCOPE Tcl_ObjCmdProc2 Tcl_IfObjCmd; MODULE_SCOPE Tcl_ObjCmdProc2 Tcl_IncrObjCmd; MODULE_SCOPE Tcl_ObjCmdProc2 Tcl_InterpObjCmd; MODULE_SCOPE Tcl_ObjCmdProc2 Tcl_JoinObjCmd; MODULE_SCOPE Tcl_ObjCmdProc2 Tcl_LappendObjCmd; MODULE_SCOPE Tcl_ObjCmdProc2 Tcl_LassignObjCmd; MODULE_SCOPE Tcl_ObjCmdProc2 Tcl_LeditObjCmd; MODULE_SCOPE Tcl_ObjCmdProc2 Tcl_LindexObjCmd; MODULE_SCOPE Tcl_ObjCmdProc2 Tcl_LinsertObjCmd; MODULE_SCOPE Tcl_ObjCmdProc2 Tcl_LlengthObjCmd; MODULE_SCOPE Tcl_ObjCmdProc2 Tcl_ListObjCmd; MODULE_SCOPE Tcl_ObjCmdProc2 Tcl_LmapObjCmd; MODULE_SCOPE Tcl_ObjCmdProc2 Tcl_LoadObjCmd; MODULE_SCOPE Tcl_ObjCmdProc2 Tcl_LpopObjCmd; MODULE_SCOPE Tcl_ObjCmdProc2 Tcl_LrangeObjCmd; MODULE_SCOPE Tcl_ObjCmdProc2 Tcl_LremoveObjCmd; MODULE_SCOPE Tcl_ObjCmdProc2 Tcl_LrepeatObjCmd; MODULE_SCOPE Tcl_ObjCmdProc2 Tcl_LreplaceObjCmd; MODULE_SCOPE Tcl_ObjCmdProc2 Tcl_LreverseObjCmd; MODULE_SCOPE Tcl_ObjCmdProc2 Tcl_LsearchObjCmd; MODULE_SCOPE Tcl_ObjCmdProc2 Tcl_LseqObjCmd; MODULE_SCOPE Tcl_ObjCmdProc2 Tcl_LsetObjCmd; MODULE_SCOPE Tcl_ObjCmdProc2 Tcl_LsortObjCmd; MODULE_SCOPE Tcl_ObjCmdProc2 TclNamespaceEnsembleCmd; MODULE_SCOPE Tcl_ObjCmdProc2 Tcl_OpenObjCmd; MODULE_SCOPE Tcl_ObjCmdProc2 Tcl_PackageObjCmd; MODULE_SCOPE Tcl_ObjCmdProc2 Tcl_PidObjCmd; MODULE_SCOPE int TclSetUpPrefixCmd(Tcl_Interp *interp, Tcl_Command prefixEnsemble); MODULE_SCOPE Tcl_ObjCmdProc2 Tcl_PutsObjCmd; MODULE_SCOPE Tcl_ObjCmdProc2 Tcl_PwdObjCmd; MODULE_SCOPE Tcl_ObjCmdProc2 Tcl_ReadObjCmd; MODULE_SCOPE Tcl_ObjCmdProc2 Tcl_RegexpObjCmd; MODULE_SCOPE Tcl_ObjCmdProc2 Tcl_RegsubObjCmd; MODULE_SCOPE Tcl_ObjCmdProc2 Tcl_RenameObjCmd; MODULE_SCOPE Tcl_ObjCmdProc2 Tcl_RepresentationCmd; MODULE_SCOPE Tcl_ObjCmdProc2 Tcl_ReturnObjCmd; MODULE_SCOPE Tcl_ObjCmdProc2 TclSafeCatchCmd; MODULE_SCOPE Tcl_ObjCmdProc2 Tcl_ScanObjCmd; MODULE_SCOPE Tcl_ObjCmdProc2 Tcl_SeekObjCmd; MODULE_SCOPE Tcl_ObjCmdProc2 Tcl_SetObjCmd; MODULE_SCOPE Tcl_ObjCmdProc2 Tcl_SplitObjCmd; MODULE_SCOPE Tcl_ObjCmdProc2 Tcl_SocketObjCmd; MODULE_SCOPE Tcl_ObjCmdProc2 Tcl_SourceObjCmd; MODULE_SCOPE Tcl_ObjCmdProc2 Tcl_SubstObjCmd; MODULE_SCOPE Tcl_ObjCmdProc2 Tcl_SwitchObjCmd; MODULE_SCOPE Tcl_ObjCmdProc2 Tcl_TellObjCmd; MODULE_SCOPE Tcl_ObjCmdProc2 Tcl_ThrowObjCmd; MODULE_SCOPE Tcl_ObjCmdProc2 Tcl_TimeObjCmd; MODULE_SCOPE Tcl_ObjCmdProc2 Tcl_TimeRateObjCmd; MODULE_SCOPE Tcl_ObjCmdProc2 Tcl_TraceObjCmd; MODULE_SCOPE Tcl_ObjCmdProc2 Tcl_TryObjCmd; MODULE_SCOPE Tcl_ObjCmdProc2 Tcl_UnloadObjCmd; MODULE_SCOPE Tcl_ObjCmdProc2 Tcl_UnsetObjCmd; MODULE_SCOPE Tcl_ObjCmdProc2 Tcl_UpdateObjCmd; MODULE_SCOPE Tcl_ObjCmdProc2 Tcl_UplevelObjCmd; MODULE_SCOPE Tcl_ObjCmdProc2 Tcl_UpvarObjCmd; MODULE_SCOPE Tcl_ObjCmdProc2 Tcl_VariableObjCmd; MODULE_SCOPE Tcl_ObjCmdProc2 Tcl_VwaitObjCmd; MODULE_SCOPE Tcl_ObjCmdProc2 Tcl_WhileObjCmd; /* *---------------------------------------------------------------- * Compilation procedures for commands in the generic core: *---------------------------------------------------------------- */ |
| ︙ | ︙ | |||
3982 3983 3984 3985 3986 3987 3988 | MODULE_SCOPE CompileProc TclCompileBasic2Or3ArgCmd; MODULE_SCOPE CompileProc TclCompileBasic0To2ArgCmd; MODULE_SCOPE CompileProc TclCompileBasic1To3ArgCmd; MODULE_SCOPE CompileProc TclCompileBasicMin0ArgCmd; MODULE_SCOPE CompileProc TclCompileBasicMin1ArgCmd; MODULE_SCOPE CompileProc TclCompileBasicMin2ArgCmd; | | | | | | | | | | | | | | | | | | | 3986 3987 3988 3989 3990 3991 3992 3993 3994 3995 3996 3997 3998 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 4029 4030 4031 4032 4033 | MODULE_SCOPE CompileProc TclCompileBasic2Or3ArgCmd; MODULE_SCOPE CompileProc TclCompileBasic0To2ArgCmd; MODULE_SCOPE CompileProc TclCompileBasic1To3ArgCmd; MODULE_SCOPE CompileProc TclCompileBasicMin0ArgCmd; MODULE_SCOPE CompileProc TclCompileBasicMin1ArgCmd; MODULE_SCOPE CompileProc TclCompileBasicMin2ArgCmd; MODULE_SCOPE Tcl_ObjCmdProc2 TclInvertOpCmd; MODULE_SCOPE CompileProc TclCompileInvertOpCmd; MODULE_SCOPE Tcl_ObjCmdProc2 TclNotOpCmd; MODULE_SCOPE CompileProc TclCompileNotOpCmd; MODULE_SCOPE Tcl_ObjCmdProc2 TclAddOpCmd; MODULE_SCOPE CompileProc TclCompileAddOpCmd; MODULE_SCOPE Tcl_ObjCmdProc2 TclMulOpCmd; MODULE_SCOPE CompileProc TclCompileMulOpCmd; MODULE_SCOPE Tcl_ObjCmdProc2 TclAndOpCmd; MODULE_SCOPE CompileProc TclCompileAndOpCmd; MODULE_SCOPE Tcl_ObjCmdProc2 TclOrOpCmd; MODULE_SCOPE CompileProc TclCompileOrOpCmd; MODULE_SCOPE Tcl_ObjCmdProc2 TclXorOpCmd; MODULE_SCOPE CompileProc TclCompileXorOpCmd; MODULE_SCOPE Tcl_ObjCmdProc2 TclPowOpCmd; MODULE_SCOPE CompileProc TclCompilePowOpCmd; MODULE_SCOPE Tcl_ObjCmdProc2 TclLshiftOpCmd; MODULE_SCOPE CompileProc TclCompileLshiftOpCmd; MODULE_SCOPE Tcl_ObjCmdProc2 TclRshiftOpCmd; MODULE_SCOPE CompileProc TclCompileRshiftOpCmd; MODULE_SCOPE Tcl_ObjCmdProc2 TclModOpCmd; MODULE_SCOPE CompileProc TclCompileModOpCmd; MODULE_SCOPE Tcl_ObjCmdProc2 TclNeqOpCmd; MODULE_SCOPE CompileProc TclCompileNeqOpCmd; MODULE_SCOPE Tcl_ObjCmdProc2 TclStrneqOpCmd; MODULE_SCOPE CompileProc TclCompileStrneqOpCmd; MODULE_SCOPE Tcl_ObjCmdProc2 TclInOpCmd; MODULE_SCOPE CompileProc TclCompileInOpCmd; MODULE_SCOPE Tcl_ObjCmdProc2 TclNiOpCmd; MODULE_SCOPE CompileProc TclCompileNiOpCmd; MODULE_SCOPE Tcl_ObjCmdProc2 TclMinusOpCmd; MODULE_SCOPE CompileProc TclCompileMinusOpCmd; MODULE_SCOPE Tcl_ObjCmdProc2 TclDivOpCmd; MODULE_SCOPE CompileProc TclCompileDivOpCmd; MODULE_SCOPE CompileProc TclCompileLessOpCmd; MODULE_SCOPE CompileProc TclCompileLeqOpCmd; MODULE_SCOPE CompileProc TclCompileGreaterOpCmd; MODULE_SCOPE CompileProc TclCompileGeqOpCmd; MODULE_SCOPE CompileProc TclCompileEqOpCmd; MODULE_SCOPE CompileProc TclCompileStreqOpCmd; |
| ︙ | ︙ | |||
4125 4126 4127 4128 4129 4130 4131 | MODULE_SCOPE int TclUniCharCaseMatch(const Tcl_UniChar *uniStr, const Tcl_UniChar *uniPattern, int nocase); /* * Just for the purposes of command-type registration. */ | | | | | | | | | | 4129 4130 4131 4132 4133 4134 4135 4136 4137 4138 4139 4140 4141 4142 4143 4144 4145 4146 4147 4148 4149 4150 | MODULE_SCOPE int TclUniCharCaseMatch(const Tcl_UniChar *uniStr, const Tcl_UniChar *uniPattern, int nocase); /* * Just for the purposes of command-type registration. */ MODULE_SCOPE Tcl_ObjCmdProc2 TclEnsembleImplementationCmd; MODULE_SCOPE Tcl_ObjCmdProc2 TclAliasObjCmd; MODULE_SCOPE Tcl_ObjCmdProc2 TclLocalAliasObjCmd; MODULE_SCOPE Tcl_ObjCmdProc2 TclChildObjCmd; MODULE_SCOPE Tcl_ObjCmdProc2 TclInvokeImportedCmd; MODULE_SCOPE Tcl_ObjCmdProc2 TclOOPublicObjectCmd; MODULE_SCOPE Tcl_ObjCmdProc2 TclOOPrivateObjectCmd; MODULE_SCOPE Tcl_ObjCmdProc2 TclOOMyClassObjCmd; /* * TIP #462. */ /* * The following enum values give the status of a spawned process. |
| ︙ | ︙ | |||
4179 4180 4181 4182 4183 4184 4185 | MODULE_SCOPE int TclIndexEncode(Tcl_Interp *interp, Tcl_Obj *objPtr, int before, int after, int *indexPtr); MODULE_SCOPE Tcl_Size TclIndexDecode(int encoded, Tcl_Size endValue); /* * Error message utility functions */ | < < | 4183 4184 4185 4186 4187 4188 4189 4190 4191 4192 4193 4194 4195 4196 | MODULE_SCOPE int TclIndexEncode(Tcl_Interp *interp, Tcl_Obj *objPtr, int before, int after, int *indexPtr); MODULE_SCOPE Tcl_Size TclIndexDecode(int encoded, Tcl_Size endValue); /* * Error message utility functions */ MODULE_SCOPE int TclListLimitExceededError(Tcl_Interp *interp); /* Constants used in index value encoding routines. */ #define TCL_INDEX_END ((Tcl_Size)-2) #define TCL_INDEX_START ((Tcl_Size)0) /* |
| ︙ | ︙ | |||
4424 4425 4426 4427 4428 4429 4430 |
int line);
# define TclDbNewObj(objPtr, file, line) \
do { \
TclIncrObjsAllocated(); \
(objPtr) = (Tcl_Obj *) \
Tcl_DbCkalloc(sizeof(Tcl_Obj), (file), (line)); \
| > | | > | 4426 4427 4428 4429 4430 4431 4432 4433 4434 4435 4436 4437 4438 4439 4440 4441 4442 4443 |
int line);
# define TclDbNewObj(objPtr, file, line) \
do { \
TclIncrObjsAllocated(); \
(objPtr) = (Tcl_Obj *) \
Tcl_DbCkalloc(sizeof(Tcl_Obj), (file), (line)); \
if ((objPtr)) { \
TclDbInitNewObj((objPtr), (file), (line)); \
TCL_DTRACE_OBJ_CREATE(objPtr); \
} \
} while (0)
# define TclNewObj(objPtr) \
TclDbNewObj(objPtr, __FILE__, __LINE__);
# define TclDecrRefCount(objPtr) \
Tcl_DbDecrRefCount(objPtr, __FILE__, __LINE__)
|
| ︙ | ︙ |
Changes to generic/tclIntDecls.h.
| ︙ | ︙ | |||
23 24 25 26 27 28 29 30 31 32 33 34 35 36 | # ifdef USE_TCL_STUBS # define TCL_STORAGE_CLASS # else # define TCL_STORAGE_CLASS DLLIMPORT # endif #endif /* * WARNING: This file is automatically generated by the tools/genStubs.tcl * script. Any modifications to the function declarations below should be made * in the generic/tclInt.decls script. */ /* !BEGIN!: Do not edit below this line. */ | > > > > | 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 | # ifdef USE_TCL_STUBS # define TCL_STORAGE_CLASS # else # define TCL_STORAGE_CLASS DLLIMPORT # endif #endif #ifdef TCL_NO_DEPRECATED #define Tcl_ObjCmdProc void #endif /* * WARNING: This file is automatically generated by the tools/genStubs.tcl * script. Any modifications to the function declarations below should be made * in the generic/tclInt.decls script. */ /* !BEGIN!: Do not edit below this line. */ |
| ︙ | ︙ | |||
472 473 474 475 476 477 478 | EXTERN int TclObjBeingDeleted(Tcl_Obj *objPtr); /* 227 */ EXTERN void TclSetNsPath(Namespace *nsPtr, Tcl_Size pathLength, Tcl_Namespace *pathAry[]); /* Slot 228 is reserved */ /* 229 */ EXTERN int TclPtrMakeUpvar(Tcl_Interp *interp, Var *otherP1Ptr, | | > | > | 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 | EXTERN int TclObjBeingDeleted(Tcl_Obj *objPtr); /* 227 */ EXTERN void TclSetNsPath(Namespace *nsPtr, Tcl_Size pathLength, Tcl_Namespace *pathAry[]); /* Slot 228 is reserved */ /* 229 */ EXTERN int TclPtrMakeUpvar(Tcl_Interp *interp, Var *otherP1Ptr, const char *myName, int myFlags, Tcl_Size index); /* 230 */ EXTERN Var * TclObjLookupVar(Tcl_Interp *interp, Tcl_Obj *part1Ptr, const char *part2, int flags, const char *msg, int createPart1, int createPart2, Var **arrayPtrPtr); /* 231 */ EXTERN int TclGetNamespaceFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Namespace **nsPtrPtr); /* 232 */ EXTERN int TclEvalObjEx(Tcl_Interp *interp, Tcl_Obj *objPtr, int flags, const CmdFrame *invoker, Tcl_Size word); /* 233 */ EXTERN void TclGetSrcInfoForPc(CmdFrame *contextPtr); /* 234 */ EXTERN Var * TclVarHashCreateVar(TclVarHashTable *tablePtr, const char *key, int *newPtr); /* 235 */ EXTERN void TclInitVarHashTable(TclVarHashTable *tablePtr, |
| ︙ | ︙ | |||
507 508 509 510 511 512 513 | Tcl_Obj *procNameObj, Tcl_Size skip, ProcErrorProc *errorProc); /* 240 */ EXTERN int TclNRRunCallbacks(Tcl_Interp *interp, int result, NRE_callback *rootPtr); /* 241 */ EXTERN int TclNREvalObjEx(Tcl_Interp *interp, Tcl_Obj *objPtr, | | > | 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 | Tcl_Obj *procNameObj, Tcl_Size skip, ProcErrorProc *errorProc); /* 240 */ EXTERN int TclNRRunCallbacks(Tcl_Interp *interp, int result, NRE_callback *rootPtr); /* 241 */ EXTERN int TclNREvalObjEx(Tcl_Interp *interp, Tcl_Obj *objPtr, int flags, const CmdFrame *invoker, Tcl_Size word); /* 242 */ EXTERN int TclNREvalObjv(Tcl_Interp *interp, Tcl_Size objc, Tcl_Obj *const objv[], int flags, Command *cmdPtr); /* 243 */ EXTERN void TclDbDumpActiveObjects(FILE *outFile); /* 244 */ |
| ︙ | ︙ | |||
805 806 807 808 809 810 811 |
void (*tclListObjValidate) (Tcl_Interp *interp, Tcl_Obj *listObj); /* 222 */
void * (*tclGetCStackPtr) (void); /* 223 */
TclPlatformType * (*tclGetPlatform) (void); /* 224 */
Tcl_Obj * (*tclTraceDictPath) (Tcl_Interp *interp, Tcl_Obj *rootPtr, Tcl_Size keyc, Tcl_Obj *const keyv[], int flags); /* 225 */
int (*tclObjBeingDeleted) (Tcl_Obj *objPtr); /* 226 */
void (*tclSetNsPath) (Namespace *nsPtr, Tcl_Size pathLength, Tcl_Namespace *pathAry[]); /* 227 */
void (*reserved228)(void);
| | | | | 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 |
void (*tclListObjValidate) (Tcl_Interp *interp, Tcl_Obj *listObj); /* 222 */
void * (*tclGetCStackPtr) (void); /* 223 */
TclPlatformType * (*tclGetPlatform) (void); /* 224 */
Tcl_Obj * (*tclTraceDictPath) (Tcl_Interp *interp, Tcl_Obj *rootPtr, Tcl_Size keyc, Tcl_Obj *const keyv[], int flags); /* 225 */
int (*tclObjBeingDeleted) (Tcl_Obj *objPtr); /* 226 */
void (*tclSetNsPath) (Namespace *nsPtr, Tcl_Size pathLength, Tcl_Namespace *pathAry[]); /* 227 */
void (*reserved228)(void);
int (*tclPtrMakeUpvar) (Tcl_Interp *interp, Var *otherP1Ptr, const char *myName, int myFlags, Tcl_Size index); /* 229 */
Var * (*tclObjLookupVar) (Tcl_Interp *interp, Tcl_Obj *part1Ptr, const char *part2, int flags, const char *msg, int createPart1, int createPart2, Var **arrayPtrPtr); /* 230 */
int (*tclGetNamespaceFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Namespace **nsPtrPtr); /* 231 */
int (*tclEvalObjEx) (Tcl_Interp *interp, Tcl_Obj *objPtr, int flags, const CmdFrame *invoker, Tcl_Size word); /* 232 */
void (*tclGetSrcInfoForPc) (CmdFrame *contextPtr); /* 233 */
Var * (*tclVarHashCreateVar) (TclVarHashTable *tablePtr, const char *key, int *newPtr); /* 234 */
void (*tclInitVarHashTable) (TclVarHashTable *tablePtr, Namespace *nsPtr); /* 235 */
void (*reserved236)(void);
int (*tclResetCancellation) (Tcl_Interp *interp, int force); /* 237 */
int (*tclNRInterpProc) (void *clientData, Tcl_Interp *interp, Tcl_Size objc, Tcl_Obj *const objv[]); /* 238 */
int (*tclNRInterpProcCore) (Tcl_Interp *interp, Tcl_Obj *procNameObj, Tcl_Size skip, ProcErrorProc *errorProc); /* 239 */
int (*tclNRRunCallbacks) (Tcl_Interp *interp, int result, NRE_callback *rootPtr); /* 240 */
int (*tclNREvalObjEx) (Tcl_Interp *interp, Tcl_Obj *objPtr, int flags, const CmdFrame *invoker, Tcl_Size word); /* 241 */
int (*tclNREvalObjv) (Tcl_Interp *interp, Tcl_Size objc, Tcl_Obj *const objv[], int flags, Command *cmdPtr); /* 242 */
void (*tclDbDumpActiveObjects) (FILE *outFile); /* 243 */
Tcl_HashTable * (*tclGetNamespaceChildTable) (Tcl_Namespace *nsPtr); /* 244 */
Tcl_HashTable * (*tclGetNamespaceCommandTable) (Tcl_Namespace *nsPtr); /* 245 */
int (*tclInitRewriteEnsemble) (Tcl_Interp *interp, Tcl_Size numRemoved, Tcl_Size numInserted, Tcl_Obj *const *objv); /* 246 */
void (*tclResetRewriteEnsemble) (Tcl_Interp *interp, int isRootEnsemble); /* 247 */
int (*tclCopyChannel) (Tcl_Interp *interp, Tcl_Channel inChan, Tcl_Channel outChan, long long toRead, Tcl_Obj *cmdPtr); /* 248 */
|
| ︙ | ︙ | |||
1259 1260 1261 1262 1263 1264 1265 1266 1267 1268 1269 1270 1271 1272 | /* Slot 260 is reserved */ #define TclUnusedStubEntry \ (tclIntStubsPtr->tclUnusedStubEntry) /* 261 */ #endif /* defined(USE_TCL_STUBS) */ /* !END!: Do not edit above this line. */ #if defined(USE_TCL_STUBS) #undef Tcl_StaticLibrary #define Tcl_StaticLibrary \ (tclIntStubsPtr->tclStaticLibrary) #endif /* defined(USE_TCL_STUBS) */ | > > > > > | 1266 1267 1268 1269 1270 1271 1272 1273 1274 1275 1276 1277 1278 1279 1280 1281 1282 1283 1284 | /* Slot 260 is reserved */ #define TclUnusedStubEntry \ (tclIntStubsPtr->tclUnusedStubEntry) /* 261 */ #endif /* defined(USE_TCL_STUBS) */ /* !END!: Do not edit above this line. */ #ifdef TCL_NO_DEPRECATED #undef Tcl_ObjCmdProc #undef TclGetObjInterpProc #endif #if defined(USE_TCL_STUBS) #undef Tcl_StaticLibrary #define Tcl_StaticLibrary \ (tclIntStubsPtr->tclStaticLibrary) #endif /* defined(USE_TCL_STUBS) */ |
| ︙ | ︙ |
Changes to generic/tclInterp.c.
| ︙ | ︙ | |||
222 223 224 225 226 227 228 | */ static int AliasDelete(Tcl_Interp *interp, Tcl_Interp *childInterp, Tcl_Obj *namePtr); static int AliasDescribe(Tcl_Interp *interp, Tcl_Interp *childInterp, Tcl_Obj *objPtr); static int AliasList(Tcl_Interp *interp, Tcl_Interp *childInterp); | | | 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 | */ static int AliasDelete(Tcl_Interp *interp, Tcl_Interp *childInterp, Tcl_Obj *namePtr); static int AliasDescribe(Tcl_Interp *interp, Tcl_Interp *childInterp, Tcl_Obj *objPtr); static int AliasList(Tcl_Interp *interp, Tcl_Interp *childInterp); static Tcl_ObjCmdProc2 AliasNRCmd; static Tcl_CmdDeleteProc AliasObjCmdDeleteProc; static Tcl_Interp * GetInterp(Tcl_Interp *interp, Tcl_Obj *pathPtr); static Tcl_Interp * GetInterp2(Tcl_Interp *interp, Tcl_Size objc, Tcl_Obj *const objv[]); static Tcl_InterpDeleteProc InterpInfoDeleteProc; static int ChildBgerror(Tcl_Interp *interp, Tcl_Interp *childInterp, Tcl_Size objc, |
| ︙ | ︙ | |||
278 279 280 281 282 283 284 | static void MakeSafe(Tcl_Interp *interp); static void RunLimitHandlers(LimitHandler *handlerPtr, Tcl_Interp *interp); static void TimeLimitCallback(void *clientData); /* NRE enabling */ static Tcl_NRPostProc NRPostInvokeHidden; | | | | 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 | static void MakeSafe(Tcl_Interp *interp); static void RunLimitHandlers(LimitHandler *handlerPtr, Tcl_Interp *interp); static void TimeLimitCallback(void *clientData); /* NRE enabling */ static Tcl_NRPostProc NRPostInvokeHidden; static Tcl_ObjCmdProc2 NRInterpCmd; static Tcl_ObjCmdProc2 NRChildCmd; /* *---------------------------------------------------------------------- * * Tcl_SetPreInitScript -- * * This routine is used to change the value of the internal variable, |
| ︙ | ︙ | |||
510 511 512 513 514 515 516 |
childPtr = &interpInfoPtr->child;
childPtr->parentInterp = NULL;
childPtr->childEntryPtr = NULL;
childPtr->childInterp = interp;
childPtr->interpCmd = NULL;
Tcl_InitHashTable(&childPtr->aliasTable, TCL_STRING_KEYS);
| | | 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 |
childPtr = &interpInfoPtr->child;
childPtr->parentInterp = NULL;
childPtr->childEntryPtr = NULL;
childPtr->childInterp = interp;
childPtr->interpCmd = NULL;
Tcl_InitHashTable(&childPtr->aliasTable, TCL_STRING_KEYS);
Tcl_NRCreateCommand2(interp, "interp", Tcl_InterpObjCmd, NRInterpCmd,
NULL, NULL);
Tcl_CallWhenDeleted(interp, InterpInfoDeleteProc, NULL);
return TCL_OK;
}
/*
|
| ︙ | ︙ | |||
616 617 618 619 620 621 622 |
*----------------------------------------------------------------------
*/
int
Tcl_InterpObjCmd(
void *clientData,
Tcl_Interp *interp, /* Current interpreter. */
| | | | | 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 |
*----------------------------------------------------------------------
*/
int
Tcl_InterpObjCmd(
void *clientData,
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
return Tcl_NRCallObjProc2(interp, NRInterpCmd, clientData, objc, objv);
}
static int
NRInterpCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_Interp *childInterp;
static const char *const options[] = {
"alias", "aliases", "bgerror", "cancel",
"children", "create", "debug", "delete",
"eval", "exists", "expose", "hide",
|
| ︙ | ︙ | |||
1394 1395 1396 1397 1398 1399 1400 |
Command *aliasCmdPtr;
/*
* If we are not creating or renaming an alias, then it is always OK to
* create or rename the command.
*/
| | | | | 1394 1395 1396 1397 1398 1399 1400 1401 1402 1403 1404 1405 1406 1407 1408 1409 1410 1411 1412 1413 1414 1415 1416 1417 1418 1419 |
Command *aliasCmdPtr;
/*
* If we are not creating or renaming an alias, then it is always OK to
* create or rename the command.
*/
if (cmdPtr->objProc2 != TclAliasObjCmd
&& cmdPtr->objProc2 != TclLocalAliasObjCmd) {
return TCL_OK;
}
/*
* OK, we are dealing with an alias, so traverse the chain of aliases. If
* we encounter the alias we are defining (or renaming to) any in the
* chain then we have a loop.
*/
aliasPtr = (Alias *)cmdPtr->objClientData2;
nextAliasPtr = aliasPtr;
while (1) {
Tcl_Obj *cmdNamePtr;
/*
* If the target of the next alias in the chain is the same as the
* source alias, we have a loop.
|
| ︙ | ︙ | |||
1450 1451 1452 1453 1454 1455 1456 | /* * Otherwise, follow the chain one step further. See if the target * command is an alias - if so, follow the loop to its target command. * Otherwise we do not have a loop. */ | | | | | 1450 1451 1452 1453 1454 1455 1456 1457 1458 1459 1460 1461 1462 1463 1464 1465 1466 1467 1468 |
/*
* Otherwise, follow the chain one step further. See if the target
* command is an alias - if so, follow the loop to its target command.
* Otherwise we do not have a loop.
*/
if (aliasCmdPtr->objProc2 != TclAliasObjCmd
&& aliasCmdPtr->objProc2 != TclLocalAliasObjCmd) {
return TCL_OK;
}
nextAliasPtr = (Alias *)aliasCmdPtr->objClientData2;
}
}
/*
*----------------------------------------------------------------------
*
* TclAliasCreate --
|
| ︙ | ︙ | |||
1515 1516 1517 1518 1519 1520 1521 |
Tcl_IncrRefCount(objv[i]);
}
Tcl_Preserve(childInterp);
Tcl_Preserve(parentInterp);
if (childInterp == parentInterp) {
| | | | 1515 1516 1517 1518 1519 1520 1521 1522 1523 1524 1525 1526 1527 1528 1529 1530 1531 1532 1533 |
Tcl_IncrRefCount(objv[i]);
}
Tcl_Preserve(childInterp);
Tcl_Preserve(parentInterp);
if (childInterp == parentInterp) {
aliasPtr->childCmd = Tcl_NRCreateCommand2(childInterp,
TclGetString(namePtr), TclLocalAliasObjCmd, AliasNRCmd,
aliasPtr, AliasObjCmdDeleteProc);
} else {
aliasPtr->childCmd = Tcl_CreateObjCommand2(childInterp,
TclGetString(namePtr), TclAliasObjCmd, aliasPtr,
AliasObjCmdDeleteProc);
}
if (TclPreventAliasLoop(interp, childInterp,
aliasPtr->childCmd) != TCL_OK) {
/*
|
| ︙ | ︙ | |||
1786 1787 1788 1789 1790 1791 1792 |
*----------------------------------------------------------------------
*/
static int
AliasNRCmd(
void *clientData, /* Alias record. */
Tcl_Interp *interp, /* Current interpreter. */
| | | 1786 1787 1788 1789 1790 1791 1792 1793 1794 1795 1796 1797 1798 1799 1800 |
*----------------------------------------------------------------------
*/
static int
AliasNRCmd(
void *clientData, /* Alias record. */
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument vector. */
{
Alias *aliasPtr = (Alias *) clientData;
Tcl_Size prefc, cmdc, i;
Tcl_Obj **prefv, **cmdv;
Tcl_Obj *listPtr;
ListRep listRep;
|
| ︙ | ︙ | |||
1839 1840 1841 1842 1843 1844 1845 |
return Tcl_NREvalObj(interp, listPtr, flags);
}
int
TclAliasObjCmd(
void *clientData, /* Alias record. */
Tcl_Interp *interp, /* Current interpreter. */
| | | 1839 1840 1841 1842 1843 1844 1845 1846 1847 1848 1849 1850 1851 1852 1853 |
return Tcl_NREvalObj(interp, listPtr, flags);
}
int
TclAliasObjCmd(
void *clientData, /* Alias record. */
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument vector. */
{
#define ALIAS_CMDV_PREALLOC 10
Alias *aliasPtr = (Alias *) clientData;
Tcl_Interp *targetInterp = aliasPtr->targetInterp;
int result;
Tcl_Size prefc, cmdc, i;
|
| ︙ | ︙ | |||
1930 1931 1932 1933 1934 1935 1936 |
#undef ALIAS_CMDV_PREALLOC
}
int
TclLocalAliasObjCmd(
void *clientData, /* Alias record. */
Tcl_Interp *interp, /* Current interpreter. */
| | | 1930 1931 1932 1933 1934 1935 1936 1937 1938 1939 1940 1941 1942 1943 1944 |
#undef ALIAS_CMDV_PREALLOC
}
int
TclLocalAliasObjCmd(
void *clientData, /* Alias record. */
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument vector. */
{
#define ALIAS_CMDV_PREALLOC 10
Alias *aliasPtr = (Alias *) clientData;
int result;
Tcl_Size prefc, cmdc, i;
Tcl_Obj **prefv, **cmdv;
|
| ︙ | ︙ | |||
2431 2432 2433 2434 2435 2436 2437 |
}
childInterp = Tcl_CreateInterp();
childPtr = &INTERP_INFO(childInterp)->child;
childPtr->parentInterp = parentInterp;
childPtr->childEntryPtr = hPtr;
childPtr->childInterp = childInterp;
| | | 2431 2432 2433 2434 2435 2436 2437 2438 2439 2440 2441 2442 2443 2444 2445 |
}
childInterp = Tcl_CreateInterp();
childPtr = &INTERP_INFO(childInterp)->child;
childPtr->parentInterp = parentInterp;
childPtr->childEntryPtr = hPtr;
childPtr->childInterp = childInterp;
childPtr->interpCmd = Tcl_NRCreateCommand2(parentInterp, path,
TclChildObjCmd, NRChildCmd, childInterp, ChildObjCmdDeleteProc);
Tcl_InitHashTable(&childPtr->aliasTable, TCL_STRING_KEYS);
Tcl_SetHashValue(hPtr, childPtr);
Tcl_SetVar2(childInterp, "tcl_interactive", NULL, "0", TCL_GLOBAL_ONLY);
/*
* Inherit the recursion limit.
|
| ︙ | ︙ | |||
2516 2517 2518 2519 2520 2521 2522 |
*----------------------------------------------------------------------
*/
int
TclChildObjCmd(
void *clientData, /* Child interpreter. */
Tcl_Interp *interp, /* Current interpreter. */
| | | | | 2516 2517 2518 2519 2520 2521 2522 2523 2524 2525 2526 2527 2528 2529 2530 2531 2532 2533 2534 2535 2536 2537 2538 2539 2540 |
*----------------------------------------------------------------------
*/
int
TclChildObjCmd(
void *clientData, /* Child interpreter. */
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
return Tcl_NRCallObjProc2(interp, NRChildCmd, clientData, objc, objv);
}
static int
NRChildCmd(
void *clientData, /* Child interpreter. */
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_Interp *childInterp = (Tcl_Interp *) clientData;
static const char *const options[] = {
"alias", "aliases", "bgerror", "debug",
"eval", "expose", "hide", "hidden",
"issafe", "invokehidden", "limit", "marktrusted",
|
| ︙ | ︙ | |||
2880 2881 2882 2883 2884 2885 2886 |
if (objc == 1) {
/*
* TIP #280: Make actual argument location available to eval'd script.
*/
Interp *iPtr = (Interp *) interp;
CmdFrame *invoker = iPtr->cmdFramePtr;
| | | 2880 2881 2882 2883 2884 2885 2886 2887 2888 2889 2890 2891 2892 2893 2894 |
if (objc == 1) {
/*
* TIP #280: Make actual argument location available to eval'd script.
*/
Interp *iPtr = (Interp *) interp;
CmdFrame *invoker = iPtr->cmdFramePtr;
Tcl_Size word = 0;
TclArgumentGet(interp, objv[0], &invoker, &word);
result = TclEvalObjEx(childInterp, objv[0], 0, invoker, word);
} else {
Tcl_Obj *objPtr = Tcl_ConcatObj(objc, objv);
Tcl_IncrRefCount(objPtr);
|
| ︙ | ︙ |
Changes to generic/tclLoad.c.
| ︙ | ︙ | |||
126 127 128 129 130 131 132 |
*----------------------------------------------------------------------
*/
int
Tcl_LoadObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 |
*----------------------------------------------------------------------
*/
int
Tcl_LoadObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_Interp *target;
LoadedLibrary *libraryPtr, *defaultPtr;
Tcl_DString pfx, tmp, initName, safeInitName;
Tcl_DString unloadName, safeUnloadName;
InterpLibrary *ipFirstPtr, *ipPtr;
|
| ︙ | ︙ | |||
554 555 556 557 558 559 560 |
*----------------------------------------------------------------------
*/
int
Tcl_UnloadObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | > | | 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 |
*----------------------------------------------------------------------
*/
int
Tcl_UnloadObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_Interp *target; /* Which interpreter to unload from. */
LoadedLibrary *libraryPtr;
Tcl_DString pfx, tmp;
InterpLibrary *ipFirstPtr, *ipPtr;
Tcl_Size i;
int code, complain = 1, keepLibrary = 0;
const char *fullFileName = "";
const char *prefix;
static const char *const options[] = {
"-nocomplain", "-keeplibrary", "--", NULL
};
enum unloadOptionsEnum {
UNLOAD_NOCOMPLAIN, UNLOAD_KEEPLIB, UNLOAD_LAST
|
| ︙ | ︙ |
Changes to generic/tclMutexTest.c.
| ︙ | ︙ | |||
143 144 145 146 147 148 149 |
*----------------------------------------------------------------------
*/
static int
TestMutexObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 |
*----------------------------------------------------------------------
*/
static int
TestMutexObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
static const char *const mutexOptions[] = {
"lock", "condition", NULL
};
enum options {
LOCK, CONDITION
|
| ︙ | ︙ | |||
555 556 557 558 559 560 561 |
*----------------------------------------------------------------------
*/
int
TclMutex_Init(
Tcl_Interp *interp) /* The current Tcl interpreter */
{
| | | 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 |
*----------------------------------------------------------------------
*/
int
TclMutex_Init(
Tcl_Interp *interp) /* The current Tcl interpreter */
{
Tcl_CreateObjCommand2(interp, "testmutex", TestMutexObjCmd, NULL, NULL);
return TCL_OK;
}
#endif /* TCL_THREADS */
/*
* Local Variables:
* mode: c
* c-basic-offset: 4
* fill-column: 78
* End:
*/
|
Changes to generic/tclNamesp.c.
| ︙ | ︙ | |||
87 88 89 90 91 92 93 | static char * EstablishErrorInfoTraces(void *clientData, Tcl_Interp *interp, const char *name1, const char *name2, int flags); static void FreeNsNameInternalRep(Tcl_Obj *objPtr); static int GetNamespaceFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Namespace **nsPtrPtr); static int InvokeImportedNRCmd(void *clientData, | | | | | | | | | | | | | | | | | | | | | | | 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 122 123 | static char * EstablishErrorInfoTraces(void *clientData, Tcl_Interp *interp, const char *name1, const char *name2, int flags); static void FreeNsNameInternalRep(Tcl_Obj *objPtr); static int GetNamespaceFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Namespace **nsPtrPtr); static int InvokeImportedNRCmd(void *clientData, Tcl_Interp *interp, Tcl_Size objc, Tcl_Obj *const objv[]); static Tcl_ObjCmdProc2 NamespaceChildrenCmd; static Tcl_ObjCmdProc2 NamespaceCodeCmd; static Tcl_ObjCmdProc2 NamespaceCurrentCmd; static Tcl_ObjCmdProc2 NamespaceDeleteCmd; static Tcl_ObjCmdProc2 NamespaceEvalCmd; static Tcl_ObjCmdProc2 NRNamespaceEvalCmd; static Tcl_ObjCmdProc2 NamespaceExistsCmd; static Tcl_ObjCmdProc2 NamespaceExportCmd; static Tcl_ObjCmdProc2 NamespaceForgetCmd; static void NamespaceFree(Namespace *nsPtr); static Tcl_ObjCmdProc2 NamespaceImportCmd; static Tcl_ObjCmdProc2 NamespaceInscopeCmd; static Tcl_ObjCmdProc2 NRNamespaceInscopeCmd; static Tcl_ObjCmdProc2 NamespaceOriginCmd; static Tcl_ObjCmdProc2 NamespaceParentCmd; static Tcl_ObjCmdProc2 NamespacePathCmd; static Tcl_ObjCmdProc2 NamespaceQualifiersCmd; static Tcl_ObjCmdProc2 NamespaceTailCmd; static Tcl_ObjCmdProc2 NamespaceUpvarCmd; static Tcl_ObjCmdProc2 NamespaceUnknownCmd; static Tcl_ObjCmdProc2 NamespaceWhichCmd; static int SetNsNameFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr); static void UnlinkNsPath(Namespace *nsPtr); static Tcl_NRPostProc NsEval_Callback; /* * This structure defines a Tcl object type that contains a namespace |
| ︙ | ︙ | |||
1052 1053 1054 1055 1056 1057 1058 |
* NOTE: we could avoid traversing the ns's command list by keeping a
* separate list of coros.
*/
for (entryPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search);
entryPtr != NULL;) {
cmdPtr = (Command *) Tcl_GetHashValue(entryPtr);
| | | 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 |
* NOTE: we could avoid traversing the ns's command list by keeping a
* separate list of coros.
*/
for (entryPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search);
entryPtr != NULL;) {
cmdPtr = (Command *) Tcl_GetHashValue(entryPtr);
if (cmdPtr->nreProc2 == TclNRInterpCoroutine) {
Tcl_DeleteCommandFromToken(interp, (Tcl_Command) cmdPtr);
entryPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search);
} else {
entryPtr = Tcl_NextHashEntry(&search);
}
}
|
| ︙ | ︙ | |||
1846 1847 1848 1849 1850 1851 1852 |
cmdPtr = (Command *) Tcl_GetHashValue(hPtr);
if (found != NULL && cmdPtr->deleteProc == DeleteImportedCmd) {
Command *overwrite = (Command *) Tcl_GetHashValue(found);
Command *linkCmd = cmdPtr;
while (linkCmd->deleteProc == DeleteImportedCmd) {
| | | | 1846 1847 1848 1849 1850 1851 1852 1853 1854 1855 1856 1857 1858 1859 1860 1861 1862 1863 1864 1865 1866 1867 1868 1869 1870 1871 1872 1873 1874 1875 |
cmdPtr = (Command *) Tcl_GetHashValue(hPtr);
if (found != NULL && cmdPtr->deleteProc == DeleteImportedCmd) {
Command *overwrite = (Command *) Tcl_GetHashValue(found);
Command *linkCmd = cmdPtr;
while (linkCmd->deleteProc == DeleteImportedCmd) {
dataPtr = (ImportedCmdData *)linkCmd->objClientData2;
linkCmd = dataPtr->realCmdPtr;
if (overwrite == linkCmd) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"import pattern \"%s\" would create a loop"
" containing command \"%s\"",
pattern, Tcl_DStringValue(&ds)));
Tcl_DStringFree(&ds);
Tcl_SetErrorCode(interp, "TCL", "IMPORT", "LOOP", (char *)NULL);
return TCL_ERROR;
}
}
}
dataPtr = (ImportedCmdData *) Tcl_Alloc(sizeof(ImportedCmdData));
importedCmd = Tcl_NRCreateCommand2(interp, Tcl_DStringValue(&ds),
TclInvokeImportedCmd, InvokeImportedNRCmd, dataPtr,
DeleteImportedCmd);
dataPtr->realCmdPtr = cmdPtr;
/* corresponding decrement is in DeleteImportedCmd */
cmdPtr->refCount++;
dataPtr->selfPtr = (Command *) importedCmd;
dataPtr->selfPtr->compileProc = cmdPtr->compileProc;
|
| ︙ | ︙ | |||
1884 1885 1886 1887 1888 1889 1890 |
refPtr->importedCmdPtr = (Command *) importedCmd;
refPtr->nextPtr = cmdPtr->importRefPtr;
cmdPtr->importRefPtr = refPtr;
} else {
Command *overwrite = (Command *) Tcl_GetHashValue(found);
if (overwrite->deleteProc == DeleteImportedCmd) {
| | < | 1884 1885 1886 1887 1888 1889 1890 1891 1892 1893 1894 1895 1896 1897 1898 |
refPtr->importedCmdPtr = (Command *) importedCmd;
refPtr->nextPtr = cmdPtr->importRefPtr;
cmdPtr->importRefPtr = refPtr;
} else {
Command *overwrite = (Command *) Tcl_GetHashValue(found);
if (overwrite->deleteProc == DeleteImportedCmd) {
ImportedCmdData *dataPtr = (ImportedCmdData *)overwrite->objClientData2;
if (dataPtr->realCmdPtr == Tcl_GetHashValue(hPtr)) {
/*
* Repeated import of same command is acceptable.
*/
return TCL_OK;
|
| ︙ | ︙ | |||
2022 2023 2024 2025 2026 2027 2028 |
if (info.namespacePtr != (Tcl_Namespace *) sourceNsPtr) {
/*
* Original not in namespace we're matching. Check the first link
* in the import chain.
*/
Command *cmdPtr = (Command *) token;
| | | 2021 2022 2023 2024 2025 2026 2027 2028 2029 2030 2031 2032 2033 2034 2035 |
if (info.namespacePtr != (Tcl_Namespace *) sourceNsPtr) {
/*
* Original not in namespace we're matching. Check the first link
* in the import chain.
*/
Command *cmdPtr = (Command *) token;
ImportedCmdData *dataPtr = (ImportedCmdData *)cmdPtr->objClientData2;
Tcl_Command firstToken = (Tcl_Command) dataPtr->realCmdPtr;
if (firstToken == origin) {
continue;
}
Tcl_GetCommandInfoFromToken(firstToken, &info);
if (info.namespacePtr != (Tcl_Namespace *) sourceNsPtr) {
|
| ︙ | ︙ | |||
2076 2077 2078 2079 2080 2081 2082 |
Command *cmdPtr = (Command *) command;
if (cmdPtr->deleteProc != DeleteImportedCmd) {
return NULL;
}
while (cmdPtr->deleteProc == DeleteImportedCmd) {
| | | 2075 2076 2077 2078 2079 2080 2081 2082 2083 2084 2085 2086 2087 2088 2089 |
Command *cmdPtr = (Command *) command;
if (cmdPtr->deleteProc != DeleteImportedCmd) {
return NULL;
}
while (cmdPtr->deleteProc == DeleteImportedCmd) {
ImportedCmdData *dataPtr = (ImportedCmdData *) cmdPtr->objClientData2;
cmdPtr = dataPtr->realCmdPtr;
}
return (Tcl_Command) cmdPtr;
}
/*
*----------------------------------------------------------------------
|
| ︙ | ︙ | |||
2106 2107 2108 2109 2110 2111 2112 |
*/
static int
InvokeImportedNRCmd(
void *clientData, /* Points to the imported command's
* ImportedCmdData structure. */
Tcl_Interp *interp, /* Current interpreter. */
| | | | | 2105 2106 2107 2108 2109 2110 2111 2112 2113 2114 2115 2116 2117 2118 2119 2120 2121 2122 2123 2124 2125 2126 2127 2128 2129 2130 2131 2132 2133 2134 2135 2136 2137 |
*/
static int
InvokeImportedNRCmd(
void *clientData, /* Points to the imported command's
* ImportedCmdData structure. */
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* The argument objects. */
{
ImportedCmdData *dataPtr = (ImportedCmdData *) clientData;
Command *realCmdPtr = dataPtr->realCmdPtr;
TclSkipTailcall(interp);
return TclNREvalObjv(interp, objc, objv, TCL_EVAL_NOERR, realCmdPtr);
}
int
TclInvokeImportedCmd(
void *clientData, /* Points to the imported command's
* ImportedCmdData structure. */
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* The argument objects. */
{
return Tcl_NRCallObjProc2(interp, InvokeImportedNRCmd, clientData,
objc, objv);
}
/*
*----------------------------------------------------------------------
*
* DeleteImportedCmd --
|
| ︙ | ︙ | |||
3101 3102 3103 3104 3105 3106 3107 |
*----------------------------------------------------------------------
*/
static int
NamespaceChildrenCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 3100 3101 3102 3103 3104 3105 3106 3107 3108 3109 3110 3111 3112 3113 3114 |
*----------------------------------------------------------------------
*/
static int
NamespaceChildrenCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_Namespace *namespacePtr;
Namespace *nsPtr, *childNsPtr;
Namespace *globalNsPtr = (Namespace *) TclGetGlobalNamespace(interp);
const char *pattern = NULL;
Tcl_DString buffer;
|
| ︙ | ︙ | |||
3219 3220 3221 3222 3223 3224 3225 |
*----------------------------------------------------------------------
*/
static int
NamespaceCodeCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 3218 3219 3220 3221 3222 3223 3224 3225 3226 3227 3228 3229 3230 3231 3232 |
*----------------------------------------------------------------------
*/
static int
NamespaceCodeCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_Obj *listPtr, *objPtr;
const char *arg;
Tcl_Size length;
if (objc != 2) {
|
| ︙ | ︙ | |||
3294 3295 3296 3297 3298 3299 3300 |
*----------------------------------------------------------------------
*/
static int
NamespaceCurrentCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 3293 3294 3295 3296 3297 3298 3299 3300 3301 3302 3303 3304 3305 3306 3307 |
*----------------------------------------------------------------------
*/
static int
NamespaceCurrentCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
if (objc != 1) {
Tcl_WrongNumArgs(interp, 1, objv, NULL);
return TCL_ERROR;
}
|
| ︙ | ︙ | |||
3353 3354 3355 3356 3357 3358 3359 |
*----------------------------------------------------------------------
*/
static int
NamespaceDeleteCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | | 3352 3353 3354 3355 3356 3357 3358 3359 3360 3361 3362 3363 3364 3365 3366 3367 3368 3369 3370 3371 |
*----------------------------------------------------------------------
*/
static int
NamespaceDeleteCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_Namespace *namespacePtr;
const char *name;
Tcl_Size i;
if (objc < 1) {
Tcl_WrongNumArgs(interp, 1, objv, "?name name...?");
return TCL_ERROR;
}
/*
|
| ︙ | ︙ | |||
3430 3431 3432 3433 3434 3435 3436 |
*----------------------------------------------------------------------
*/
static int
NamespaceEvalCmd(
void *clientData, /* Arbitrary value passed to cmd. */
Tcl_Interp *interp, /* Current interpreter. */
| | | | | | 3429 3430 3431 3432 3433 3434 3435 3436 3437 3438 3439 3440 3441 3442 3443 3444 3445 3446 3447 3448 3449 3450 3451 3452 3453 3454 3455 3456 3457 3458 3459 |
*----------------------------------------------------------------------
*/
static int
NamespaceEvalCmd(
void *clientData, /* Arbitrary value passed to cmd. */
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
return Tcl_NRCallObjProc2(interp, NRNamespaceEvalCmd, clientData, objc,
objv);
}
static int
NRNamespaceEvalCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Interp *iPtr = (Interp *) interp;
CmdFrame *invoker;
Tcl_Size word;
Tcl_Namespace *namespacePtr;
CallFrame *framePtr, **framePtrPtr;
Tcl_Obj *objPtr;
int result;
if (objc < 3) {
Tcl_WrongNumArgs(interp, 1, objv, "name arg ?arg...?");
|
| ︙ | ︙ | |||
3573 3574 3575 3576 3577 3578 3579 |
*----------------------------------------------------------------------
*/
static int
NamespaceExistsCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 3572 3573 3574 3575 3576 3577 3578 3579 3580 3581 3582 3583 3584 3585 3586 |
*----------------------------------------------------------------------
*/
static int
NamespaceExistsCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_Namespace *namespacePtr;
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "name");
return TCL_ERROR;
|
| ︙ | ︙ | |||
3628 3629 3630 3631 3632 3633 3634 |
*----------------------------------------------------------------------
*/
static int
NamespaceExportCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | | 3627 3628 3629 3630 3631 3632 3633 3634 3635 3636 3637 3638 3639 3640 3641 3642 3643 3644 |
*----------------------------------------------------------------------
*/
static int
NamespaceExportCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_Size firstArg, i;
if (objc < 1) {
Tcl_WrongNumArgs(interp, 1, objv, "?-clear? ?pattern pattern...?");
return TCL_ERROR;
}
/*
|
| ︙ | ︙ | |||
3710 3711 3712 3713 3714 3715 3716 |
*----------------------------------------------------------------------
*/
static int
NamespaceForgetCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | | 3709 3710 3711 3712 3713 3714 3715 3716 3717 3718 3719 3720 3721 3722 3723 3724 3725 3726 3727 |
*----------------------------------------------------------------------
*/
static int
NamespaceForgetCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
const char *pattern;
Tcl_Size i;
int result;
if (objc < 1) {
Tcl_WrongNumArgs(interp, 1, objv, "?pattern pattern...?");
return TCL_ERROR;
}
|
| ︙ | ︙ | |||
3776 3777 3778 3779 3780 3781 3782 |
*----------------------------------------------------------------------
*/
static int
NamespaceImportCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | | 3775 3776 3777 3778 3779 3780 3781 3782 3783 3784 3785 3786 3787 3788 3789 3790 3791 3792 3793 3794 |
*----------------------------------------------------------------------
*/
static int
NamespaceImportCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
bool allowOverwrite = false;
const char *string, *pattern;
Tcl_Size i, firstArg;
int result;
if (objc < 1) {
Tcl_WrongNumArgs(interp, 1, objv, "?-force? ?pattern pattern...?");
return TCL_ERROR;
}
|
| ︙ | ︙ | |||
3880 3881 3882 3883 3884 3885 3886 |
*----------------------------------------------------------------------
*/
static int
NamespaceInscopeCmd(
void *clientData, /* Arbitrary value passed to cmd. */
Tcl_Interp *interp, /* Current interpreter. */
| | | | | 3879 3880 3881 3882 3883 3884 3885 3886 3887 3888 3889 3890 3891 3892 3893 3894 3895 3896 3897 3898 3899 3900 3901 3902 3903 3904 |
*----------------------------------------------------------------------
*/
static int
NamespaceInscopeCmd(
void *clientData, /* Arbitrary value passed to cmd. */
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
return Tcl_NRCallObjProc2(interp, NRNamespaceInscopeCmd, clientData, objc,
objv);
}
static int
NRNamespaceInscopeCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_Namespace *namespacePtr;
CallFrame *framePtr, **framePtrPtr;
Tcl_Obj *cmdObjPtr;
if (objc < 3) {
|
| ︙ | ︙ | |||
3978 3979 3980 3981 3982 3983 3984 |
*----------------------------------------------------------------------
*/
static int
NamespaceOriginCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 3977 3978 3979 3980 3981 3982 3983 3984 3985 3986 3987 3988 3989 3990 3991 |
*----------------------------------------------------------------------
*/
static int
NamespaceOriginCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_Command cmd, origCmd;
Tcl_Obj *resultPtr;
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "name");
|
| ︙ | ︙ | |||
4039 4040 4041 4042 4043 4044 4045 |
*----------------------------------------------------------------------
*/
static int
NamespaceParentCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 4038 4039 4040 4041 4042 4043 4044 4045 4046 4047 4048 4049 4050 4051 4052 |
*----------------------------------------------------------------------
*/
static int
NamespaceParentCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_Namespace *nsPtr;
if (objc == 1) {
nsPtr = TclGetCurrentNamespace(interp);
} else if (objc == 2) {
|
| ︙ | ︙ | |||
4096 4097 4098 4099 4100 4101 4102 |
*----------------------------------------------------------------------
*/
static int
NamespacePathCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 4095 4096 4097 4098 4099 4100 4101 4102 4103 4104 4105 4106 4107 4108 4109 |
*----------------------------------------------------------------------
*/
static int
NamespacePathCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Namespace *nsPtr = (Namespace *) TclGetCurrentNamespace(interp);
Tcl_Size nsObjc, i;
int result = TCL_ERROR;
Tcl_Obj **nsObjv;
Tcl_Namespace **namespaceList = NULL;
|
| ︙ | ︙ | |||
4323 4324 4325 4326 4327 4328 4329 |
*----------------------------------------------------------------------
*/
static int
NamespaceQualifiersCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 4322 4323 4324 4325 4326 4327 4328 4329 4330 4331 4332 4333 4334 4335 4336 |
*----------------------------------------------------------------------
*/
static int
NamespaceQualifiersCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
const char *name, *p;
size_t length;
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "string");
|
| ︙ | ︙ | |||
4391 4392 4393 4394 4395 4396 4397 |
*----------------------------------------------------------------------
*/
static int
NamespaceUnknownCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 4390 4391 4392 4393 4394 4395 4396 4397 4398 4399 4400 4401 4402 4403 4404 |
*----------------------------------------------------------------------
*/
static int
NamespaceUnknownCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_Namespace *currNsPtr;
Tcl_Obj *resultPtr;
int rc;
if (objc > 2) {
|
| ︙ | ︙ | |||
4578 4579 4580 4581 4582 4583 4584 |
*----------------------------------------------------------------------
*/
static int
NamespaceTailCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 4577 4578 4579 4580 4581 4582 4583 4584 4585 4586 4587 4588 4589 4590 4591 |
*----------------------------------------------------------------------
*/
static int
NamespaceTailCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
const char *name, *p;
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "string");
return TCL_ERROR;
|
| ︙ | ︙ | |||
4636 4637 4638 4639 4640 4641 4642 |
*----------------------------------------------------------------------
*/
static int
NamespaceUpvarCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 4635 4636 4637 4638 4639 4640 4641 4642 4643 4644 4645 4646 4647 4648 4649 |
*----------------------------------------------------------------------
*/
static int
NamespaceUpvarCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Interp *iPtr = (Interp *) interp;
Tcl_Namespace *nsPtr, *savedNsPtr;
Var *otherPtr, *arrayPtr;
const char *myName;
|
| ︙ | ︙ | |||
4710 4711 4712 4713 4714 4715 4716 |
*----------------------------------------------------------------------
*/
static int
NamespaceWhichCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 4709 4710 4711 4712 4713 4714 4715 4716 4717 4718 4719 4720 4721 4722 4723 |
*----------------------------------------------------------------------
*/
static int
NamespaceWhichCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
static const char *const opts[] = {
"-command", "-variable", NULL
};
enum { OPT_COMMAND, OPT_VARIABLE } lookupType = OPT_COMMAND;
Tcl_Obj *resultPtr;
|
| ︙ | ︙ |
Changes to generic/tclOO.c.
| ︙ | ︙ | |||
18 19 20 21 22 23 24 |
/*
* Commands in oo and oo::Helpers.
*/
static const struct StdCommands {
const char *name;
| | | | 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 |
/*
* Commands in oo and oo::Helpers.
*/
static const struct StdCommands {
const char *name;
Tcl_ObjCmdProc2 *objProc;
Tcl_ObjCmdProc2 *nreProc;
CompileProc *compileProc;
int flags;
} ooCmds[] = {
{"define", TclOODefineObjCmd, NULL, NULL, 0},
{"objdefine", TclOOObjDefObjCmd, NULL, NULL, 0},
{"copy", TclOOCopyObjectCmd, NULL, NULL, 0},
{"DelegateName", TclOODelegateNameObjCmd, NULL, NULL, 0},
|
| ︙ | ︙ | |||
45 46 47 48 49 50 51 |
/*
* Commands in oo::define and oo::objdefine.
*/
static const struct DefineCommands {
const char *name;
| | | 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 |
/*
* Commands in oo::define and oo::objdefine.
*/
static const struct DefineCommands {
const char *name;
Tcl_ObjCmdProc2 *objProc;
int flag;
} defineCmds[] = {
{"classmethod", TclOODefineClassMethodObjCmd, 0},
{"constructor", TclOODefineConstructorObjCmd, 0},
{"definitionnamespace", TclOODefineDefnNsObjCmd, 0},
{"deletemethod", TclOODefineDeleteMethodObjCmd, 0},
{"destructor", TclOODefineDestructorObjCmd, 0},
|
| ︙ | ︙ | |||
112 113 114 115 116 117 118 | static Tcl_CmdDeleteProc MyDeleted; static Tcl_NamespaceDeleteProc ObjectNamespaceDeleted; static Tcl_CommandTraceProc ObjectRenamedTrace; static inline void RemoveClass(Class **list, size_t num, size_t idx); static inline void RemoveObject(Object **list, size_t num, size_t idx); static inline void SquelchCachedName(Object *oPtr); | | | | | | 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 |
static Tcl_CmdDeleteProc MyDeleted;
static Tcl_NamespaceDeleteProc ObjectNamespaceDeleted;
static Tcl_CommandTraceProc ObjectRenamedTrace;
static inline void RemoveClass(Class **list, size_t num, size_t idx);
static inline void RemoveObject(Object **list, size_t num, size_t idx);
static inline void SquelchCachedName(Object *oPtr);
static Tcl_ObjCmdProc2 PublicNRObjectCmd;
static Tcl_ObjCmdProc2 PrivateNRObjectCmd;
static Tcl_ObjCmdProc2 MyClassNRObjCmd;
static Tcl_CmdDeleteProc MyClassDeleted;
/*
* Methods in the oo::object and oo::class classes. First, we define a helper
* macro that makes building the method type declaration structure a lot
* easier. No point in making life harder than it has to be!
*
* Note that the core methods don't need clone or free proc callbacks.
*/
#define DCM(name,visibility,proc) \
{name,visibility,\
{TCL_OO_METHOD_VERSION_2,"core method: "#name,proc,NULL,NULL}}
static const DeclaredClassMethod objMethods[] = {
DCM("<cloned>", 0, TclOO_Object_Cloned),
DCM("destroy", 1, TclOO_Object_Destroy),
DCM("eval", 0, TclOO_Object_Eval),
DCM("unknown", 0, TclOO_Object_Unknown),
DCM("variable", 0, TclOO_Object_LinkVar),
|
| ︙ | ︙ | |||
159 160 161 162 163 164 165 |
{NULL, 0, {0, NULL, NULL, NULL, NULL}}
};
/*
* And for the oo::class constructor...
*/
| | | | | | 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 |
{NULL, 0, {0, NULL, NULL, NULL, NULL}}
};
/*
* And for the oo::class constructor...
*/
static const Tcl_MethodType2 classConstructor = {
TCL_OO_METHOD_VERSION_2,
"oo::class constructor",
TclOO_Class_Constructor, NULL, NULL
};
/*
* And the oo::configurable constructor...
*/
static const Tcl_MethodType2 configurableConstructor = {
TCL_OO_METHOD_VERSION_2,
"oo::configurable constructor",
TclOO_Configurable_Constructor, NULL, NULL
};
/*
* The scripted part of TclOO: (legacy) package registration. There's no C API
* at all for doing this, not even internally to Tcl.
|
| ︙ | ︙ | |||
335 336 337 338 339 340 341 |
* ----------------------------------------------------------------------
*/
static inline void
CreateCmdInNS(
Tcl_Interp *interp,
Tcl_Namespace *namespacePtr,
const char *name,
| | | | | 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 |
* ----------------------------------------------------------------------
*/
static inline void
CreateCmdInNS(
Tcl_Interp *interp,
Tcl_Namespace *namespacePtr,
const char *name,
Tcl_ObjCmdProc2 *cmdProc,
Tcl_ObjCmdProc2 *nreProc,
CompileProc *compileProc,
int flags)
{
Command *cmdPtr;
if (cmdProc == NULL && nreProc == NULL) {
Tcl_Panic("must supply at least one implementation function");
}
cmdPtr = (Command *) TclCreateObjCommandInNs(interp, name,
namespacePtr, cmdProc, NULL, NULL);
cmdPtr->nreProc2 = nreProc;
cmdPtr->compileProc = compileProc;
cmdPtr->flags |= flags;
}
/*
* ----------------------------------------------------------------------
*
|
| ︙ | ︙ | |||
980 981 982 983 984 985 986 |
/*
* Add the NRE command and trace directly. While this breaks a number of
* abstractions, it is faster and we're inside Tcl here so we're allowed.
*/
cmdPtr = (Command *) oPtr->command;
| | | 980 981 982 983 984 985 986 987 988 989 990 991 992 993 994 |
/*
* Add the NRE command and trace directly. While this breaks a number of
* abstractions, it is faster and we're inside Tcl here so we're allowed.
*/
cmdPtr = (Command *) oPtr->command;
cmdPtr->nreProc2 = PublicNRObjectCmd;
cmdPtr->tracePtr = tracePtr = (CommandTrace *)
Tcl_Alloc(sizeof(CommandTrace));
tracePtr->traceProc = ObjectRenamedTrace;
tracePtr->clientData = oPtr;
tracePtr->flags = TCL_TRACE_RENAME|TCL_TRACE_DELETE;
tracePtr->nextPtr = NULL;
tracePtr->refCount = 1;
|
| ︙ | ︙ | |||
1433 1434 1435 1436 1437 1438 1439 |
if (contextPtr != NULL) {
int result;
Tcl_InterpState state;
contextPtr->callPtr->flags |= DESTRUCTOR;
contextPtr->skip = 0;
state = Tcl_SaveInterpState(interp, TCL_OK);
| | | 1433 1434 1435 1436 1437 1438 1439 1440 1441 1442 1443 1444 1445 1446 1447 |
if (contextPtr != NULL) {
int result;
Tcl_InterpState state;
contextPtr->callPtr->flags |= DESTRUCTOR;
contextPtr->skip = 0;
state = Tcl_SaveInterpState(interp, TCL_OK);
result = Tcl_NRCallObjProc2(interp, TclOOInvokeContext,
contextPtr, 0, NULL);
if (result != TCL_OK) {
Tcl_BackgroundException(interp, result);
}
Tcl_RestoreInterpState(interp, state);
TclOODeleteContext(contextPtr);
}
|
| ︙ | ︙ | |||
1988 1989 1990 1991 1992 1993 1994 | contextPtr->skip = skip; /* * Adjust the ensemble tracking record if necessary. [Bug 3514761] */ isRoot = TclInitRewriteEnsemble(interp, skip, skip, objv); | | | 1988 1989 1990 1991 1992 1993 1994 1995 1996 1997 1998 1999 2000 2001 2002 |
contextPtr->skip = skip;
/*
* Adjust the ensemble tracking record if necessary. [Bug 3514761]
*/
isRoot = TclInitRewriteEnsemble(interp, skip, skip, objv);
result = Tcl_NRCallObjProc2(interp, TclOOInvokeContext, contextPtr,
objc, objv);
if (isRoot) {
TclResetRewriteEnsemble(interp, 1);
}
clientData[0] = contextPtr;
|
| ︙ | ︙ | |||
2521 2522 2523 2524 2525 2526 2527 |
if (contextPtr) {
args[0] = TclOOObjectName(interp, o2Ptr);
args[1] = oPtr->fPtr->clonedName;
args[2] = TclOOObjectName(interp, oPtr);
Tcl_IncrRefCount(args[0]);
Tcl_IncrRefCount(args[1]);
Tcl_IncrRefCount(args[2]);
| | | 2521 2522 2523 2524 2525 2526 2527 2528 2529 2530 2531 2532 2533 2534 2535 |
if (contextPtr) {
args[0] = TclOOObjectName(interp, o2Ptr);
args[1] = oPtr->fPtr->clonedName;
args[2] = TclOOObjectName(interp, oPtr);
Tcl_IncrRefCount(args[0]);
Tcl_IncrRefCount(args[1]);
Tcl_IncrRefCount(args[2]);
result = Tcl_NRCallObjProc2(interp, TclOOInvokeContext, contextPtr, 3,
args);
TclDecrRefCount(args[0]);
TclDecrRefCount(args[1]);
TclDecrRefCount(args[2]);
TclOODeleteContext(contextPtr);
if (result == TCL_ERROR) {
Tcl_AddErrorInfo(interp,
|
| ︙ | ︙ | |||
2559 2560 2561 2562 2563 2564 2565 |
static int
CloneObjectMethod(
Tcl_Interp *interp,
Object *oPtr,
Method *mPtr,
Tcl_Obj *namePtr)
{
| | | | | | | | | | | | 2559 2560 2561 2562 2563 2564 2565 2566 2567 2568 2569 2570 2571 2572 2573 2574 2575 2576 2577 2578 2579 2580 2581 2582 2583 2584 2585 2586 2587 2588 2589 2590 2591 2592 2593 2594 2595 2596 2597 2598 2599 2600 2601 2602 2603 2604 2605 2606 2607 2608 2609 2610 2611 2612 2613 2614 2615 2616 2617 |
static int
CloneObjectMethod(
Tcl_Interp *interp,
Object *oPtr,
Method *mPtr,
Tcl_Obj *namePtr)
{
if (mPtr->type2Ptr == NULL) {
TclNewInstanceMethod(interp, (Tcl_Object) oPtr, namePtr,
mPtr->flags & PUBLIC_METHOD, NULL, NULL);
} else if (mPtr->type2Ptr->cloneProc) {
void *newClientData;
if (mPtr->type2Ptr->cloneProc(interp, mPtr->clientData,
&newClientData) != TCL_OK) {
return TCL_ERROR;
}
TclNewInstanceMethod(interp, (Tcl_Object) oPtr, namePtr,
mPtr->flags & PUBLIC_METHOD, mPtr->type2Ptr, newClientData);
} else {
TclNewInstanceMethod(interp, (Tcl_Object) oPtr, namePtr,
mPtr->flags & PUBLIC_METHOD, mPtr->type2Ptr, mPtr->clientData);
}
return TCL_OK;
}
static int
CloneClassMethod(
Tcl_Interp *interp,
Class *clsPtr,
Method *mPtr,
Tcl_Obj *namePtr,
Method **m2PtrPtr)
{
Method *m2Ptr;
if (mPtr->type2Ptr == NULL) {
m2Ptr = (Method *) TclNewMethod((Tcl_Class) clsPtr,
namePtr, mPtr->flags & PUBLIC_METHOD, NULL, NULL);
} else if (mPtr->type2Ptr->cloneProc) {
void *newClientData;
if (mPtr->type2Ptr->cloneProc(interp, mPtr->clientData,
&newClientData) != TCL_OK) {
return TCL_ERROR;
}
m2Ptr = (Method *) TclNewMethod((Tcl_Class) clsPtr,
namePtr, mPtr->flags & PUBLIC_METHOD, mPtr->type2Ptr,
newClientData);
} else {
m2Ptr = (Method *) TclNewMethod((Tcl_Class) clsPtr,
namePtr, mPtr->flags & PUBLIC_METHOD, mPtr->type2Ptr,
mPtr->clientData);
}
if (m2PtrPtr != NULL) {
*m2PtrPtr = m2Ptr;
}
return TCL_OK;
}
|
| ︙ | ︙ | |||
2816 2817 2818 2819 2820 2821 2822 |
* ----------------------------------------------------------------------
*/
int
TclOOPublicObjectCmd(
void *clientData,
Tcl_Interp *interp,
| | | | | | | | 2816 2817 2818 2819 2820 2821 2822 2823 2824 2825 2826 2827 2828 2829 2830 2831 2832 2833 2834 2835 2836 2837 2838 2839 2840 2841 2842 2843 2844 2845 2846 2847 2848 2849 2850 2851 2852 2853 2854 2855 2856 2857 2858 2859 2860 2861 |
* ----------------------------------------------------------------------
*/
int
TclOOPublicObjectCmd(
void *clientData,
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const *objv)
{
return Tcl_NRCallObjProc2(interp, PublicNRObjectCmd, clientData, objc, objv);
}
static int
PublicNRObjectCmd(
void *clientData,
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const *objv)
{
return TclOOObjectCmdCore((Object *) clientData, interp, objc, objv,
PUBLIC_METHOD, NULL);
}
int
TclOOPrivateObjectCmd(
void *clientData,
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const *objv)
{
return Tcl_NRCallObjProc2(interp, PrivateNRObjectCmd, clientData, objc, objv);
}
static int
PrivateNRObjectCmd(
void *clientData,
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const *objv)
{
return TclOOObjectCmdCore((Object *) clientData, interp, objc, objv, 0, NULL);
}
int
TclOOInvokeObject(
|
| ︙ | ︙ | |||
2898 2899 2900 2901 2902 2903 2904 |
* ----------------------------------------------------------------------
*/
int
TclOOMyClassObjCmd(
void *clientData,
Tcl_Interp *interp,
| | | | | 2898 2899 2900 2901 2902 2903 2904 2905 2906 2907 2908 2909 2910 2911 2912 2913 2914 2915 2916 2917 2918 2919 2920 2921 2922 |
* ----------------------------------------------------------------------
*/
int
TclOOMyClassObjCmd(
void *clientData,
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const *objv)
{
return Tcl_NRCallObjProc2(interp, MyClassNRObjCmd, clientData, objc, objv);
}
static int
MyClassNRObjCmd(
void *clientData,
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const *objv)
{
Object *oPtr = (Object *) clientData;
if (objc < 2) {
Tcl_WrongNumArgs(interp, 1, objv, "methodName ?arg ...?");
return TCL_ERROR;
|
| ︙ | ︙ | |||
3150 3151 3152 3153 3154 3155 3156 |
contextPtr->index++;
contextPtr->skip = skip;
/*
* Invoke the (advanced) method call context in the caller context.
*/
| | | 3150 3151 3152 3153 3154 3155 3156 3157 3158 3159 3160 3161 3162 3163 3164 |
contextPtr->index++;
contextPtr->skip = skip;
/*
* Invoke the (advanced) method call context in the caller context.
*/
int result = Tcl_NRCallObjProc2(interp, TclOOInvokeContext, contextPtr,
objc, objv);
/*
* Restore the call chain context index as we've finished the inner invoke
* and want to operate in the outer context again.
*/
|
| ︙ | ︙ | |||
3254 3255 3256 3257 3258 3259 3260 |
* exactly the name of its public command. */
{
Command *cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, objPtr);
if (cmdPtr == NULL) {
goto notAnObject;
}
| | | | | 3254 3255 3256 3257 3258 3259 3260 3261 3262 3263 3264 3265 3266 3267 3268 3269 3270 3271 3272 3273 3274 |
* exactly the name of its public command. */
{
Command *cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, objPtr);
if (cmdPtr == NULL) {
goto notAnObject;
}
if (cmdPtr->objProc2 != TclOOPublicObjectCmd) {
cmdPtr = (Command *) TclGetOriginalCommand((Tcl_Command) cmdPtr);
if (cmdPtr == NULL || cmdPtr->objProc2 != TclOOPublicObjectCmd) {
goto notAnObject;
}
}
return (Tcl_Object) cmdPtr->objClientData2;
notAnObject:
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"%s does not refer to an object", TclGetString(objPtr)));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "OBJECT", TclGetString(objPtr),
(char *)NULL);
return NULL;
|
| ︙ | ︙ |
Changes to generic/tclOO.h.
| ︙ | ︙ | |||
57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 |
/*
* 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);
typedef int (Tcl_MethodCallProc2)(void *clientData, Tcl_Interp *interp,
Tcl_ObjectContext objectContext, Tcl_Size objc, Tcl_Obj *const *objv);
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);
/*
* The type of a method implementation. This describes how to call the method
* implementation, how to delete it (when the object or class is deleted) and
* how to create a clone of it (when the object or class is copied).
*/
typedef struct Tcl_MethodType {
int version; /* Structure version field. Always to be equal
* to TCL_OO_METHOD_VERSION_(1|CURRENT) in
* declarations. */
const char *name; /* Name of this type of method, mostly for
* debugging purposes. */
Tcl_MethodCallProc *callProc;
/* How to invoke this method. */
Tcl_MethodDeleteProc *deleteProc;
/* How to delete this method's type-specific
* 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;
typedef struct Tcl_MethodType2 {
int version; /* Structure version field. Always to be equal
* to TCL_OO_METHOD_VERSION_2 in
* declarations. */
const char *name; /* Name of this type of method, mostly for
* debugging purposes. */
| > > > > | 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 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 |
/*
* 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.
*/
#ifndef TCL_NO_DEPRECATED
typedef int (Tcl_MethodCallProc)(void *clientData, Tcl_Interp *interp,
Tcl_ObjectContext objectContext, int objc, Tcl_Obj *const *objv);
#endif /* TCL_NO_DEPRECATED */
typedef int (Tcl_MethodCallProc2)(void *clientData, Tcl_Interp *interp,
Tcl_ObjectContext objectContext, Tcl_Size objc, Tcl_Obj *const *objv);
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);
/*
* The type of a method implementation. This describes how to call the method
* implementation, how to delete it (when the object or class is deleted) and
* how to create a clone of it (when the object or class is copied).
*/
#ifndef TCL_NO_DEPRECATED
typedef struct Tcl_MethodType {
int version; /* Structure version field. Always to be equal
* to TCL_OO_METHOD_VERSION_(1|CURRENT) in
* declarations. */
const char *name; /* Name of this type of method, mostly for
* debugging purposes. */
Tcl_MethodCallProc *callProc;
/* How to invoke this method. */
Tcl_MethodDeleteProc *deleteProc;
/* How to delete this method's type-specific
* 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;
#endif /* TCL_NO_DEPRECATED */
typedef struct Tcl_MethodType2 {
int version; /* Structure version field. Always to be equal
* to TCL_OO_METHOD_VERSION_2 in
* declarations. */
const char *name; /* Name of this type of method, mostly for
* debugging purposes. */
|
| ︙ | ︙ | |||
114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 |
/*
* 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.
*/
enum TclOOMethodVersion {
TCL_OO_METHOD_VERSION_CURRENT = 1,
TCL_OO_METHOD_VERSION_1 = 1,
TCL_OO_METHOD_VERSION_2 = 2
};
/*
* Visibility constants for the flags parameter to Tcl_NewMethod and
* Tcl_NewInstanceMethod.
*/
| > > | 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 |
/*
* 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.
*/
enum TclOOMethodVersion {
#ifndef TCL_NO_DEPRECATED
TCL_OO_METHOD_VERSION_CURRENT = 1,
TCL_OO_METHOD_VERSION_1 = 1,
#endif /* TCL_NO_DEPRECATED */
TCL_OO_METHOD_VERSION_2 = 2
};
/*
* Visibility constants for the flags parameter to Tcl_NewMethod and
* Tcl_NewInstanceMethod.
*/
|
| ︙ | ︙ |
Changes to generic/tclOOBasic.c.
| ︙ | ︙ | |||
191 192 193 194 195 196 197 |
*/
int
TclOO_Class_Constructor(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_ObjectContext context,
| | < | 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 |
*/
int
TclOO_Class_Constructor(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_ObjectContext context,
Tcl_Size objc,
Tcl_Obj *const *objv)
{
Object *oPtr = (Object *) Tcl_ObjectContextObject(context);
Tcl_Size skip = Tcl_ObjectContextSkippedArgs(context);
if (objc > skip + 1) {
Tcl_WrongNumArgs(interp, skip, objv,
"?definitionScript?");
return TCL_ERROR;
}
/*
|
| ︙ | ︙ | |||
321 322 323 324 325 326 327 |
int
TclOO_Class_Create(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Interpreter in which to create the object;
* also used for error reporting. */
Tcl_ObjectContext context, /* The object/call context. */
| | | 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 |
int
TclOO_Class_Create(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Interpreter in which to create the object;
* also used for error reporting. */
Tcl_ObjectContext context, /* The object/call context. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const *objv) /* The actual arguments. */
{
Tcl_Class cls = ContextClass(interp, context);
const char *objName;
Tcl_Size len;
/*
|
| ︙ | ︙ | |||
380 381 382 383 384 385 386 |
int
TclOO_Class_CreateNs(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Interpreter in which to create the object;
* also used for error reporting. */
Tcl_ObjectContext context, /* The object/call context. */
| | | 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 |
int
TclOO_Class_CreateNs(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Interpreter in which to create the object;
* also used for error reporting. */
Tcl_ObjectContext context, /* The object/call context. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const *objv) /* The actual arguments. */
{
Tcl_Class cls = ContextClass(interp, context);
const char *objName, *nsName;
Tcl_Size len;
/*
|
| ︙ | ︙ | |||
447 448 449 450 451 452 453 |
int
TclOO_Class_New(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Interpreter in which to create the object;
* also used for error reporting. */
Tcl_ObjectContext context, /* The object/call context. */
| | | 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 |
int
TclOO_Class_New(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Interpreter in which to create the object;
* also used for error reporting. */
Tcl_ObjectContext context, /* The object/call context. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const *objv) /* The actual arguments. */
{
Tcl_Class cls = ContextClass(interp, context);
/*
* Sanity check; should not be possible to invoke this method on a
* non-class.
|
| ︙ | ︙ | |||
487 488 489 490 491 492 493 |
*/
int
TclOO_Class_Cloned(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Interpreter in which to create the object;
* also used for error reporting. */
Tcl_ObjectContext context, /* The object/call context. */
| | | 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 |
*/
int
TclOO_Class_Cloned(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Interpreter in which to create the object;
* also used for error reporting. */
Tcl_ObjectContext context, /* The object/call context. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const *objv) /* The actual arguments. */
{
Tcl_Object targetObject = Tcl_ObjectContextObject(context);
Tcl_Size skip = Tcl_ObjectContextSkippedArgs(context);
if (skip >= objc) {
Tcl_WrongNumArgs(interp, skip, objv, "originObject");
return TCL_ERROR;
|
| ︙ | ︙ | |||
582 583 584 585 586 587 588 |
* ----------------------------------------------------------------------
*/
int
TclOO_Configurable_Constructor(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_ObjectContext context,
| | | 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 |
* ----------------------------------------------------------------------
*/
int
TclOO_Configurable_Constructor(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_ObjectContext context,
Tcl_Size objc,
Tcl_Obj *const *objv)
{
Object *oPtr = (Object *) Tcl_ObjectContextObject(context);
Tcl_Size skip = Tcl_ObjectContextSkippedArgs(context);
if (objc != skip && objc != skip + 1) {
Tcl_WrongNumArgs(interp, skip, objv, "?definitionScript?");
return TCL_ERROR;
|
| ︙ | ︙ | |||
618 619 620 621 622 623 624 |
* ----------------------------------------------------------------------
*/
int
TclOO_Object_Cloned(
TCL_UNUSED(void *),
Tcl_Interp *interp, // Interpreter for error reporting.
Tcl_ObjectContext context, // The object/call context.
| | | 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 |
* ----------------------------------------------------------------------
*/
int
TclOO_Object_Cloned(
TCL_UNUSED(void *),
Tcl_Interp *interp, // Interpreter for error reporting.
Tcl_ObjectContext context, // The object/call context.
Tcl_Size objc, // Number of arguments.
Tcl_Obj *const *objv) // The actual arguments.
{
Tcl_Size skip = Tcl_ObjectContextSkippedArgs(context);
if (objc != skip + 1) {
Tcl_WrongNumArgs(interp, skip, objv, "originObject");
return TCL_ERROR;
}
|
| ︙ | ︙ | |||
656 657 658 659 660 661 662 |
int
TclOO_Object_Destroy(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Interpreter in which to create the object;
* also used for error reporting. */
Tcl_ObjectContext context, /* The object/call context. */
| | | 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 |
int
TclOO_Object_Destroy(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Interpreter in which to create the object;
* also used for error reporting. */
Tcl_ObjectContext context, /* The object/call context. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const *objv) /* The actual arguments. */
{
Object *oPtr = (Object *) Tcl_ObjectContextObject(context);
CallContext *contextPtr;
if (objc != Tcl_ObjectContextSkippedArgs(context)) {
Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
|
| ︙ | ︙ | |||
720 721 722 723 724 725 726 |
int
TclOO_Object_Eval(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Interpreter in which to create the object;
* also used for error reporting. */
Tcl_ObjectContext context, /* The object/call context. */
| | | | 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 |
int
TclOO_Object_Eval(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Interpreter in which to create the object;
* also used for error reporting. */
Tcl_ObjectContext context, /* The object/call context. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const *objv) /* The actual arguments. */
{
CallContext *contextPtr = (CallContext *) context;
Tcl_Object object = Tcl_ObjectContextObject(context);
Tcl_Size skip = Tcl_ObjectContextSkippedArgs(context);
CallFrame *framePtr, **framePtrPtr = &framePtr;
Tcl_Obj *scriptPtr;
CmdFrame *invoker;
if (objc < skip + 1) {
Tcl_WrongNumArgs(interp, skip, objv, "arg ?arg ...?");
return TCL_ERROR;
}
/*
* Make the object's namespace the current namespace and evaluate the
* command(s).
*/
(void)TclPushStackFrame(interp, (Tcl_CallFrame **)framePtrPtr,
Tcl_GetObjectNamespace(object), FRAME_IS_METHOD);
framePtr->clientData = context;
framePtr->objc = objc;
framePtr->objv = objv; /* Reference counts do not need to be
* incremented here. */
if (!(contextPtr->callPtr->flags & PUBLIC_METHOD)) {
|
| ︙ | ︙ | |||
823 824 825 826 827 828 829 |
int
TclOO_Object_Unknown(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Interpreter in which to create the object;
* also used for error reporting. */
Tcl_ObjectContext context, /* The object/call context. */
| | | | 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 |
int
TclOO_Object_Unknown(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Interpreter in which to create the object;
* also used for error reporting. */
Tcl_ObjectContext context, /* The object/call context. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const *objv) /* The actual arguments. */
{
CallContext *contextPtr = (CallContext *) context;
Object *callerObj = NULL;
Class *callerCls = NULL;
Object *oPtr = contextPtr->oPtr;
Tcl_Obj **methodNames;
Tcl_Size numMethodNames, i;
Tcl_Size skip = Tcl_ObjectContextSkippedArgs(context);
CallFrame *framePtr = ((Interp *) interp)->varFramePtr;
Tcl_Obj *errorMsg;
/*
* If no method name, generate an error asking for a method name. (Only by
* overriding *this* method can an object handle the absence of a method
|
| ︙ | ︙ | |||
930 931 932 933 934 935 936 |
int
TclOO_Object_LinkVar(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Interpreter in which to create the object;
* also used for error reporting. */
Tcl_ObjectContext context, /* The object/call context. */
| | | 929 930 931 932 933 934 935 936 937 938 939 940 941 942 943 |
int
TclOO_Object_LinkVar(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Interpreter in which to create the object;
* also used for error reporting. */
Tcl_ObjectContext context, /* The object/call context. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const *objv) /* The actual arguments. */
{
Interp *iPtr = (Interp *) interp;
Tcl_Object object = Tcl_ObjectContextObject(context);
Namespace *savedNsPtr;
Tcl_Size i;
|
| ︙ | ︙ | |||
1147 1148 1149 1150 1151 1152 1153 |
int
TclOO_Object_VarName(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Interpreter in which to create the object;
* also used for error reporting. */
Tcl_ObjectContext context, /* The object/call context. */
| | | 1146 1147 1148 1149 1150 1151 1152 1153 1154 1155 1156 1157 1158 1159 1160 |
int
TclOO_Object_VarName(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Interpreter in which to create the object;
* also used for error reporting. */
Tcl_ObjectContext context, /* The object/call context. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const *objv) /* The actual arguments. */
{
Tcl_Var varPtr, aryVar;
Tcl_Obj *varNamePtr;
if (Tcl_ObjectContextSkippedArgs(context) + 1 != objc) {
Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
|
| ︙ | ︙ | |||
1207 1208 1209 1210 1211 1212 1213 |
*
* ----------------------------------------------------------------------
*/
int
TclOOLinkObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | 1206 1207 1208 1209 1210 1211 1212 1213 1214 1215 1216 1217 1218 1219 1220 |
*
* ----------------------------------------------------------------------
*/
int
TclOOLinkObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const *objv)
{
// Set up common bits.
CallContext *context = TclOOGetContextFromCurrentStackFrame(interp,
TclGetString(objv[0]));
if (!context) {
return TCL_ERROR;
|
| ︙ | ︙ | |||
1294 1295 1296 1297 1298 1299 1300 |
* ----------------------------------------------------------------------
*/
int
TclOONextObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | 1293 1294 1295 1296 1297 1298 1299 1300 1301 1302 1303 1304 1305 1306 1307 |
* ----------------------------------------------------------------------
*/
int
TclOONextObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const *objv)
{
Interp *iPtr = (Interp *) interp;
CallFrame *framePtr = iPtr->varFramePtr;
Tcl_ObjectContext context = (Tcl_ObjectContext)
TclOOGetContextFromCurrentStackFrame(interp, TclGetString(objv[0]));
|
| ︙ | ︙ | |||
1326 1327 1328 1329 1330 1331 1332 |
return TclNRObjectContextInvokeNext(interp, context, objc, objv, 1);
}
int
TclOONextToObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | 1325 1326 1327 1328 1329 1330 1331 1332 1333 1334 1335 1336 1337 1338 1339 |
return TclNRObjectContextInvokeNext(interp, context, objc, objv, 1);
}
int
TclOONextToObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const *objv)
{
/*
* Start with sanity checks on the calling context to make sure that we
* are invoked from a suitable method context. If so, we can safely
* retrieve the handle to the object call context.
*/
|
| ︙ | ︙ | |||
1438 1439 1440 1441 1442 1443 1444 |
* ----------------------------------------------------------------------
*/
int
TclOOSelfObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | 1437 1438 1439 1440 1441 1442 1443 1444 1445 1446 1447 1448 1449 1450 1451 |
* ----------------------------------------------------------------------
*/
int
TclOOSelfObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const *objv)
{
static const char *const subcmds[] = {
"call", "caller", "class", "filter", "method", "namespace", "next",
"object", "target", NULL
};
enum SelfCmds {
|
| ︙ | ︙ | |||
1654 1655 1656 1657 1658 1659 1660 |
* ----------------------------------------------------------------------
*/
int
TclOOCopyObjectCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | 1653 1654 1655 1656 1657 1658 1659 1660 1661 1662 1663 1664 1665 1666 1667 |
* ----------------------------------------------------------------------
*/
int
TclOOCopyObjectCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const *objv)
{
Tcl_Object oPtr, o2Ptr;
if (objc < 2 || objc > 4) {
Tcl_WrongNumArgs(interp, 1, objv,
"sourceName ?targetName? ?targetNamespace?");
|
| ︙ | ︙ | |||
1735 1736 1737 1738 1739 1740 1741 |
*
* ----------------------------------------------------------------------
*/
int
TclOOCallbackObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | 1734 1735 1736 1737 1738 1739 1740 1741 1742 1743 1744 1745 1746 1747 1748 |
*
* ----------------------------------------------------------------------
*/
int
TclOOCallbackObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const *objv)
{
/*
* Start with sanity checks on the calling context to make sure that we
* are invoked from a suitable method context. If so, we can safely
* retrieve the handle to the object call context.
*/
|
| ︙ | ︙ | |||
1785 1786 1787 1788 1789 1790 1791 |
*
* ----------------------------------------------------------------------
*/
int
TclOOClassVariableObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | 1784 1785 1786 1787 1788 1789 1790 1791 1792 1793 1794 1795 1796 1797 1798 |
*
* ----------------------------------------------------------------------
*/
int
TclOOClassVariableObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const *objv)
{
if (objc < 2) {
Tcl_WrongNumArgs(interp, 1, objv, "name ...");
return TCL_ERROR;
}
|
| ︙ | ︙ | |||
1875 1876 1877 1878 1879 1880 1881 |
*
* ----------------------------------------------------------------------
*/
int
TclOODelegateNameObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | 1874 1875 1876 1877 1878 1879 1880 1881 1882 1883 1884 1885 1886 1887 1888 |
*
* ----------------------------------------------------------------------
*/
int
TclOODelegateNameObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const *objv)
{
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "class");
return TCL_ERROR;
}
Class *clsPtr = TclOOGetClassFromObj(interp, objv[1]);
|
| ︙ | ︙ | |||
1907 1908 1909 1910 1911 1912 1913 |
int
TclOO_Singleton_New(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Interpreter in which to create the object;
* also used for error reporting. */
Tcl_ObjectContext context, /* The object/call context. */
| | | 1906 1907 1908 1909 1910 1911 1912 1913 1914 1915 1916 1917 1918 1919 1920 |
int
TclOO_Singleton_New(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Interpreter in which to create the object;
* also used for error reporting. */
Tcl_ObjectContext context, /* The object/call context. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const *objv) /* The actual arguments. */
{
Object *oPtr = (Object *) Tcl_ObjectContextObject(context);
Class *clsPtr = oPtr->classPtr;
if (clsPtr->instances.num) {
Tcl_SetObjResult(interp, TclOOObjectName(interp, clsPtr->instances.list[0]));
|
| ︙ | ︙ | |||
1972 1973 1974 1975 1976 1977 1978 |
*/
int
TclOO_SingletonInstance_Destroy(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Interpreter for error reporting. */
TCL_UNUSED(Tcl_ObjectContext),
| | | | 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 |
*/
int
TclOO_SingletonInstance_Destroy(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Interpreter for error reporting. */
TCL_UNUSED(Tcl_ObjectContext),
TCL_UNUSED(Tcl_Size),
TCL_UNUSED(Tcl_Obj *const *))
{
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"may not destroy a singleton object"));
OO_ERROR(interp, SINGLETON);
return TCL_ERROR;
}
int
TclOO_SingletonInstance_Cloned(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Interpreter in which to create the object;
* also used for error reporting. */
TCL_UNUSED(Tcl_ObjectContext),
TCL_UNUSED(Tcl_Size),
TCL_UNUSED(Tcl_Obj *const *))
{
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"may not clone a singleton object"));
OO_ERROR(interp, SINGLETON);
return TCL_ERROR;
}
|
| ︙ | ︙ |
Changes to generic/tclOOCall.c.
| ︙ | ︙ | |||
143 144 145 146 147 148 149 | static void DupMethodNameRep(Tcl_Obj *srcPtr, Tcl_Obj *dstPtr); static Tcl_NRPostProc FinalizeMethodRefs; static void FreeMethodNameRep(Tcl_Obj *objPtr); static inline int IsStillValid(CallChain *callPtr, Object *oPtr, int flags, int reuseMask); static Tcl_NRPostProc ResetFilterFlags; static Tcl_NRPostProc SetFilterFlags; | | | 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 | static void DupMethodNameRep(Tcl_Obj *srcPtr, Tcl_Obj *dstPtr); static Tcl_NRPostProc FinalizeMethodRefs; static void FreeMethodNameRep(Tcl_Obj *objPtr); static inline int IsStillValid(CallChain *callPtr, Object *oPtr, int flags, int reuseMask); static Tcl_NRPostProc ResetFilterFlags; static Tcl_NRPostProc SetFilterFlags; static Tcl_Size SortMethodNames(Tcl_HashTable *namesPtr, int flags, Tcl_Obj ***stringsPtr); static inline void StashCallChain(Tcl_Obj *objPtr, CallChain *callPtr); /* * Object type used to manage type caches attached to method names. */ |
| ︙ | ︙ | |||
317 318 319 320 321 322 323 |
int
TclOOInvokeContext(
void *clientData, /* The method call context. */
Tcl_Interp *interp, /* Interpreter for error reporting, and many
* other sorts of context handling (e.g.,
* commands, variables) depending on method
* implementation. */
| | | 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 |
int
TclOOInvokeContext(
void *clientData, /* The method call context. */
Tcl_Interp *interp, /* Interpreter for error reporting, and many
* other sorts of context handling (e.g.,
* commands, variables) depending on method
* implementation. */
Tcl_Size objc, /* The number of arguments. */
Tcl_Obj *const objv[]) /* The arguments as actually seen. */
{
CallContext *const contextPtr = (CallContext *) clientData;
Method *const mPtr = contextPtr->callPtr->chain[contextPtr->index].mPtr;
const int isFilter =
contextPtr->callPtr->chain[contextPtr->index].isFilter;
|
| ︙ | ︙ | |||
375 376 377 378 379 380 381 382 383 |
contextPtr->oPtr->flags &= ~FILTER_HANDLING;
}
/*
* Run the method implementation.
*/
if (mPtr->typePtr->version < TCL_OO_METHOD_VERSION_2) {
return (mPtr->typePtr->callProc)(mPtr->clientData, interp,
| > | > | 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 |
contextPtr->oPtr->flags &= ~FILTER_HANDLING;
}
/*
* Run the method implementation.
*/
#ifndef TCL_NO_DEPRECATED
if (mPtr->typePtr->version < TCL_OO_METHOD_VERSION_2) {
return (mPtr->typePtr->callProc)(mPtr->clientData, interp,
(Tcl_ObjectContext) contextPtr, (int)objc, objv);
}
#endif /* TCL_NO_DEPRECATED */
return (mPtr->type2Ptr->callProc)(mPtr->clientData, interp,
(Tcl_ObjectContext) contextPtr, objc, objv);
}
static int
SetFilterFlags(
void *data[],
|
| ︙ | ︙ | |||
548 549 550 551 552 553 554 |
Tcl_DeleteHashTable(&examinedClasses);
numStrings = SortMethodNames(&names, flags, namesLstPtr);
Tcl_DeleteHashTable(&names);
return numStrings;
}
| | | | 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 |
Tcl_DeleteHashTable(&examinedClasses);
numStrings = SortMethodNames(&names, flags, namesLstPtr);
Tcl_DeleteHashTable(&names);
return numStrings;
}
Tcl_Size
TclOOGetSortedClassMethodList(
Class *clsPtr, /* The class to get the method names for. */
int flags, /* Whether we just want the public method
* names. */
Tcl_Obj ***namesLstPtr) /* Where to write a pointer to the array of
* strings to. */
{
Tcl_HashTable names; /* Tcl_Obj* method name to "wanted in list"
* mapping. */
Tcl_HashTable examinedClasses;
/* Used to track what classes have been looked
* at. Is set-like in nature and keyed by
* pointer to class. */
Tcl_Size numStrings;
Tcl_InitObjHashTable(&names);
Tcl_InitHashTable(&examinedClasses, TCL_ONE_WORD_KEYS);
/*
* Process method names from the class hierarchy and the mixin hierarchy.
*/
|
| ︙ | ︙ | |||
607 608 609 610 611 612 613 | * * Returns: * The length of the sorted list. * * ---------------------------------------------------------------------- */ | | | | 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 |
*
* Returns:
* The length of the sorted list.
*
* ----------------------------------------------------------------------
*/
static Tcl_Size
SortMethodNames(
Tcl_HashTable *namesTbl, /* The table of names; unsorted, but contains
* whether the names are wanted and under what
* circumstances. */
int flags, /* Whether we are looking for unexported
* methods. Full private methods are handled
* on insertion to the table. */
Tcl_Obj ***namesLstPtr) /* Where to store the sorted list of strings
* that we produce. Tcl_Alloced() */
{
Tcl_Obj **namesLst;
FOREACH_HASH_DECLS;
Tcl_Obj *namePtr;
void *isWanted;
Tcl_Size i = 0;
/*
* See how many (visible) method names there are. If none, we do not (and
* should not) try to sort the list of them.
*/
if (namesTbl->numEntries == 0) {
|
| ︙ | ︙ | |||
815 816 817 818 819 820 821 |
Tcl_HashEntry *hPtr =
Tcl_CreateHashEntry(namesPtr, namePtr, &isNew);
if (isNew) {
int isWanted = (!WANT_PUBLIC(flags) || IS_PUBLIC(mPtr))
? IN_LIST : 0;
| | | | 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 |
Tcl_HashEntry *hPtr =
Tcl_CreateHashEntry(namesPtr, namePtr, &isNew);
if (isNew) {
int isWanted = (!WANT_PUBLIC(flags) || IS_PUBLIC(mPtr))
? IN_LIST : 0;
isWanted |= (mPtr->type2Ptr == NULL ? NO_IMPLEMENTATION : 0);
Tcl_SetHashValue(hPtr, INT2PTR(isWanted));
} else if ((PTR2INT(Tcl_GetHashValue(hPtr)) & NO_IMPLEMENTATION)
&& mPtr->type2Ptr != NULL) {
Tcl_Size isWanted = PTR2INT(Tcl_GetHashValue(hPtr));
isWanted &= ~NO_IMPLEMENTATION;
Tcl_SetHashValue(hPtr, INT2PTR(isWanted));
}
}
}
|
| ︙ | ︙ | |||
1001 1002 1003 1004 1005 1006 1007 |
* Return if this is just an entry used to record whether this is a public
* method. If so, there's nothing real to call and so nothing to add to
* the call chain.
*
* This is also where we enforce mixin-consistency.
*/
| | | 1003 1004 1005 1006 1007 1008 1009 1010 1011 1012 1013 1014 1015 1016 1017 |
* Return if this is just an entry used to record whether this is a public
* method. If so, there's nothing real to call and so nothing to add to
* the call chain.
*
* This is also where we enforce mixin-consistency.
*/
if (mPtr == NULL || mPtr->type2Ptr == NULL || !MIXIN_CONSISTENT(flags)) {
return;
}
/*
* Enforce real private method handling here. We will skip adding this
* method IF
* 1) we are not allowing private methods, AND
|
| ︙ | ︙ | |||
1910 1911 1912 1913 1914 1915 1916 | callPtr->flags & CONSTRUCTOR ? fPtr->constructorName : callPtr->flags & DESTRUCTOR ? fPtr->destructorName : miPtr->mPtr->namePtr; descObjs[2] = miPtr->mPtr->declaringClassPtr ? Tcl_GetObjectName(interp, (Tcl_Object) miPtr->mPtr->declaringClassPtr->thisPtr) : objectLiteral; | | | 1912 1913 1914 1915 1916 1917 1918 1919 1920 1921 1922 1923 1924 1925 1926 |
callPtr->flags & CONSTRUCTOR ? fPtr->constructorName :
callPtr->flags & DESTRUCTOR ? fPtr->destructorName :
miPtr->mPtr->namePtr;
descObjs[2] = miPtr->mPtr->declaringClassPtr
? Tcl_GetObjectName(interp,
(Tcl_Object) miPtr->mPtr->declaringClassPtr->thisPtr)
: objectLiteral;
descObjs[3] = Tcl_NewStringObj(miPtr->mPtr->type2Ptr->name,
TCL_AUTO_LENGTH);
objv[i] = Tcl_NewListObj(4, descObjs);
}
/*
* Drop the local references to the literals; if they're actually used,
|
| ︙ | ︙ |
Changes to generic/tclOODecls.h.
| ︙ | ︙ | |||
13 14 15 16 17 18 19 20 21 22 23 24 25 26 |
# endif
#endif
#ifdef USE_TCL_STUBS
# undef USE_TCLOO_STUBS
# define USE_TCLOO_STUBS
#endif
/* !BEGIN!: Do not edit below this line. */
#ifdef __cplusplus
extern "C" {
#endif
| > > > > | 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 |
# endif
#endif
#ifdef USE_TCL_STUBS
# undef USE_TCLOO_STUBS
# define USE_TCLOO_STUBS
#endif
#ifdef TCL_NO_DEPRECATED
# define Tcl_MethodType void
#endif
/* !BEGIN!: Do not edit below this line. */
#ifdef __cplusplus
extern "C" {
#endif
|
| ︙ | ︙ | |||
265 266 267 268 269 270 271 272 273 | (tclOOStubsPtr->tcl_NewInstanceMethod2) /* 33 */ #define Tcl_NewMethod2 \ (tclOOStubsPtr->tcl_NewMethod2) /* 34 */ #endif /* defined(USE_TCLOO_STUBS) */ /* !END!: Do not edit above this line. */ #endif /* _TCLOODECLS */ | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 |
(tclOOStubsPtr->tcl_NewInstanceMethod2) /* 33 */
#define Tcl_NewMethod2 \
(tclOOStubsPtr->tcl_NewMethod2) /* 34 */
#endif /* defined(USE_TCLOO_STUBS) */
/* !END!: Do not edit above this line. */
#ifdef TCL_NO_DEPRECATED
# undef Tcl_MethodType
# undef Tcl_MethodIsType
# undef Tcl_NewInstanceMethod
# undef Tcl_NewMethod
#endif
#if defined(__STDC_VERSION__) && (__STDC_VERSION__ >= 201112L)
#ifndef TclOOGeneric
/* Select method based on type of argument. */
#define TclOOGeneric(typePtr, impl) \
_Generic(typePtr, default: impl, const Tcl_MethodType2 *: impl ## 2)
#endif
#ifdef USE_TCLOO_STUBS
#undef Tcl_MethodIsType
#define Tcl_MethodIsType(method, typePtr, clientDataPtr) \
(TclOOGeneric((typePtr), tclOOStubsPtr->tcl_MethodIsType) \
((method), (typePtr), (clientDataPtr)))
#undef Tcl_NewInstanceMethod
#define Tcl_NewInstanceMethod(interp, object, nameObj, flags, typePtr, clientData) \
(TclOOGeneric((typePtr), tclOOStubsPtr->tcl_NewInstanceMethod) \
((interp), (object), (nameObj), (flags), (typePtr), (clientData)))
#undef Tcl_NewMethod
#define Tcl_NewMethod(interp, cls, nameObj, flags, typePtr, clientData) \
(TclOOGeneric((typePtr), tclOOStubsPtr->tcl_NewMethod) \
((interp), (cls), (nameObj), (flags), (typePtr), (clientData)))
#else
#define Tcl_MethodIsType(method, typePtr, clientDataPtr) \
(TclOOGeneric((typePtr), Tcl_MethodIsType) \
((method), (typePtr), (clientDataPtr)))
#define Tcl_NewInstanceMethod(interp, object, nameObj, flags, typePtr, clientData) \
(TclOOGeneric((typePtr), Tcl_NewInstanceMethod) \
((interp), (object), (nameObj), (flags), (typePtr), (clientData)))
#define Tcl_NewMethod(interp, cls, nameObj, flags, typePtr, clientData) \
(TclOOGeneric((typePtr), Tcl_NewMethod) \
((interp), (cls), (nameObj), (flags), (typePtr), (clientData)))
#endif
#endif
#endif /* _TCLOODECLS */
|
Changes to generic/tclOODefineCmds.c.
| ︙ | ︙ | |||
30 31 32 33 34 35 36 |
#define OBJNAME_LENGTH_IN_ERRORINFO_LIMIT 30
/*
* Some things that make it easier to declare a slot.
*/
typedef struct DeclaredSlot {
const char *name;
| | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 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 122 123 |
#define OBJNAME_LENGTH_IN_ERRORINFO_LIMIT 30
/*
* Some things that make it easier to declare a slot.
*/
typedef struct DeclaredSlot {
const char *name;
const Tcl_MethodType2 getterType;
const Tcl_MethodType2 setterType;
const Tcl_MethodType2 resolverType;
const char *defaultOp; // The default op, if not set by the class
} DeclaredSlot;
#define SLOT(name,getter,setter,resolver,defOp) \
{"::oo::" name, \
{TCL_OO_METHOD_VERSION_2, "core method: " name " Getter", \
getter, NULL, NULL}, \
{TCL_OO_METHOD_VERSION_2, "core method: " name " Setter", \
setter, NULL, NULL}, \
{TCL_OO_METHOD_VERSION_2, "core method: " name " Resolver", \
resolver, NULL, NULL}, (defOp)}
typedef struct DeclaredSlotMethod {
const char *name;
int flags;
const Tcl_MethodType2 implType;
} DeclaredSlotMethod;
#define SLOT_METHOD(name,impl,flags) \
{name, flags, {TCL_OO_METHOD_VERSION_2, \
"core method: " name " slot", impl, NULL, NULL}}
/*
* A [string match] pattern used to determine if a method should be exported.
*/
#define PUBLIC_PATTERN "[a-z]*"
/*
* Forward declarations.
*/
static inline void BumpGlobalEpoch(Tcl_Interp *interp, Class *classPtr);
static inline void BumpInstanceEpoch(Object *oPtr);
static Tcl_Command FindCommand(Tcl_Interp *interp, Tcl_Obj *stringObj,
Tcl_Namespace *const namespacePtr);
static inline void GenerateErrorInfo(Tcl_Interp *interp, Object *oPtr,
Tcl_Obj *savedNameObj, const char *typeOfSubject);
static inline int MagicDefinitionInvoke(Tcl_Interp *interp,
Tcl_Namespace *nsPtr, int cmdIndex,
Tcl_Size objc, Tcl_Obj *const *objv);
static inline Class * GetClassInOuterContext(Tcl_Interp *interp,
Tcl_Obj *className, const char *errMsg);
static inline Tcl_Namespace *GetNamespaceInOuterContext(Tcl_Interp *interp,
Tcl_Obj *namespaceName);
static inline int InitDefineContext(Tcl_Interp *interp,
Tcl_Namespace *namespacePtr, Object *oPtr,
Tcl_Size objc, Tcl_Obj *const objv[]);
static inline void RecomputeClassCacheFlag(Object *oPtr);
static int RenameDeleteMethod(Tcl_Interp *interp, Object *oPtr,
int useClass, Tcl_Obj *const fromPtr,
Tcl_Obj *const toPtr);
static Tcl_MethodCallProc2 Slot_Append;
static Tcl_MethodCallProc2 Slot_AppendNew;
static Tcl_MethodCallProc2 Slot_Clear;
static Tcl_MethodCallProc2 Slot_Prepend;
static Tcl_MethodCallProc2 Slot_Remove;
static Tcl_MethodCallProc2 Slot_Resolve;
static Tcl_MethodCallProc2 Slot_ResolveClass;
static Tcl_MethodCallProc2 Slot_Set;
static Tcl_MethodCallProc2 Slot_Unimplemented;
static Tcl_MethodCallProc2 Slot_Unknown;
static Tcl_MethodCallProc2 ClassFilter_Get, ClassFilter_Set;
static Tcl_MethodCallProc2 ClassMixin_Get, ClassMixin_Set;
static Tcl_MethodCallProc2 ClassSuper_Get, ClassSuper_Set;
static Tcl_MethodCallProc2 ClassVars_Get, ClassVars_Set;
static Tcl_MethodCallProc2 ObjFilter_Get, ObjFilter_Set;
static Tcl_MethodCallProc2 ObjMixin_Get, ObjMixin_Set;
static Tcl_MethodCallProc2 ObjVars_Get, ObjVars_Set;
static Tcl_MethodCallProc2 Configurable_ClassReadableProps_Get;
static Tcl_MethodCallProc2 Configurable_ClassReadableProps_Set;
static Tcl_MethodCallProc2 Configurable_ClassWritableProps_Get;
static Tcl_MethodCallProc2 Configurable_ClassWritableProps_Set;
static Tcl_MethodCallProc2 Configurable_ObjectReadableProps_Get;
static Tcl_MethodCallProc2 Configurable_ObjectReadableProps_Set;
static Tcl_MethodCallProc2 Configurable_ObjectWritableProps_Get;
static Tcl_MethodCallProc2 Configurable_ObjectWritableProps_Set;
/*
* Now define the slots used in declarations.
*/
static const DeclaredSlot slots[] = {
SLOT("define::filter", ClassFilter_Get, ClassFilter_Set, NULL, NULL),
|
| ︙ | ︙ | |||
814 815 816 817 818 819 820 |
* ----------------------------------------------------------------------
*/
int
TclOOUnknownDefinition(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 |
* ----------------------------------------------------------------------
*/
int
TclOOUnknownDefinition(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const *objv)
{
Namespace *nsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
FOREACH_HASH_DECLS;
Tcl_Size soughtLen;
const char *soughtStr, *nameStr, *matchedStr = NULL;
|
| ︙ | ︙ | |||
950 951 952 953 954 955 956 |
*/
static inline int
InitDefineContext(
Tcl_Interp *interp,
Tcl_Namespace *namespacePtr,
Object *oPtr,
| | | 950 951 952 953 954 955 956 957 958 959 960 961 962 963 964 |
*/
static inline int
InitDefineContext(
Tcl_Interp *interp,
Tcl_Namespace *namespacePtr,
Object *oPtr,
Tcl_Size objc,
Tcl_Obj *const objv[])
{
CallFrame *framePtr, **framePtrPtr = &framePtr;
if (namespacePtr == NULL) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"no definition namespace available", TCL_AUTO_LENGTH));
|
| ︙ | ︙ | |||
1155 1156 1157 1158 1159 1160 1161 |
*/
static inline int
MagicDefinitionInvoke(
Tcl_Interp *interp,
Tcl_Namespace *nsPtr,
int cmdIndex,
| | | 1155 1156 1157 1158 1159 1160 1161 1162 1163 1164 1165 1166 1167 1168 1169 |
*/
static inline int
MagicDefinitionInvoke(
Tcl_Interp *interp,
Tcl_Namespace *nsPtr,
int cmdIndex,
Tcl_Size objc,
Tcl_Obj *const *objv)
{
Tcl_Obj *objPtr, *obj2Ptr, **objs;
Tcl_Command cmd;
int isRoot, result, offset = cmdIndex + 1;
Tcl_Size dummy;
|
| ︙ | ︙ | |||
1378 1379 1380 1381 1382 1383 1384 |
* ----------------------------------------------------------------------
*/
int
TclOODefineObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | 1378 1379 1380 1381 1382 1383 1384 1385 1386 1387 1388 1389 1390 1391 1392 |
* ----------------------------------------------------------------------
*/
int
TclOODefineObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const *objv)
{
Tcl_Namespace *nsPtr;
Object *oPtr;
int result;
if (objc < 3) {
|
| ︙ | ︙ | |||
1454 1455 1456 1457 1458 1459 1460 |
* ----------------------------------------------------------------------
*/
int
TclOOObjDefObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | 1454 1455 1456 1457 1458 1459 1460 1461 1462 1463 1464 1465 1466 1467 1468 |
* ----------------------------------------------------------------------
*/
int
TclOOObjDefObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const *objv)
{
Tcl_Namespace *nsPtr;
Object *oPtr;
int result;
if (objc < 3) {
|
| ︙ | ︙ | |||
1523 1524 1525 1526 1527 1528 1529 |
* ----------------------------------------------------------------------
*/
int
TclOODefineSelfObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | 1523 1524 1525 1526 1527 1528 1529 1530 1531 1532 1533 1534 1535 1536 1537 |
* ----------------------------------------------------------------------
*/
int
TclOODefineSelfObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const *objv)
{
Tcl_Namespace *nsPtr;
Object *oPtr;
int result, isPrivate;
oPtr = (Object *) TclOOGetDefineCmdContext(interp);
|
| ︙ | ︙ | |||
1594 1595 1596 1597 1598 1599 1600 |
* ----------------------------------------------------------------------
*/
int
TclOODefineObjSelfObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | 1594 1595 1596 1597 1598 1599 1600 1601 1602 1603 1604 1605 1606 1607 1608 |
* ----------------------------------------------------------------------
*/
int
TclOODefineObjSelfObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const *objv)
{
Object *oPtr;
if (objc != 1) {
Tcl_WrongNumArgs(interp, 1, objv, NULL);
return TCL_ERROR;
|
| ︙ | ︙ | |||
1628 1629 1630 1631 1632 1633 1634 |
* ----------------------------------------------------------------------
*/
int
TclOODefinePrivateObjCmd(
void *clientData,
Tcl_Interp *interp,
| | | 1628 1629 1630 1631 1632 1633 1634 1635 1636 1637 1638 1639 1640 1641 1642 |
* ----------------------------------------------------------------------
*/
int
TclOODefinePrivateObjCmd(
void *clientData,
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const *objv)
{
int isInstancePrivate = (clientData != NULL);
/* Just so that we can generate the correct
* error message depending on the context of
* usage of this function. */
Interp *iPtr = (Interp *) interp;
|
| ︙ | ︙ | |||
1701 1702 1703 1704 1705 1706 1707 |
* ----------------------------------------------------------------------
*/
int
TclOODefineClassObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | 1701 1702 1703 1704 1705 1706 1707 1708 1709 1710 1711 1712 1713 1714 1715 |
* ----------------------------------------------------------------------
*/
int
TclOODefineClassObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const *objv)
{
Object *oPtr;
Class *clsPtr;
Foundation *fPtr = TclOOGetFoundation(interp);
int wasClass, willBeClass;
|
| ︙ | ︙ | |||
1813 1814 1815 1816 1817 1818 1819 |
* ----------------------------------------------------------------------
*/
int
TclOODefineConstructorObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | 1813 1814 1815 1816 1817 1818 1819 1820 1821 1822 1823 1824 1825 1826 1827 |
* ----------------------------------------------------------------------
*/
int
TclOODefineConstructorObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const *objv)
{
Class *clsPtr = TclOOGetClassDefineCmdContext(interp);
Tcl_Method method;
Tcl_Size bodyLength;
if (clsPtr == NULL) {
|
| ︙ | ︙ | |||
1872 1873 1874 1875 1876 1877 1878 |
* ----------------------------------------------------------------------
*/
int
TclOODefineDefnNsObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | 1872 1873 1874 1875 1876 1877 1878 1879 1880 1881 1882 1883 1884 1885 1886 |
* ----------------------------------------------------------------------
*/
int
TclOODefineDefnNsObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const *objv)
{
static const char *kindList[] = {
"-class",
"-instance",
NULL
};
|
| ︙ | ︙ | |||
1949 1950 1951 1952 1953 1954 1955 |
* ----------------------------------------------------------------------
*/
int
TclOODefineDeleteMethodObjCmd(
void *clientData,
Tcl_Interp *interp,
| | | 1949 1950 1951 1952 1953 1954 1955 1956 1957 1958 1959 1960 1961 1962 1963 |
* ----------------------------------------------------------------------
*/
int
TclOODefineDeleteMethodObjCmd(
void *clientData,
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const *objv)
{
int isInstanceDeleteMethod = (clientData != NULL);
Object *oPtr;
int i;
if (objc < 2) {
|
| ︙ | ︙ | |||
2003 2004 2005 2006 2007 2008 2009 |
* ----------------------------------------------------------------------
*/
int
TclOODefineDestructorObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | 2003 2004 2005 2006 2007 2008 2009 2010 2011 2012 2013 2014 2015 2016 2017 |
* ----------------------------------------------------------------------
*/
int
TclOODefineDestructorObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const *objv)
{
Tcl_Method method;
Tcl_Size bodyLength;
Class *clsPtr = TclOOGetClassDefineCmdContext(interp);
if (clsPtr == NULL) {
|
| ︙ | ︙ | |||
2064 2065 2066 2067 2068 2069 2070 |
* ----------------------------------------------------------------------
*/
int
TclOODefineExportObjCmd(
void *clientData,
Tcl_Interp *interp,
| | | 2064 2065 2066 2067 2068 2069 2070 2071 2072 2073 2074 2075 2076 2077 2078 |
* ----------------------------------------------------------------------
*/
int
TclOODefineExportObjCmd(
void *clientData,
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const *objv)
{
int isInstanceExport = (clientData != NULL);
int i, changed = 0;
if (objc < 2) {
Tcl_WrongNumArgs(interp, 1, objv, "name ?name ...?");
|
| ︙ | ︙ | |||
2130 2131 2132 2133 2134 2135 2136 |
* ----------------------------------------------------------------------
*/
int
TclOODefineForwardObjCmd(
void *clientData,
Tcl_Interp *interp,
| | | 2130 2131 2132 2133 2134 2135 2136 2137 2138 2139 2140 2141 2142 2143 2144 |
* ----------------------------------------------------------------------
*/
int
TclOODefineForwardObjCmd(
void *clientData,
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const *objv)
{
int isInstanceForward = (clientData != NULL);
Object *oPtr;
Method *mPtr;
int isPublic;
Tcl_Obj *prefixObj;
|
| ︙ | ︙ | |||
2191 2192 2193 2194 2195 2196 2197 |
* ----------------------------------------------------------------------
*/
int
TclOODefineInitialiseObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | 2191 2192 2193 2194 2195 2196 2197 2198 2199 2200 2201 2202 2203 2204 2205 |
* ----------------------------------------------------------------------
*/
int
TclOODefineInitialiseObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const *objv)
{
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "body");
return TCL_ERROR;
}
|
| ︙ | ︙ | |||
2238 2239 2240 2241 2242 2243 2244 |
* ----------------------------------------------------------------------
*/
int
TclOODefineMethodObjCmd(
void *clientData,
Tcl_Interp *interp,
| | | 2238 2239 2240 2241 2242 2243 2244 2245 2246 2247 2248 2249 2250 2251 2252 |
* ----------------------------------------------------------------------
*/
int
TclOODefineMethodObjCmd(
void *clientData,
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const *objv)
{
/*
* Table of export modes for methods and their corresponding enum.
*/
static const char *const exportModes[] = {
|
| ︙ | ︙ | |||
2333 2334 2335 2336 2337 2338 2339 |
* ----------------------------------------------------------------------
*/
int
TclOODefineClassMethodObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | 2333 2334 2335 2336 2337 2338 2339 2340 2341 2342 2343 2344 2345 2346 2347 |
* ----------------------------------------------------------------------
*/
int
TclOODefineClassMethodObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const *objv)
{
if (objc != 2 && objc != 4) {
Tcl_WrongNumArgs(interp, 1, objv, "name ?args body?");
return TCL_ERROR;
}
Class *clsPtr = TclOOGetClassDefineCmdContext(interp);
|
| ︙ | ︙ | |||
2399 2400 2401 2402 2403 2404 2405 |
* ----------------------------------------------------------------------
*/
int
TclOODefineRenameMethodObjCmd(
void *clientData,
Tcl_Interp *interp,
| | | 2399 2400 2401 2402 2403 2404 2405 2406 2407 2408 2409 2410 2411 2412 2413 |
* ----------------------------------------------------------------------
*/
int
TclOODefineRenameMethodObjCmd(
void *clientData,
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const *objv)
{
int isInstanceRenameMethod = (clientData != NULL);
Object *oPtr;
if (objc != 3) {
Tcl_WrongNumArgs(interp, 1, objv, "oldName newName");
|
| ︙ | ︙ | |||
2453 2454 2455 2456 2457 2458 2459 |
* ----------------------------------------------------------------------
*/
int
TclOODefineUnexportObjCmd(
void *clientData,
Tcl_Interp *interp,
| | | 2453 2454 2455 2456 2457 2458 2459 2460 2461 2462 2463 2464 2465 2466 2467 |
* ----------------------------------------------------------------------
*/
int
TclOODefineUnexportObjCmd(
void *clientData,
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const *objv)
{
int isInstanceUnexport = (clientData != NULL);
Object *oPtr;
Class *clsPtr;
int i, changed = 0;
|
| ︙ | ︙ | |||
2582 2583 2584 2585 2586 2587 2588 |
Tcl_Class slotCls = (Tcl_Class) ((Object *) object)->classPtr;
if (slotCls == NULL) {
return TCL_ERROR;
}
for (const DeclaredSlotMethod *smPtr = slotMethods; smPtr->name; smPtr++) {
Tcl_Obj *name = Tcl_NewStringObj(smPtr->name, -1);
| | | 2582 2583 2584 2585 2586 2587 2588 2589 2590 2591 2592 2593 2594 2595 2596 |
Tcl_Class slotCls = (Tcl_Class) ((Object *) object)->classPtr;
if (slotCls == NULL) {
return TCL_ERROR;
}
for (const DeclaredSlotMethod *smPtr = slotMethods; smPtr->name; smPtr++) {
Tcl_Obj *name = Tcl_NewStringObj(smPtr->name, -1);
Tcl_NewMethod2(interp, slotCls, name, smPtr->flags,
&smPtr->implType, NULL);
Tcl_BounceRefCount(name);
}
// If a slot can't figure out what method to call directly, it uses
// --default-operation. That defaults to -append; we set that here.
Tcl_Obj *defaults[] = {
|
| ︙ | ︙ | |||
2734 2735 2736 2737 2738 2739 2740 |
* ----------------------------------------------------------------------
*/
static int
Slot_Append(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_ObjectContext context,
| | | 2734 2735 2736 2737 2738 2739 2740 2741 2742 2743 2744 2745 2746 2747 2748 |
* ----------------------------------------------------------------------
*/
static int
Slot_Append(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_ObjectContext context,
Tcl_Size objc,
Tcl_Obj *const *objv)
{
Object *oPtr = (Object *) Tcl_ObjectContextObject(context);
Tcl_Size skip = Tcl_ObjectContextSkippedArgs(context);
if (skip == objc) {
return TCL_OK;
}
|
| ︙ | ︙ | |||
2792 2793 2794 2795 2796 2797 2798 |
* ----------------------------------------------------------------------
*/
static int
Slot_AppendNew(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_ObjectContext context,
| | | 2792 2793 2794 2795 2796 2797 2798 2799 2800 2801 2802 2803 2804 2805 2806 |
* ----------------------------------------------------------------------
*/
static int
Slot_AppendNew(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_ObjectContext context,
Tcl_Size objc,
Tcl_Obj *const *objv)
{
Object *oPtr = (Object *) Tcl_ObjectContextObject(context);
Tcl_Size skip = Tcl_ObjectContextSkippedArgs(context);
if (skip == objc) {
return TCL_OK;
}
|
| ︙ | ︙ | |||
2868 2869 2870 2871 2872 2873 2874 |
* ----------------------------------------------------------------------
*/
static int
Slot_Clear(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_ObjectContext context,
| | | 2868 2869 2870 2871 2872 2873 2874 2875 2876 2877 2878 2879 2880 2881 2882 |
* ----------------------------------------------------------------------
*/
static int
Slot_Clear(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_ObjectContext context,
Tcl_Size objc,
Tcl_Obj *const *objv)
{
Object *oPtr = (Object *) Tcl_ObjectContextObject(context);
Tcl_Size skip = Tcl_ObjectContextSkippedArgs(context);
if (skip != objc) {
Tcl_WrongNumArgs(interp, skip, objv, NULL);
return TCL_ERROR;
|
| ︙ | ︙ | |||
2898 2899 2900 2901 2902 2903 2904 |
* ----------------------------------------------------------------------
*/
static int
Slot_Prepend(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_ObjectContext context,
| | | 2898 2899 2900 2901 2902 2903 2904 2905 2906 2907 2908 2909 2910 2911 2912 |
* ----------------------------------------------------------------------
*/
static int
Slot_Prepend(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_ObjectContext context,
Tcl_Size objc,
Tcl_Obj *const *objv)
{
Object *oPtr = (Object *) Tcl_ObjectContextObject(context);
Tcl_Size skip = Tcl_ObjectContextSkippedArgs(context);
if (skip == objc) {
return TCL_OK;
}
|
| ︙ | ︙ | |||
2943 2944 2945 2946 2947 2948 2949 |
* ----------------------------------------------------------------------
*/
static int
Slot_Remove(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_ObjectContext context,
| | | 2943 2944 2945 2946 2947 2948 2949 2950 2951 2952 2953 2954 2955 2956 2957 |
* ----------------------------------------------------------------------
*/
static int
Slot_Remove(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_ObjectContext context,
Tcl_Size objc,
Tcl_Obj *const *objv)
{
Object *oPtr = (Object *) Tcl_ObjectContextObject(context);
Tcl_Size skip = Tcl_ObjectContextSkippedArgs(context);
if (skip == objc) {
return TCL_OK;
}
|
| ︙ | ︙ | |||
3015 3016 3017 3018 3019 3020 3021 |
* ----------------------------------------------------------------------
*/
static int
Slot_Resolve(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_ObjectContext context,
| | | 3015 3016 3017 3018 3019 3020 3021 3022 3023 3024 3025 3026 3027 3028 3029 |
* ----------------------------------------------------------------------
*/
static int
Slot_Resolve(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_ObjectContext context,
Tcl_Size objc,
Tcl_Obj *const *objv)
{
Tcl_Size skip = Tcl_ObjectContextSkippedArgs(context);
if (skip + 1 != objc) {
Tcl_WrongNumArgs(interp, skip, objv, "list");
return TCL_ERROR;
}
|
| ︙ | ︙ | |||
3041 3042 3043 3044 3045 3046 3047 |
* ----------------------------------------------------------------------
*/
static int
Slot_Set(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_ObjectContext context,
| | | 3041 3042 3043 3044 3045 3046 3047 3048 3049 3050 3051 3052 3053 3054 3055 |
* ----------------------------------------------------------------------
*/
static int
Slot_Set(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_ObjectContext context,
Tcl_Size objc,
Tcl_Obj *const *objv)
{
Object *oPtr = (Object *) Tcl_ObjectContextObject(context);
Tcl_Size skip = Tcl_ObjectContextSkippedArgs(context);
Tcl_Obj *list;
// Resolve all values
|
| ︙ | ︙ | |||
3080 3081 3082 3083 3084 3085 3086 |
* ----------------------------------------------------------------------
*/
static int
Slot_Unimplemented(
TCL_UNUSED(void *),
Tcl_Interp *interp,
TCL_UNUSED(Tcl_ObjectContext),
| | | 3080 3081 3082 3083 3084 3085 3086 3087 3088 3089 3090 3091 3092 3093 3094 |
* ----------------------------------------------------------------------
*/
static int
Slot_Unimplemented(
TCL_UNUSED(void *),
Tcl_Interp *interp,
TCL_UNUSED(Tcl_ObjectContext),
TCL_UNUSED(Tcl_Size),
TCL_UNUSED(Tcl_Obj *const *))
{
Tcl_SetObjResult(interp, Tcl_NewStringObj("unimplemented", -1));
OO_ERROR(interp, ABSTRACT_SLOT);
return TCL_ERROR;
}
|
| ︙ | ︙ | |||
3104 3105 3106 3107 3108 3109 3110 |
* ----------------------------------------------------------------------
*/
static int
Slot_Unknown(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_ObjectContext context,
| | | 3104 3105 3106 3107 3108 3109 3110 3111 3112 3113 3114 3115 3116 3117 3118 |
* ----------------------------------------------------------------------
*/
static int
Slot_Unknown(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_ObjectContext context,
Tcl_Size objc,
Tcl_Obj *const *objv)
{
Object *oPtr = (Object *) Tcl_ObjectContextObject(context);
Tcl_Size skip = Tcl_ObjectContextSkippedArgs(context);
if (skip >= objc) {
Tcl_Obj *args[] = {
oPtr->fPtr->myName,
|
| ︙ | ︙ | |||
3179 3180 3181 3182 3183 3184 3185 |
*/
static int
ClassFilter_Get(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_ObjectContext context,
| | | 3179 3180 3181 3182 3183 3184 3185 3186 3187 3188 3189 3190 3191 3192 3193 |
*/
static int
ClassFilter_Get(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_ObjectContext context,
Tcl_Size objc,
Tcl_Obj *const *objv)
{
Class *clsPtr = TclOOGetClassDefineCmdContext(interp);
Tcl_Obj *resultObj, *filterObj;
Tcl_Size i;
if (clsPtr == NULL) {
|
| ︙ | ︙ | |||
3207 3208 3209 3210 3211 3212 3213 |
}
static int
ClassFilter_Set(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_ObjectContext context,
| | | 3207 3208 3209 3210 3211 3212 3213 3214 3215 3216 3217 3218 3219 3220 3221 |
}
static int
ClassFilter_Set(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_ObjectContext context,
Tcl_Size objc,
Tcl_Obj *const *objv)
{
Class *clsPtr = TclOOGetClassDefineCmdContext(interp);
Tcl_Size filterc;
Tcl_Obj **filterv;
if (clsPtr == NULL) {
|
| ︙ | ︙ | |||
3248 3249 3250 3251 3252 3253 3254 |
*/
static int
ClassMixin_Get(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_ObjectContext context,
| | | 3248 3249 3250 3251 3252 3253 3254 3255 3256 3257 3258 3259 3260 3261 3262 |
*/
static int
ClassMixin_Get(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_ObjectContext context,
Tcl_Size objc,
Tcl_Obj *const *objv)
{
Class *clsPtr = TclOOGetClassDefineCmdContext(interp);
Tcl_Obj *resultObj;
Class *mixinPtr;
Tcl_Size i;
|
| ︙ | ︙ | |||
3278 3279 3280 3281 3282 3283 3284 |
}
static int
ClassMixin_Set(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_ObjectContext context,
| | | 3278 3279 3280 3281 3282 3283 3284 3285 3286 3287 3288 3289 3290 3291 3292 |
}
static int
ClassMixin_Set(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_ObjectContext context,
Tcl_Size objc,
Tcl_Obj *const *objv)
{
Class *clsPtr = TclOOGetClassDefineCmdContext(interp);
Tcl_Size mixinc, i;
Tcl_Obj **mixinv;
Class **mixins; /* The references to the classes to actually
* install. */
|
| ︙ | ︙ | |||
3314 3315 3316 3317 3318 3319 3320 |
for (i = 0; i < mixinc; i++) {
mixins[i] = GetClassInOuterContext(interp, mixinv[i],
"may only mix in classes");
if (mixins[i] == NULL) {
i--;
goto freeAndError;
}
| | | 3314 3315 3316 3317 3318 3319 3320 3321 3322 3323 3324 3325 3326 3327 3328 |
for (i = 0; i < mixinc; i++) {
mixins[i] = GetClassInOuterContext(interp, mixinv[i],
"may only mix in classes");
if (mixins[i] == NULL) {
i--;
goto freeAndError;
}
(void) Tcl_CreateHashEntry(&uniqueCheck, mixins[i], &isNew);
if (!isNew) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"class should only be a direct mixin once",
TCL_AUTO_LENGTH));
OO_ERROR(interp, REPETITIOUS);
goto freeAndError;
}
|
| ︙ | ︙ | |||
3357 3358 3359 3360 3361 3362 3363 |
*/
static int
ClassSuper_Get(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_ObjectContext context,
| | | 3357 3358 3359 3360 3361 3362 3363 3364 3365 3366 3367 3368 3369 3370 3371 |
*/
static int
ClassSuper_Get(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_ObjectContext context,
Tcl_Size objc,
Tcl_Obj *const *objv)
{
Class *clsPtr = TclOOGetClassDefineCmdContext(interp);
Tcl_Obj *resultObj;
Class *superPtr;
Tcl_Size i;
|
| ︙ | ︙ | |||
3387 3388 3389 3390 3391 3392 3393 |
}
static int
ClassSuper_Set(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_ObjectContext context,
| | | 3387 3388 3389 3390 3391 3392 3393 3394 3395 3396 3397 3398 3399 3400 3401 |
}
static int
ClassSuper_Set(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_ObjectContext context,
Tcl_Size objc,
Tcl_Obj *const *objv)
{
Class *clsPtr = TclOOGetClassDefineCmdContext(interp);
Tcl_Size superc, j;
Tcl_Size i;
Tcl_Obj **superv;
|
| ︙ | ︙ | |||
3505 3506 3507 3508 3509 3510 3511 |
*/
static int
ClassVars_Get(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_ObjectContext context,
| | | 3505 3506 3507 3508 3509 3510 3511 3512 3513 3514 3515 3516 3517 3518 3519 |
*/
static int
ClassVars_Get(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_ObjectContext context,
Tcl_Size objc,
Tcl_Obj *const *objv)
{
Class *clsPtr = TclOOGetClassDefineCmdContext(interp);
Tcl_Obj *resultObj;
Tcl_Size i;
if (clsPtr == NULL) {
|
| ︙ | ︙ | |||
3543 3544 3545 3546 3547 3548 3549 |
}
static int
ClassVars_Set(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_ObjectContext context,
| | | 3543 3544 3545 3546 3547 3548 3549 3550 3551 3552 3553 3554 3555 3556 3557 |
}
static int
ClassVars_Set(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_ObjectContext context,
Tcl_Size objc,
Tcl_Obj *const *objv)
{
Class *clsPtr = TclOOGetClassDefineCmdContext(interp);
Tcl_Size i;
Tcl_Size varc;
Tcl_Obj **varv;
|
| ︙ | ︙ | |||
3595 3596 3597 3598 3599 3600 3601 |
*/
static int
ObjFilter_Get(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_ObjectContext context,
| | | 3595 3596 3597 3598 3599 3600 3601 3602 3603 3604 3605 3606 3607 3608 3609 |
*/
static int
ObjFilter_Get(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_ObjectContext context,
Tcl_Size objc,
Tcl_Obj *const *objv)
{
Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
Tcl_Obj *resultObj, *filterObj;
Tcl_Size i;
if (Tcl_ObjectContextSkippedArgs(context) != objc) {
|
| ︙ | ︙ | |||
3623 3624 3625 3626 3627 3628 3629 |
}
static int
ObjFilter_Set(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_ObjectContext context,
| | | 3623 3624 3625 3626 3627 3628 3629 3630 3631 3632 3633 3634 3635 3636 3637 |
}
static int
ObjFilter_Set(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_ObjectContext context,
Tcl_Size objc,
Tcl_Obj *const *objv)
{
Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
Tcl_Size filterc;
Tcl_Obj **filterv;
if (Tcl_ObjectContextSkippedArgs(context) + 1 != objc) {
|
| ︙ | ︙ | |||
3662 3663 3664 3665 3666 3667 3668 |
*/
static int
ObjMixin_Get(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_ObjectContext context,
| | | 3662 3663 3664 3665 3666 3667 3668 3669 3670 3671 3672 3673 3674 3675 3676 |
*/
static int
ObjMixin_Get(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_ObjectContext context,
Tcl_Size objc,
Tcl_Obj *const *objv)
{
Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
Tcl_Obj *resultObj;
Class *mixinPtr;
Tcl_Size i;
|
| ︙ | ︙ | |||
3694 3695 3696 3697 3698 3699 3700 |
}
static int
ObjMixin_Set(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_ObjectContext context,
| | | 3694 3695 3696 3697 3698 3699 3700 3701 3702 3703 3704 3705 3706 3707 3708 |
}
static int
ObjMixin_Set(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_ObjectContext context,
Tcl_Size objc,
Tcl_Obj *const *objv)
{
Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
Tcl_Size mixinc, i;
Tcl_Obj **mixinv;
Class **mixins; /* The references to the classes to actually
* install. */
|
| ︙ | ︙ | |||
3728 3729 3730 3731 3732 3733 3734 |
for (i = 0; i < mixinc; i++) {
mixins[i] = GetClassInOuterContext(interp, mixinv[i],
"may only mix in classes");
if (mixins[i] == NULL) {
goto freeAndError;
}
| | | 3728 3729 3730 3731 3732 3733 3734 3735 3736 3737 3738 3739 3740 3741 3742 |
for (i = 0; i < mixinc; i++) {
mixins[i] = GetClassInOuterContext(interp, mixinv[i],
"may only mix in classes");
if (mixins[i] == NULL) {
goto freeAndError;
}
(void) Tcl_CreateHashEntry(&uniqueCheck, mixins[i], &isNew);
if (!isNew) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"class should only be a direct mixin once",
TCL_AUTO_LENGTH));
OO_ERROR(interp, REPETITIOUS);
goto freeAndError;
}
|
| ︙ | ︙ | |||
3765 3766 3767 3768 3769 3770 3771 |
*/
static int
ObjVars_Get(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_ObjectContext context,
| | | 3765 3766 3767 3768 3769 3770 3771 3772 3773 3774 3775 3776 3777 3778 3779 |
*/
static int
ObjVars_Get(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_ObjectContext context,
Tcl_Size objc,
Tcl_Obj *const *objv)
{
Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
Tcl_Obj *resultObj;
Tcl_Size i;
if (Tcl_ObjectContextSkippedArgs(context) != objc) {
|
| ︙ | ︙ | |||
3803 3804 3805 3806 3807 3808 3809 |
}
static int
ObjVars_Set(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_ObjectContext context,
| | | 3803 3804 3805 3806 3807 3808 3809 3810 3811 3812 3813 3814 3815 3816 3817 |
}
static int
ObjVars_Set(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_ObjectContext context,
Tcl_Size objc,
Tcl_Obj *const *objv)
{
Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
Tcl_Size varc, i;
Tcl_Obj **varv;
if (Tcl_ObjectContextSkippedArgs(context) + 1 != objc) {
|
| ︙ | ︙ | |||
3854 3855 3856 3857 3858 3859 3860 |
*/
static int
Slot_ResolveClass(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_ObjectContext context,
| | | 3854 3855 3856 3857 3858 3859 3860 3861 3862 3863 3864 3865 3866 3867 3868 |
*/
static int
Slot_ResolveClass(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_ObjectContext context,
Tcl_Size objc,
Tcl_Obj *const *objv)
{
Tcl_Size idx = Tcl_ObjectContextSkippedArgs(context);
Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
Class *clsPtr;
/*
|
| ︙ | ︙ | |||
3907 3908 3909 3910 3911 3912 3913 |
*/
static int
Configurable_ClassReadableProps_Get(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_ObjectContext context,
| | | 3907 3908 3909 3910 3911 3912 3913 3914 3915 3916 3917 3918 3919 3920 3921 |
*/
static int
Configurable_ClassReadableProps_Get(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_ObjectContext context,
Tcl_Size objc,
Tcl_Obj *const *objv)
{
Class *clsPtr = TclOOGetClassDefineCmdContext(interp);
if (clsPtr == NULL) {
return TCL_ERROR;
} else if (Tcl_ObjectContextSkippedArgs(context) != objc) {
|
| ︙ | ︙ | |||
3929 3930 3931 3932 3933 3934 3935 |
}
static int
Configurable_ClassReadableProps_Set(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_ObjectContext context,
| | | 3929 3930 3931 3932 3933 3934 3935 3936 3937 3938 3939 3940 3941 3942 3943 |
}
static int
Configurable_ClassReadableProps_Set(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_ObjectContext context,
Tcl_Size objc,
Tcl_Obj *const *objv)
{
Class *clsPtr = TclOOGetClassDefineCmdContext(interp);
Tcl_Size varc;
Tcl_Obj **varv;
if (clsPtr == NULL) {
|
| ︙ | ︙ | |||
3959 3960 3961 3962 3963 3964 3965 |
}
static int
Configurable_ObjectReadableProps_Get(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_ObjectContext context,
| | | 3959 3960 3961 3962 3963 3964 3965 3966 3967 3968 3969 3970 3971 3972 3973 |
}
static int
Configurable_ObjectReadableProps_Get(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_ObjectContext context,
Tcl_Size objc,
Tcl_Obj *const *objv)
{
Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
if (oPtr == NULL) {
return TCL_ERROR;
} else if (Tcl_ObjectContextSkippedArgs(context) != objc) {
|
| ︙ | ︙ | |||
3981 3982 3983 3984 3985 3986 3987 |
}
static int
Configurable_ObjectReadableProps_Set(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_ObjectContext context,
| | | 3981 3982 3983 3984 3985 3986 3987 3988 3989 3990 3991 3992 3993 3994 3995 |
}
static int
Configurable_ObjectReadableProps_Set(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_ObjectContext context,
Tcl_Size objc,
Tcl_Obj *const *objv)
{
Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
Tcl_Size varc;
Tcl_Obj **varv;
if (Tcl_ObjectContextSkippedArgs(context) + 1 != objc) {
|
| ︙ | ︙ | |||
4023 4024 4025 4026 4027 4028 4029 |
*/
static int
Configurable_ClassWritableProps_Get(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_ObjectContext context,
| | | 4023 4024 4025 4026 4027 4028 4029 4030 4031 4032 4033 4034 4035 4036 4037 |
*/
static int
Configurable_ClassWritableProps_Get(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_ObjectContext context,
Tcl_Size objc,
Tcl_Obj *const *objv)
{
Class *clsPtr = TclOOGetClassDefineCmdContext(interp);
if (clsPtr == NULL) {
return TCL_ERROR;
} else if (Tcl_ObjectContextSkippedArgs(context) != objc) {
|
| ︙ | ︙ | |||
4045 4046 4047 4048 4049 4050 4051 |
}
static int
Configurable_ClassWritableProps_Set(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_ObjectContext context,
| | | 4045 4046 4047 4048 4049 4050 4051 4052 4053 4054 4055 4056 4057 4058 4059 |
}
static int
Configurable_ClassWritableProps_Set(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_ObjectContext context,
Tcl_Size objc,
Tcl_Obj *const *objv)
{
Class *clsPtr = TclOOGetClassDefineCmdContext(interp);
Tcl_Size varc;
Tcl_Obj **varv;
if (clsPtr == NULL) {
|
| ︙ | ︙ | |||
4075 4076 4077 4078 4079 4080 4081 |
}
static int
Configurable_ObjectWritableProps_Get(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_ObjectContext context,
| | | 4075 4076 4077 4078 4079 4080 4081 4082 4083 4084 4085 4086 4087 4088 4089 |
}
static int
Configurable_ObjectWritableProps_Get(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_ObjectContext context,
Tcl_Size objc,
Tcl_Obj *const *objv)
{
Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
if (oPtr == NULL) {
return TCL_ERROR;
} else if (Tcl_ObjectContextSkippedArgs(context) != objc) {
|
| ︙ | ︙ | |||
4097 4098 4099 4100 4101 4102 4103 |
}
static int
Configurable_ObjectWritableProps_Set(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_ObjectContext context,
| | | 4097 4098 4099 4100 4101 4102 4103 4104 4105 4106 4107 4108 4109 4110 4111 |
}
static int
Configurable_ObjectWritableProps_Set(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_ObjectContext context,
Tcl_Size objc,
Tcl_Obj *const *objv)
{
Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
Tcl_Size varc;
Tcl_Obj **varv;
if (Tcl_ObjectContextSkippedArgs(context) + 1 != objc) {
|
| ︙ | ︙ |
Changes to generic/tclOOInfo.c.
| ︙ | ︙ | |||
12 13 14 15 16 17 18 | #ifdef HAVE_CONFIG_H #include "config.h" #endif #include "tclInt.h" #include "tclOOInt.h" | | | | | < | | | | | | | | | | | | | | | | > | | | | | | | 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 |
#ifdef HAVE_CONFIG_H
#include "config.h"
#endif
#include "tclInt.h"
#include "tclOOInt.h"
static Tcl_ObjCmdProc2 InfoObjectCallCmd;
static Tcl_ObjCmdProc2 InfoObjectClassCmd;
static Tcl_ObjCmdProc2 InfoObjectDefnCmd;
static Tcl_ObjCmdProc2 InfoObjectFiltersCmd;
static Tcl_ObjCmdProc2 InfoObjectForwardCmd;
static Tcl_ObjCmdProc2 InfoObjectIdCmd;
static Tcl_ObjCmdProc2 InfoObjectIsACmd;
static Tcl_ObjCmdProc2 InfoObjectMethodsCmd;
static Tcl_ObjCmdProc2 InfoObjectMethodTypeCmd;
static Tcl_ObjCmdProc2 InfoObjectMixinsCmd;
static Tcl_ObjCmdProc2 InfoObjectNsCmd;
static Tcl_ObjCmdProc2 InfoObjectVarsCmd;
static Tcl_ObjCmdProc2 InfoObjectVariablesCmd;
static Tcl_ObjCmdProc2 InfoClassCallCmd;
static Tcl_ObjCmdProc2 InfoClassConstrCmd;
static Tcl_ObjCmdProc2 InfoClassDefnCmd;
static Tcl_ObjCmdProc2 InfoClassDefnNsCmd;
static Tcl_ObjCmdProc2 InfoClassDestrCmd;
static Tcl_ObjCmdProc2 InfoClassFiltersCmd;
static Tcl_ObjCmdProc2 InfoClassForwardCmd;
static Tcl_ObjCmdProc2 InfoClassInstancesCmd;
static Tcl_ObjCmdProc2 InfoClassMethodsCmd;
static Tcl_ObjCmdProc2 InfoClassMethodTypeCmd;
static Tcl_ObjCmdProc2 InfoClassMixinsCmd;
static Tcl_ObjCmdProc2 InfoClassSubsCmd;
static Tcl_ObjCmdProc2 InfoClassSupersCmd;
static Tcl_ObjCmdProc2 InfoClassVariablesCmd;
/*
* List of commands that are used to implement the [info object] subcommands.
*/
static const EnsembleImplMap infoObjectImplMap[] = {
{"call", InfoObjectCallCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0},
{"class", InfoObjectClassCmd, TclCompileInfoObjectClassCmd, NULL, NULL, 0},
|
| ︙ | ︙ | |||
211 212 213 214 215 216 217 |
Tcl_HashEntry *hPtr = Tcl_FindHashEntry(&clsPtr->classMethods, methodName);
Method *mPtr;
if (hPtr == NULL) {
goto unknownMethod;
}
mPtr = (Method *)Tcl_GetHashValue(hPtr);
| | | 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 |
Tcl_HashEntry *hPtr = Tcl_FindHashEntry(&clsPtr->classMethods, methodName);
Method *mPtr;
if (hPtr == NULL) {
goto unknownMethod;
}
mPtr = (Method *)Tcl_GetHashValue(hPtr);
if (mPtr->type2Ptr == NULL) {
/*
* Special entry for visibility control: pretend the method doesnt
* exist.
*/
goto unknownMethod;
}
|
| ︙ | ︙ | |||
255 256 257 258 259 260 261 |
goto unknownMethod;
}
hPtr = Tcl_FindHashEntry(oPtr->methodsPtr, methodName);
if (hPtr == NULL) {
goto unknownMethod;
}
mPtr = (Method *)Tcl_GetHashValue(hPtr);
| | | 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 |
goto unknownMethod;
}
hPtr = Tcl_FindHashEntry(oPtr->methodsPtr, methodName);
if (hPtr == NULL) {
goto unknownMethod;
}
mPtr = (Method *)Tcl_GetHashValue(hPtr);
if (mPtr->type2Ptr == NULL) {
/*
* Special entry for visibility control: pretend the method doesnt
* exist.
*/
goto unknownMethod;
}
|
| ︙ | ︙ | |||
337 338 339 340 341 342 343 |
* ----------------------------------------------------------------------
*/
static int
InfoObjectClassCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 |
* ----------------------------------------------------------------------
*/
static int
InfoObjectClassCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const objv[])
{
Object *oPtr;
if (objc != 2 && objc != 3) {
Tcl_WrongNumArgs(interp, 1, objv, "objName ?className?");
return TCL_ERROR;
|
| ︙ | ︙ | |||
394 395 396 397 398 399 400 |
* ----------------------------------------------------------------------
*/
static int
InfoObjectDefnCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 |
* ----------------------------------------------------------------------
*/
static int
InfoObjectDefnCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const objv[])
{
Object *oPtr;
Method *mPtr;
Proc *procPtr;
Tcl_Obj *resultObjs[2];
|
| ︙ | ︙ | |||
445 446 447 448 449 450 451 |
* ----------------------------------------------------------------------
*/
static int
InfoObjectFiltersCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 |
* ----------------------------------------------------------------------
*/
static int
InfoObjectFiltersCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const objv[])
{
Tcl_Size i;
Tcl_Obj *filterObj, *resultObj;
Object *oPtr;
if (objc != 2) {
|
| ︙ | ︙ | |||
484 485 486 487 488 489 490 |
* ----------------------------------------------------------------------
*/
static int
InfoObjectForwardCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 |
* ----------------------------------------------------------------------
*/
static int
InfoObjectForwardCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const objv[])
{
Object *oPtr;
Method *mPtr;
Tcl_Obj *prefixObj;
if (objc != 3) {
|
| ︙ | ︙ | |||
531 532 533 534 535 536 537 |
* ----------------------------------------------------------------------
*/
static int
InfoObjectIsACmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 |
* ----------------------------------------------------------------------
*/
static int
InfoObjectIsACmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const objv[])
{
static const char *const categories[] = {
"class", "metaclass", "mixin", "object", "typeof", NULL
};
enum IsACats {
IsClass, IsMetaclass, IsMixin, IsObject, IsType
|
| ︙ | ︙ | |||
655 656 657 658 659 660 661 |
* ----------------------------------------------------------------------
*/
static int
InfoObjectMethodsCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 |
* ----------------------------------------------------------------------
*/
static int
InfoObjectMethodsCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const objv[])
{
static const char *const options[] = {
"-all", "-localprivate", "-private", "-scope", NULL
};
enum Options {
OPT_ALL, OPT_LOCALPRIVATE, OPT_PRIVATE, OPT_SCOPE
|
| ︙ | ︙ | |||
765 766 767 768 769 770 771 |
if (scope == SCOPE_DEFAULT) {
/*
* Handle legacy-mode matching. [Bug 36e5517a6850]
*/
int scopeFilter = flag | TRUE_PRIVATE_METHOD;
FOREACH_HASH(namePtr, mPtr, oPtr->methodsPtr) {
| | | | 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 |
if (scope == SCOPE_DEFAULT) {
/*
* Handle legacy-mode matching. [Bug 36e5517a6850]
*/
int scopeFilter = flag | TRUE_PRIVATE_METHOD;
FOREACH_HASH(namePtr, mPtr, oPtr->methodsPtr) {
if (mPtr->type2Ptr && (mPtr->flags & scopeFilter) == flag) {
Tcl_ListObjAppendElement(NULL, resultObj, namePtr);
}
}
} else {
FOREACH_HASH(namePtr, mPtr, oPtr->methodsPtr) {
if (mPtr->type2Ptr && (mPtr->flags & SCOPE_FLAGS) == flag) {
Tcl_ListObjAppendElement(NULL, resultObj, namePtr);
}
}
}
}
Tcl_SetObjResult(interp, resultObj);
return TCL_OK;
|
| ︙ | ︙ | |||
795 796 797 798 799 800 801 |
* ----------------------------------------------------------------------
*/
static int
InfoObjectMethodTypeCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | | | 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 |
* ----------------------------------------------------------------------
*/
static int
InfoObjectMethodTypeCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const objv[])
{
Object *oPtr;
Method *mPtr;
if (objc != 3) {
Tcl_WrongNumArgs(interp, 1, objv, "objName methodName");
return TCL_ERROR;
}
oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[1]);
if (oPtr == NULL) {
return TCL_ERROR;
}
mPtr = GetInstanceMethodFromObj(interp, oPtr, objv[2]);
if (mPtr == NULL) {
return TCL_ERROR;
}
Tcl_SetObjResult(interp,
Tcl_NewStringObj(mPtr->type2Ptr->name, TCL_AUTO_LENGTH));
return TCL_OK;
}
/*
* ----------------------------------------------------------------------
*
* InfoObjectMixinsCmd --
*
* Implements [info object mixins $objName]
*
* ----------------------------------------------------------------------
*/
static int
InfoObjectMixinsCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const objv[])
{
Class *mixinPtr;
Object *oPtr;
Tcl_Obj *resultObj;
Tcl_Size i;
|
| ︙ | ︙ | |||
877 878 879 880 881 882 883 |
* ----------------------------------------------------------------------
*/
static int
InfoObjectIdCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 |
* ----------------------------------------------------------------------
*/
static int
InfoObjectIdCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const objv[])
{
Object *oPtr;
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "objName");
return TCL_ERROR;
|
| ︙ | ︙ | |||
909 910 911 912 913 914 915 |
* ----------------------------------------------------------------------
*/
static int
InfoObjectNsCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | 909 910 911 912 913 914 915 916 917 918 919 920 921 922 923 |
* ----------------------------------------------------------------------
*/
static int
InfoObjectNsCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const objv[])
{
Object *oPtr;
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "objName");
return TCL_ERROR;
|
| ︙ | ︙ | |||
941 942 943 944 945 946 947 |
* ----------------------------------------------------------------------
*/
static int
InfoObjectVariablesCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | 941 942 943 944 945 946 947 948 949 950 951 952 953 954 955 |
* ----------------------------------------------------------------------
*/
static int
InfoObjectVariablesCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const objv[])
{
Object *oPtr;
Tcl_Obj *resultObj;
Tcl_Size i;
int isPrivate = 0;
|
| ︙ | ︙ | |||
1000 1001 1002 1003 1004 1005 1006 |
* ----------------------------------------------------------------------
*/
static int
InfoObjectVarsCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | 1000 1001 1002 1003 1004 1005 1006 1007 1008 1009 1010 1011 1012 1013 1014 |
* ----------------------------------------------------------------------
*/
static int
InfoObjectVarsCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const objv[])
{
Object *oPtr;
const char *pattern = NULL;
FOREACH_HASH_DECLS;
VarInHash *vihPtr;
Tcl_Obj *nameObj, *resultObj;
|
| ︙ | ︙ | |||
1061 1062 1063 1064 1065 1066 1067 |
* ----------------------------------------------------------------------
*/
static int
InfoClassConstrCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 |
* ----------------------------------------------------------------------
*/
static int
InfoClassConstrCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const objv[])
{
Proc *procPtr;
Tcl_Obj *resultObjs[2];
Class *clsPtr;
if (objc != 2) {
|
| ︙ | ︙ | |||
1104 1105 1106 1107 1108 1109 1110 |
* ----------------------------------------------------------------------
*/
static int
InfoClassDefnCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | 1104 1105 1106 1107 1108 1109 1110 1111 1112 1113 1114 1115 1116 1117 1118 |
* ----------------------------------------------------------------------
*/
static int
InfoClassDefnCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const objv[])
{
Method *mPtr;
Proc *procPtr;
Tcl_Obj *resultObjs[2];
Class *clsPtr;
|
| ︙ | ︙ | |||
1149 1150 1151 1152 1153 1154 1155 |
* ----------------------------------------------------------------------
*/
static int
InfoClassDefnNsCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | 1149 1150 1151 1152 1153 1154 1155 1156 1157 1158 1159 1160 1161 1162 1163 |
* ----------------------------------------------------------------------
*/
static int
InfoClassDefnNsCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const objv[])
{
static const char *kindList[] = {
"-class",
"-instance",
NULL
};
|
| ︙ | ︙ | |||
1199 1200 1201 1202 1203 1204 1205 |
* ----------------------------------------------------------------------
*/
static int
InfoClassDestrCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | 1199 1200 1201 1202 1203 1204 1205 1206 1207 1208 1209 1210 1211 1212 1213 |
* ----------------------------------------------------------------------
*/
static int
InfoClassDestrCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const objv[])
{
Proc *procPtr;
Class *clsPtr;
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "className");
|
| ︙ | ︙ | |||
1240 1241 1242 1243 1244 1245 1246 |
* ----------------------------------------------------------------------
*/
static int
InfoClassFiltersCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | 1240 1241 1242 1243 1244 1245 1246 1247 1248 1249 1250 1251 1252 1253 1254 |
* ----------------------------------------------------------------------
*/
static int
InfoClassFiltersCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const objv[])
{
Tcl_Size i;
Tcl_Obj *filterObj, *resultObj;
Class *clsPtr;
if (objc != 2) {
|
| ︙ | ︙ | |||
1278 1279 1280 1281 1282 1283 1284 |
* ----------------------------------------------------------------------
*/
static int
InfoClassForwardCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | 1278 1279 1280 1281 1282 1283 1284 1285 1286 1287 1288 1289 1290 1291 1292 |
* ----------------------------------------------------------------------
*/
static int
InfoClassForwardCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const objv[])
{
Method *mPtr;
Tcl_Obj *prefixObj;
Class *clsPtr;
if (objc != 3) {
|
| ︙ | ︙ | |||
1320 1321 1322 1323 1324 1325 1326 |
* ----------------------------------------------------------------------
*/
static int
InfoClassInstancesCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | 1320 1321 1322 1323 1324 1325 1326 1327 1328 1329 1330 1331 1332 1333 1334 |
* ----------------------------------------------------------------------
*/
static int
InfoClassInstancesCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const objv[])
{
Object *oPtr;
Class *clsPtr;
Tcl_Size i;
const char *pattern = NULL;
Tcl_Obj *resultObj;
|
| ︙ | ︙ | |||
1368 1369 1370 1371 1372 1373 1374 |
* ----------------------------------------------------------------------
*/
static int
InfoClassMethodsCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | 1368 1369 1370 1371 1372 1373 1374 1375 1376 1377 1378 1379 1380 1381 1382 |
* ----------------------------------------------------------------------
*/
static int
InfoClassMethodsCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const objv[])
{
static const char *const options[] = {
"-all", "-localprivate", "-private", "-scope", NULL
};
enum Options {
OPT_ALL, OPT_LOCALPRIVATE, OPT_PRIVATE, OPT_SCOPE
|
| ︙ | ︙ | |||
1469 1470 1471 1472 1473 1474 1475 |
if (scope == SCOPE_DEFAULT) {
/*
* Handle legacy-mode matching. [Bug 36e5517a6850]
*/
int scopeFilter = flag | TRUE_PRIVATE_METHOD;
FOREACH_HASH(namePtr, mPtr, &clsPtr->classMethods) {
| | | | 1469 1470 1471 1472 1473 1474 1475 1476 1477 1478 1479 1480 1481 1482 1483 1484 1485 1486 1487 1488 1489 |
if (scope == SCOPE_DEFAULT) {
/*
* Handle legacy-mode matching. [Bug 36e5517a6850]
*/
int scopeFilter = flag | TRUE_PRIVATE_METHOD;
FOREACH_HASH(namePtr, mPtr, &clsPtr->classMethods) {
if (mPtr->type2Ptr && (mPtr->flags & scopeFilter) == flag) {
Tcl_ListObjAppendElement(NULL, resultObj, namePtr);
}
}
} else {
FOREACH_HASH(namePtr, mPtr, &clsPtr->classMethods) {
if (mPtr->type2Ptr && (mPtr->flags & SCOPE_FLAGS) == flag) {
Tcl_ListObjAppendElement(NULL, resultObj, namePtr);
}
}
}
}
Tcl_SetObjResult(interp, resultObj);
return TCL_OK;
|
| ︙ | ︙ | |||
1499 1500 1501 1502 1503 1504 1505 |
* ----------------------------------------------------------------------
*/
static int
InfoClassMethodTypeCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | | | 1499 1500 1501 1502 1503 1504 1505 1506 1507 1508 1509 1510 1511 1512 1513 1514 1515 1516 1517 1518 1519 1520 1521 1522 1523 1524 1525 1526 1527 1528 1529 1530 1531 1532 1533 1534 1535 1536 1537 1538 1539 1540 1541 1542 1543 1544 1545 1546 1547 1548 1549 1550 1551 |
* ----------------------------------------------------------------------
*/
static int
InfoClassMethodTypeCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const objv[])
{
Method *mPtr;
Class *clsPtr;
if (objc != 3) {
Tcl_WrongNumArgs(interp, 1, objv, "className methodName");
return TCL_ERROR;
}
clsPtr = TclOOGetClassFromObj(interp, objv[1]);
if (clsPtr == NULL) {
return TCL_ERROR;
}
mPtr = GetClassMethodFromObj(interp, clsPtr, objv[2]);
if (mPtr == NULL) {
return TCL_ERROR;
}
Tcl_SetObjResult(interp,
Tcl_NewStringObj(mPtr->type2Ptr->name, TCL_AUTO_LENGTH));
return TCL_OK;
}
/*
* ----------------------------------------------------------------------
*
* InfoClassMixinsCmd --
*
* Implements [info class mixins $clsName]
*
* ----------------------------------------------------------------------
*/
static int
InfoClassMixinsCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const objv[])
{
Class *clsPtr, *mixinPtr;
Tcl_Obj *resultObj;
Tcl_Size i;
if (objc != 2) {
|
| ︙ | ︙ | |||
1579 1580 1581 1582 1583 1584 1585 |
* ----------------------------------------------------------------------
*/
static int
InfoClassSubsCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | 1579 1580 1581 1582 1583 1584 1585 1586 1587 1588 1589 1590 1591 1592 1593 |
* ----------------------------------------------------------------------
*/
static int
InfoClassSubsCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const objv[])
{
Class *clsPtr, *subclassPtr;
Tcl_Obj *resultObj;
Tcl_Size i;
const char *pattern = NULL;
|
| ︙ | ︙ | |||
1634 1635 1636 1637 1638 1639 1640 |
* ----------------------------------------------------------------------
*/
static int
InfoClassSupersCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | 1634 1635 1636 1637 1638 1639 1640 1641 1642 1643 1644 1645 1646 1647 1648 |
* ----------------------------------------------------------------------
*/
static int
InfoClassSupersCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const objv[])
{
Class *clsPtr, *superPtr;
Tcl_Obj *resultObj;
Tcl_Size i;
if (objc != 2) {
|
| ︙ | ︙ | |||
1673 1674 1675 1676 1677 1678 1679 |
* ----------------------------------------------------------------------
*/
static int
InfoClassVariablesCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | 1673 1674 1675 1676 1677 1678 1679 1680 1681 1682 1683 1684 1685 1686 1687 |
* ----------------------------------------------------------------------
*/
static int
InfoClassVariablesCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const objv[])
{
Class *clsPtr;
Tcl_Obj *resultObj;
Tcl_Size i;
int isPrivate = 0;
|
| ︙ | ︙ | |||
1732 1733 1734 1735 1736 1737 1738 |
* ----------------------------------------------------------------------
*/
static int
InfoObjectCallCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | 1732 1733 1734 1735 1736 1737 1738 1739 1740 1741 1742 1743 1744 1745 1746 |
* ----------------------------------------------------------------------
*/
static int
InfoObjectCallCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const objv[])
{
Object *oPtr;
CallContext *contextPtr;
if (objc != 3) {
Tcl_WrongNumArgs(interp, 1, objv, "objName methodName");
|
| ︙ | ︙ | |||
1779 1780 1781 1782 1783 1784 1785 |
* ----------------------------------------------------------------------
*/
static int
InfoClassCallCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | 1779 1780 1781 1782 1783 1784 1785 1786 1787 1788 1789 1790 1791 1792 1793 |
* ----------------------------------------------------------------------
*/
static int
InfoClassCallCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const objv[])
{
Class *clsPtr;
CallChain *callPtr;
if (objc != 3) {
Tcl_WrongNumArgs(interp, 1, objv, "className methodName");
|
| ︙ | ︙ |
Changes to generic/tclOOInt.h.
| ︙ | ︙ | |||
46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 |
/*
* The data that needs to be stored per method. This record is used to collect
* information about all sorts of methods, including forwards, constructors
* and destructors.
*/
struct Method {
union {
const Tcl_MethodType *typePtr;
const Tcl_MethodType2 *type2Ptr;
}; /* The type of method. If NULL, this is a
* special flag record which is just used for
* the setting of the flags field. Note that
* this is a union of two pointer types that
* have the same layout at least as far as the
* internal version field. */
| > > | 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 |
/*
* The data that needs to be stored per method. This record is used to collect
* information about all sorts of methods, including forwards, constructors
* and destructors.
*/
struct Method {
union {
#ifndef TCL_NO_DEPRECATED
const Tcl_MethodType *typePtr;
#endif /* TCL_NO_DEPRECATED */
const Tcl_MethodType2 *type2Ptr;
}; /* The type of method. If NULL, this is a
* special flag record which is just used for
* the setting of the flags field. Note that
* this is a union of two pointer types that
* have the same layout at least as far as the
* internal version field. */
|
| ︙ | ︙ | |||
485 486 487 488 489 490 491 |
/*
* Structure containing definition information about basic class methods.
*/
struct DeclaredClassMethod {
const char *name; /* Name of the method in question. */
int isPublic; /* Whether the method is public by default. */
| | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 |
/*
* Structure containing definition information about basic class methods.
*/
struct DeclaredClassMethod {
const char *name; /* Name of the method in question. */
int isPublic; /* Whether the method is public by default. */
Tcl_MethodType2 definition; /* How to call the method. */
};
/*
*----------------------------------------------------------------
* Commands relating to OO support.
*----------------------------------------------------------------
*/
MODULE_SCOPE int TclOOInit(Tcl_Interp *interp);
MODULE_SCOPE Tcl_ObjCmdProc2 TclOODefineObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc2 TclOOObjDefObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc2 TclOODefineClassMethodObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc2 TclOODefineConstructorObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc2 TclOODefineDefnNsObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc2 TclOODefineDeleteMethodObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc2 TclOODefineDestructorObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc2 TclOODefineExportObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc2 TclOODefineForwardObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc2 TclOODefineInitialiseObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc2 TclOODefineMethodObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc2 TclOODefineRenameMethodObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc2 TclOODefineUnexportObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc2 TclOODefineClassObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc2 TclOODefineSelfObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc2 TclOODefineObjSelfObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc2 TclOODefinePrivateObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc2 TclOODefinePropertyCmd;
MODULE_SCOPE Tcl_ObjCmdProc2 TclOOUnknownDefinition;
MODULE_SCOPE Tcl_ObjCmdProc2 TclOOCallbackObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc2 TclOOClassVariableObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc2 TclOOCopyObjectCmd;
MODULE_SCOPE Tcl_ObjCmdProc2 TclOODelegateNameObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc2 TclOOLinkObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc2 TclOONextObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc2 TclOONextToObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc2 TclOOSelfObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc2 TclOOInfoObjectPropCmd;
MODULE_SCOPE Tcl_ObjCmdProc2 TclOOInfoClassPropCmd;
/*
* Method implementations (in tclOOBasic.c).
*/
MODULE_SCOPE Tcl_MethodCallProc2 TclOO_Class_Cloned;
MODULE_SCOPE Tcl_MethodCallProc2 TclOO_Class_Constructor;
MODULE_SCOPE Tcl_MethodCallProc2 TclOO_Class_Create;
MODULE_SCOPE Tcl_MethodCallProc2 TclOO_Class_CreateNs;
MODULE_SCOPE Tcl_MethodCallProc2 TclOO_Class_New;
MODULE_SCOPE Tcl_MethodCallProc2 TclOO_Object_Cloned;
MODULE_SCOPE Tcl_MethodCallProc2 TclOO_Object_Destroy;
MODULE_SCOPE Tcl_MethodCallProc2 TclOO_Object_Eval;
MODULE_SCOPE Tcl_MethodCallProc2 TclOO_Object_LinkVar;
MODULE_SCOPE Tcl_MethodCallProc2 TclOO_Object_Unknown;
MODULE_SCOPE Tcl_MethodCallProc2 TclOO_Object_VarName;
MODULE_SCOPE Tcl_MethodCallProc2 TclOO_Configurable_Configure;
MODULE_SCOPE Tcl_MethodCallProc2 TclOO_Configurable_Constructor;
MODULE_SCOPE Tcl_MethodCallProc2 TclOO_Singleton_New;
MODULE_SCOPE Tcl_MethodCallProc2 TclOO_SingletonInstance_Cloned;
MODULE_SCOPE Tcl_MethodCallProc2 TclOO_SingletonInstance_Destroy;
/*
* Private definitions, some of which perhaps ought to be exposed properly or
* maybe just put in the internal stubs table.
*/
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 TclMethodIsType(Tcl_Method method,
const Tcl_MethodType2 *typePtr,
void **clientDataPtr);
MODULE_SCOPE Tcl_Method TclNewInstanceMethod(Tcl_Interp *interp,
Tcl_Object object, Tcl_Obj *nameObj,
int flags, const Tcl_MethodType2 *typePtr,
void *clientData);
MODULE_SCOPE Tcl_Method TclNewMethod(Tcl_Class cls,
Tcl_Obj *nameObj, int flags,
const Tcl_MethodType2 *typePtr,
void *clientData);
MODULE_SCOPE int TclNRNewObjectInstance(Tcl_Interp *interp,
Tcl_Class cls, const char *nameStr,
const char *nsNameStr, Tcl_Size objc,
Tcl_Obj *const *objv, Tcl_Size skip,
Tcl_Object *objectPtr);
MODULE_SCOPE Object * TclNewObjectInstanceCommon(Tcl_Interp *interp,
|
| ︙ | ︙ | |||
602 603 604 605 606 607 608 | Tcl_Interp *interp, Object *oPtr, int forClass); MODULE_SCOPE CallChain *TclOOGetStereotypeCallChain(Class *clsPtr, Tcl_Obj *methodNameObj, int flags); MODULE_SCOPE Foundation *TclOOGetFoundation(Tcl_Interp *interp); MODULE_SCOPE Tcl_Obj * TclOOGetFwdFromMethod(Method *mPtr); MODULE_SCOPE Proc * TclOOGetProcFromMethod(Method *mPtr); MODULE_SCOPE Tcl_Obj * TclOOGetMethodBody(Method *mPtr); | | | | 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 | Tcl_Interp *interp, Object *oPtr, int forClass); MODULE_SCOPE CallChain *TclOOGetStereotypeCallChain(Class *clsPtr, Tcl_Obj *methodNameObj, int flags); MODULE_SCOPE Foundation *TclOOGetFoundation(Tcl_Interp *interp); MODULE_SCOPE Tcl_Obj * TclOOGetFwdFromMethod(Method *mPtr); MODULE_SCOPE Proc * TclOOGetProcFromMethod(Method *mPtr); MODULE_SCOPE Tcl_Obj * TclOOGetMethodBody(Method *mPtr); MODULE_SCOPE Tcl_Size TclOOGetSortedClassMethodList(Class *clsPtr, int flags, Tcl_Obj ***namesLstPtr); MODULE_SCOPE Tcl_Size TclOOGetSortedMethodList(Object *oPtr, Object *contextObj, Class *contextCls, int flags, Tcl_Obj ***namesLstPtr); MODULE_SCOPE int TclOOInit(Tcl_Interp *interp); MODULE_SCOPE void TclOOInitInfo(Tcl_Interp *interp); MODULE_SCOPE int TclOOInvokeContext(void *clientData, Tcl_Interp *interp, Tcl_Size objc, Tcl_Obj *const objv[]); MODULE_SCOPE Tcl_Var TclOOLookupObjectVar(Tcl_Interp *interp, Tcl_Object object, Tcl_Obj *varName, Tcl_Var *aryPtr); MODULE_SCOPE int TclNRObjectContextInvokeNext(Tcl_Interp *interp, Tcl_ObjectContext context, Tcl_Size objc, Tcl_Obj *const *objv, Tcl_Size skip); |
| ︙ | ︙ |
Changes to generic/tclOOIntDecls.h.
1 2 3 4 5 6 7 8 9 10 11 12 13 |
/*
* This file is (mostly) automatically generated from tclOO.decls.
*/
#ifndef _TCLOOINTDECLS
#define _TCLOOINTDECLS
/* !BEGIN!: Do not edit below this line. */
#ifdef __cplusplus
extern "C" {
#endif
| > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 |
/*
* This file is (mostly) automatically generated from tclOO.decls.
*/
#ifndef _TCLOOINTDECLS
#define _TCLOOINTDECLS
#ifdef TCL_NO_DEPRECATED
# define Tcl_MethodType void
#endif
/* !BEGIN!: Do not edit below this line. */
#ifdef __cplusplus
extern "C" {
#endif
|
| ︙ | ︙ | |||
177 178 179 180 181 182 183 184 185 | (tclOOIntStubsPtr->tclOOMakeProcInstanceMethod2) /* 16 */ #define TclOOMakeProcMethod2 \ (tclOOIntStubsPtr->tclOOMakeProcMethod2) /* 17 */ #endif /* defined(USE_TCLOO_STUBS) */ /* !END!: Do not edit above this line. */ #endif /* _TCLOOINTDECLS */ | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 181 182 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 210 211 212 213 214 215 216 217 218 219 220 221 222 |
(tclOOIntStubsPtr->tclOOMakeProcInstanceMethod2) /* 16 */
#define TclOOMakeProcMethod2 \
(tclOOIntStubsPtr->tclOOMakeProcMethod2) /* 17 */
#endif /* defined(USE_TCLOO_STUBS) */
/* !END!: Do not edit above this line. */
#ifdef TCL_NO_DEPRECATED
# undef Tcl_MethodType
# undef TclOOMakeProcInstanceMethod
# undef tclOOMakeProcMethod
#endif
#if defined(__STDC_VERSION__) && (__STDC_VERSION__ >= 201112L)
#ifndef TclOOGeneric
/* Select method based on type of argument. */
#define TclOOGeneric(typePtr, impl) \
_Generic(typePtr, default: impl, const Tcl_MethodType2 *: impl ## 2)
#endif
#ifdef USE_TCLOO_STUBS
#undef TclOOMakeProcInstanceMethod
#define TclOOMakeProcInstanceMethod(interp, oPtr, flags, nameObj, argsObj, bodyObj, typePtr, clientData, procPtrPtr) \
(TclOOGeneric((typePtr), tclOOIntStubsPtr->tclOOMakeProcInstanceMethod) \
((interp), (oPtr), (flags), (nameObj), (argsObj), (bodyObj), (typePtr), (clientData), (procPtrPtr)))
#undef TclOOMakeProcMethod
#define TclOOMakeProcMethod(interp, clsPtr, flags, nameObj, namePtr, argsObj, bodyObj, typePtr, clientData, procPtrPtr) \
(TclOOGeneric((typePtr), tclOOIntStubsPtr->tclOOMakeProcMethod) \
((interp), (clsPtr), (flags), (nameObj), (namePtr), (argsObj), (bodyObj), (typePtr), (clientData), (procPtrPtr)))
#else
#define TclOOMakeProcInstanceMethod(interp, oPtr, flags, nameObj, argsObj, bodyObj, typePtr, clientData, procPtrPtr) \
(TclOOGeneric((typePtr), TclOOMakeProcInstanceMethod) \
((interp), (oPtr), (flags), (nameObj), (argsObj), (bodyObj), (typePtr), (clientData), (procPtrPtr)))
#define TclOOMakeProcMethod(interp, clsPtr, flags, nameObj, namePtr, argsObj, bodyObj, typePtr, clientData, procPtrPtr) \
(TclOOGeneric((typePtr), TclOOMakeProcMethod) \
((interp), (clsPtr), (flags), (nameObj), (namePtr), (argsObj), (bodyObj), (typePtr), (clientData), (procPtrPtr)))
#endif
#endif
#endif /* _TCLOOINTDECLS */
|
Changes to generic/tclOOMethod.c.
| ︙ | ︙ | |||
43 44 45 46 47 48 49 | * variables be cached? */ } OOResVarInfo; /* * Function declarations for things defined in this file. */ | | | | | | | | | | | | | 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 |
* variables be cached? */
} OOResVarInfo;
/*
* Function declarations for things defined in this file.
*/
static Tcl_Obj ** InitEnsembleRewrite(Tcl_Interp *interp, Tcl_Size objc,
Tcl_Obj *const *objv, Tcl_Size toRewrite,
Tcl_Size rewriteLength, Tcl_Obj *const *rewriteObjs,
Tcl_Size *lengthPtr);
static int InvokeProcedureMethod(void *clientData,
Tcl_Interp *interp, Tcl_ObjectContext context,
Tcl_Size objc, Tcl_Obj *const *objv);
static Tcl_NRPostProc FinalizeForwardCall;
static Tcl_NRPostProc FinalizePMCall;
static int PushMethodCallFrame(Tcl_Interp *interp,
CallContext *contextPtr, ProcedureMethod *pmPtr,
Tcl_Size objc, Tcl_Obj *const *objv,
PMFrameData *fdPtr);
static void DeleteProcedureMethodRecord(ProcedureMethod *pmPtr);
static void DeleteProcedureMethod(void *clientData);
static int CloneProcedureMethod(Tcl_Interp *interp,
void *clientData, void **newClientData);
static ProcErrorProc MethodErrorHandler;
static ProcErrorProc ConstructorErrorHandler;
static ProcErrorProc DestructorErrorHandler;
static Tcl_Obj * RenderMethodName(void *clientData);
static Tcl_Obj * RenderDeclarerName(void *clientData);
static int InvokeForwardMethod(void *clientData,
Tcl_Interp *interp, Tcl_ObjectContext context,
Tcl_Size objc, Tcl_Obj *const *objv);
static void DeleteForwardMethod(void *clientData);
static int CloneForwardMethod(Tcl_Interp *interp,
void *clientData, void **newClientData);
static Tcl_ResolveVarProc ProcedureMethodVarResolver;
static Tcl_ResolveCompiledVarProc ProcedureMethodCompiledVarResolver;
/*
* The types of methods defined by the core OO system.
*/
static const Tcl_MethodType2 procMethodType = {
TCL_OO_METHOD_VERSION_2, "method",
InvokeProcedureMethod, DeleteProcedureMethod, CloneProcedureMethod
};
static const Tcl_MethodType2 fwdMethodType = {
TCL_OO_METHOD_VERSION_2, "forward",
InvokeForwardMethod, DeleteForwardMethod, CloneForwardMethod
};
/*
* Helper macros (derived from things private to tclVar.c)
*/
|
| ︙ | ︙ | |||
138 139 140 141 142 143 144 |
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. */
| | | 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 |
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. */
const Tcl_MethodType2 *typePtr,
/* The type of method this is, which defines
* how to invoke, delete and clone the
* method. */
void *clientData) /* Some data associated with the particular
* method to be created. */
{
Object *oPtr = (Object *) object;
|
| ︙ | ︙ | |||
170 171 172 173 174 175 176 |
mPtr = (Method *) Tcl_Alloc(sizeof(Method));
mPtr->namePtr = nameObj;
mPtr->refCount = 1;
Tcl_IncrRefCount(nameObj);
Tcl_SetHashValue(hPtr, mPtr);
} else {
mPtr = (Method *) Tcl_GetHashValue(hPtr);
| | | | > > > | | > > | 170 171 172 173 174 175 176 177 178 179 180 181 182 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 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 |
mPtr = (Method *) Tcl_Alloc(sizeof(Method));
mPtr->namePtr = nameObj;
mPtr->refCount = 1;
Tcl_IncrRefCount(nameObj);
Tcl_SetHashValue(hPtr, mPtr);
} else {
mPtr = (Method *) Tcl_GetHashValue(hPtr);
if (mPtr->type2Ptr != NULL && mPtr->type2Ptr->deleteProc != NULL) {
mPtr->type2Ptr->deleteProc(mPtr->clientData);
}
}
populate:
mPtr->type2Ptr = typePtr;
mPtr->clientData = clientData;
mPtr->flags = 0;
mPtr->declaringObjectPtr = oPtr;
mPtr->declaringClassPtr = NULL;
if (flags) {
mPtr->flags |= flags &
(PUBLIC_METHOD | PRIVATE_METHOD | TRUE_PRIVATE_METHOD);
if (flags & TRUE_PRIVATE_METHOD) {
oPtr->flags |= HAS_PRIVATE_METHODS;
}
}
oPtr->epoch++;
return (Tcl_Method) mPtr;
}
#ifndef TCL_NO_DEPRECATED
#undef Tcl_NewInstanceMethod
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. */
const Tcl_MethodType *typePtr,
/* The type of method this is, which defines
* how to invoke, delete and clone the
* method. */
void *clientData) /* Some data associated with the particular
* method to be created. */
{
if (typePtr->version > TCL_OO_METHOD_VERSION_1) {
Tcl_Panic("%s: Wrong version in typePtr->version, should be %s",
"Tcl_NewInstanceMethod", "TCL_OO_METHOD_VERSION_1");
}
return TclNewInstanceMethod(NULL, object, nameObj, flags,
(const Tcl_MethodType2 *)typePtr, clientData);
}
#endif /* TCL_NO_DEPRECATED */
Tcl_Method
Tcl_NewInstanceMethod2(
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
|
| ︙ | ︙ | |||
235 236 237 238 239 240 241 |
* method to be created. */
{
if (typePtr->version < TCL_OO_METHOD_VERSION_2) {
Tcl_Panic("%s: Wrong version in typePtr->version, should be %s",
"Tcl_NewInstanceMethod2", "TCL_OO_METHOD_VERSION_2");
}
return TclNewInstanceMethod(NULL, object, nameObj, flags,
| | | | 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 |
* method to be created. */
{
if (typePtr->version < TCL_OO_METHOD_VERSION_2) {
Tcl_Panic("%s: Wrong version in typePtr->version, should be %s",
"Tcl_NewInstanceMethod2", "TCL_OO_METHOD_VERSION_2");
}
return TclNewInstanceMethod(NULL, object, nameObj, flags,
typePtr, clientData);
}
/*
* ----------------------------------------------------------------------
*
* Tcl_NewMethod --
*
* Attach a method to a class.
*
* ----------------------------------------------------------------------
*/
Tcl_Method
TclNewMethod(
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_MethodType2 *typePtr,
/* The type of method this is, which defines
* how to invoke, delete and clone the
* method. */
void *clientData) /* Some data associated with the particular
* method to be created. */
{
Class *clsPtr = (Class *) cls;
|
| ︙ | ︙ | |||
282 283 284 285 286 287 288 |
mPtr = (Method *) Tcl_Alloc(sizeof(Method));
mPtr->refCount = 1;
mPtr->namePtr = nameObj;
Tcl_IncrRefCount(nameObj);
Tcl_SetHashValue(hPtr, mPtr);
} else {
mPtr = (Method *) Tcl_GetHashValue(hPtr);
| | | | > > | > > | < | | | 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 |
mPtr = (Method *) Tcl_Alloc(sizeof(Method));
mPtr->refCount = 1;
mPtr->namePtr = nameObj;
Tcl_IncrRefCount(nameObj);
Tcl_SetHashValue(hPtr, mPtr);
} else {
mPtr = (Method *) Tcl_GetHashValue(hPtr);
if (mPtr->type2Ptr != NULL && mPtr->type2Ptr->deleteProc != NULL) {
mPtr->type2Ptr->deleteProc(mPtr->clientData);
}
}
populate:
clsPtr->thisPtr->fPtr->epoch++;
mPtr->type2Ptr = typePtr;
mPtr->clientData = clientData;
mPtr->flags = 0;
mPtr->declaringObjectPtr = NULL;
mPtr->declaringClassPtr = clsPtr;
if (flags) {
mPtr->flags |= flags &
(PUBLIC_METHOD | PRIVATE_METHOD | TRUE_PRIVATE_METHOD);
if (flags & TRUE_PRIVATE_METHOD) {
clsPtr->flags |= HAS_PRIVATE_METHODS;
}
}
return (Tcl_Method) mPtr;
}
#ifndef TCL_NO_DEPRECATED
#undef Tcl_NewMethod
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,
/* The type of method this is, which defines
* how to invoke, delete and clone the
* method. */
void *clientData) /* Some data associated with the particular
* method to be created. */
{
if (typePtr->version > TCL_OO_METHOD_VERSION_1) {
Tcl_Panic("%s: Wrong version in typePtr->version, should be %s",
"Tcl_NewMethod", "TCL_OO_METHOD_VERSION_1");
}
return TclNewMethod(cls, nameObj, flags,
(const Tcl_MethodType2 *)typePtr, clientData);
}
#endif /* TCL_NO_DEPRECATED */
Tcl_Method
Tcl_NewMethod2(
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_MethodType2 *typePtr,
/* The type of method this is, which defines
* how to invoke, delete and clone the
* method. */
void *clientData) /* Some data associated with the particular
* method to be created. */
{
if (typePtr->version < TCL_OO_METHOD_VERSION_2) {
Tcl_Panic("%s: Wrong version in typePtr->version, should be %s",
"Tcl_NewMethod2", "TCL_OO_METHOD_VERSION_2");
}
return TclNewMethod(cls, nameObj, flags, typePtr, clientData);
}
/*
* ----------------------------------------------------------------------
*
* TclOODelMethodRef --
*
* How to delete a method.
*
* ----------------------------------------------------------------------
*/
void
TclOODelMethodRef(
Method *mPtr)
{
if ((mPtr != NULL) && (mPtr->refCount-- <= 1)) {
if (mPtr->type2Ptr != NULL && mPtr->type2Ptr->deleteProc != NULL) {
mPtr->type2Ptr->deleteProc(mPtr->clientData);
}
if (mPtr->namePtr != NULL) {
Tcl_DecrRefCount(mPtr->namePtr);
}
Tcl_Free(mPtr);
}
|
| ︙ | ︙ | |||
439 440 441 442 443 444 445 |
ProcedureMethod *pmPtr;
Tcl_Method method;
if (TclListObjLength(interp, argsObj, &argsLen) != TCL_OK) {
return NULL;
}
pmPtr = AllocProcedureMethodRecord(flags);
| | | 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 |
ProcedureMethod *pmPtr;
Tcl_Method method;
if (TclListObjLength(interp, argsObj, &argsLen) != TCL_OK) {
return NULL;
}
pmPtr = AllocProcedureMethodRecord(flags);
method = TclOOMakeProcInstanceMethod2(interp, oPtr, flags, nameObj,
argsObj, bodyObj, &procMethodType, pmPtr, &pmPtr->procPtr);
if (method == NULL) {
Tcl_Free(pmPtr);
} else if (pmPtrPtr != NULL) {
*pmPtrPtr = pmPtr;
}
return (Method *) method;
|
| ︙ | ︙ | |||
495 496 497 498 499 500 501 |
} else if (TclListObjLength(interp, argsObj, &argsLen) != TCL_OK) {
return NULL;
} else {
procName = (nameObj==NULL ? "<constructor>" : TclGetString(nameObj));
}
pmPtr = AllocProcedureMethodRecord(flags);
| | | 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 |
} else if (TclListObjLength(interp, argsObj, &argsLen) != TCL_OK) {
return NULL;
} else {
procName = (nameObj==NULL ? "<constructor>" : TclGetString(nameObj));
}
pmPtr = AllocProcedureMethodRecord(flags);
method = TclOOMakeProcMethod2(interp, clsPtr, flags, nameObj, procName,
argsObj, bodyObj, &procMethodType, pmPtr, &pmPtr->procPtr);
if (argsLen == TCL_INDEX_NONE) {
Tcl_DecrRefCount(argsObj);
}
if (method == NULL) {
Tcl_Free(pmPtr);
|
| ︙ | ︙ | |||
606 607 608 609 610 611 612 613 614 615 616 617 618 619 |
* Split apart so that it is easier for other extensions to reuse (in
* particular, it frees them from having to pry so deeply into Tcl's
* guts).
*
* ----------------------------------------------------------------------
*/
Tcl_Method
TclOOMakeProcInstanceMethod(
Tcl_Interp *interp, /* The interpreter containing the object. */
Object *oPtr, /* The object to modify. */
int flags, /* Whether this is a public method. */
Tcl_Obj *nameObj, /* The name of the method, which _must not_ be
* NULL. */
| > > | 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 |
* Split apart so that it is easier for other extensions to reuse (in
* particular, it frees them from having to pry so deeply into Tcl's
* guts).
*
* ----------------------------------------------------------------------
*/
#ifndef TCL_NO_DEPRECATED
#undef TclOOMakeProcInstanceMethod
Tcl_Method
TclOOMakeProcInstanceMethod(
Tcl_Interp *interp, /* The interpreter containing the object. */
Object *oPtr, /* The object to modify. */
int flags, /* Whether this is a public method. */
Tcl_Obj *nameObj, /* The name of the method, which _must not_ be
* NULL. */
|
| ︙ | ︙ | |||
642 643 644 645 646 647 648 |
}
procPtr = *procPtrPtr;
procPtr->cmdPtr = NULL;
InitCmdFrame(iPtr, procPtr);
return TclNewInstanceMethod(interp, (Tcl_Object) oPtr, nameObj, flags,
| | > | 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 |
}
procPtr = *procPtrPtr;
procPtr->cmdPtr = NULL;
InitCmdFrame(iPtr, procPtr);
return TclNewInstanceMethod(interp, (Tcl_Object) oPtr, nameObj, flags,
(const Tcl_MethodType2 *)typePtr, clientData);
}
#endif /* TCL_NO_DEPRECATED */
Tcl_Method
TclOOMakeProcInstanceMethod2(
Tcl_Interp *interp, /* The interpreter containing the object. */
Object *oPtr, /* The object to modify. */
int flags, /* Whether this is a public method. */
Tcl_Obj *nameObj, /* The name of the method, which _must not_ be
|
| ︙ | ︙ | |||
681 682 683 684 685 686 687 |
}
procPtr = *procPtrPtr;
procPtr->cmdPtr = NULL;
InitCmdFrame(iPtr, procPtr);
return TclNewInstanceMethod(interp, (Tcl_Object) oPtr, nameObj, flags,
| | > > | 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 |
}
procPtr = *procPtrPtr;
procPtr->cmdPtr = NULL;
InitCmdFrame(iPtr, procPtr);
return TclNewInstanceMethod(interp, (Tcl_Object) oPtr, nameObj, flags,
typePtr, clientData);
}
/*
* ----------------------------------------------------------------------
*
* TclOOMakeProcMethod --
*
* The guts of the code to make a procedure-like method for a class.
* Split apart so that it is easier for other extensions to reuse (in
* particular, it frees them from having to pry so deeply into Tcl's
* guts).
*
* ----------------------------------------------------------------------
*/
#ifndef TCL_NO_DEPRECATED
#undef TclOOMakeProcMethod
Tcl_Method
TclOOMakeProcMethod(
Tcl_Interp *interp, /* The interpreter containing the class. */
Class *clsPtr, /* The class to modify. */
int flags, /* Whether this is a public method. */
Tcl_Obj *nameObj, /* The name of the method, which may be NULL;
* if so, up to caller to manage storage
|
| ︙ | ︙ | |||
737 738 739 740 741 742 743 |
}
procPtr = *procPtrPtr;
procPtr->cmdPtr = NULL;
InitCmdFrame(iPtr, procPtr);
return TclNewMethod(
| | > | 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 |
}
procPtr = *procPtrPtr;
procPtr->cmdPtr = NULL;
InitCmdFrame(iPtr, procPtr);
return TclNewMethod(
(Tcl_Class) clsPtr, nameObj, flags, (const Tcl_MethodType2 *)typePtr, clientData);
}
#endif /* TCL_NO_DEPRECATED */
Tcl_Method
TclOOMakeProcMethod2(
Tcl_Interp *interp, /* The interpreter containing the class. */
Class *clsPtr, /* The class to modify. */
int flags, /* Whether this is a public method. */
Tcl_Obj *nameObj, /* The name of the method, which may be NULL;
|
| ︙ | ︙ | |||
780 781 782 783 784 785 786 |
}
procPtr = *procPtrPtr;
procPtr->cmdPtr = NULL;
InitCmdFrame(iPtr, procPtr);
return TclNewMethod((Tcl_Class) clsPtr, nameObj, flags,
| | | | 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 |
}
procPtr = *procPtrPtr;
procPtr->cmdPtr = NULL;
InitCmdFrame(iPtr, procPtr);
return TclNewMethod((Tcl_Class) clsPtr, nameObj, flags,
typePtr, clientData);
}
/*
* ----------------------------------------------------------------------
*
* InvokeProcedureMethod, FinalizePMCall, PushMethodCallFrame --
*
* How to invoke a procedure-like method.
*
* ----------------------------------------------------------------------
*/
static int
InvokeProcedureMethod(
void *clientData, /* Pointer to the per-method record. */
Tcl_Interp *interp,
Tcl_ObjectContext context, /* The method calling context. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const *objv) /* Arguments as actually seen. */
{
ProcedureMethod *pmPtr = (ProcedureMethod *) clientData;
int result;
PMFrameData *fdPtr; /* Important data that has to have a lifetime
* matched by this function (or rather, by the
* call frame's lifetime). */
|
| ︙ | ︙ | |||
937 938 939 940 941 942 943 |
static int
PushMethodCallFrame(
Tcl_Interp *interp, /* Current interpreter. */
CallContext *contextPtr, /* Current method call context. */
ProcedureMethod *pmPtr, /* Information about this procedure-like
* method. */
| | | 951 952 953 954 955 956 957 958 959 960 961 962 963 964 965 |
static int
PushMethodCallFrame(
Tcl_Interp *interp, /* Current interpreter. */
CallContext *contextPtr, /* Current method call context. */
ProcedureMethod *pmPtr, /* Information about this procedure-like
* method. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const *objv, /* Array of arguments. */
PMFrameData *fdPtr) /* Place to store information about the call
* frame. */
{
Namespace *nsPtr = (Namespace *) contextPtr->oPtr->namespacePtr;
int result;
CallFrame **framePtrPtr = &fdPtr->framePtr;
|
| ︙ | ︙ | |||
1566 1567 1568 1569 1570 1571 1572 |
*/
static int
InvokeForwardMethod(
void *clientData, /* Pointer to some per-method context. */
Tcl_Interp *interp,
Tcl_ObjectContext context, /* The method calling context. */
| | | | 1580 1581 1582 1583 1584 1585 1586 1587 1588 1589 1590 1591 1592 1593 1594 1595 1596 1597 1598 1599 1600 1601 |
*/
static int
InvokeForwardMethod(
void *clientData, /* Pointer to some per-method context. */
Tcl_Interp *interp,
Tcl_ObjectContext context, /* The method calling context. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const *objv) /* Arguments as actually seen. */
{
CallContext *contextPtr = (CallContext *) context;
ForwardMethod *fmPtr = (ForwardMethod *) clientData;
Tcl_Obj **argObjs, **prefixObjs;
Tcl_Size numPrefixes, skip = contextPtr->skip;
Tcl_Size len;
/*
* Build the real list of arguments to use. Note that we know that the
* prefixObj field of the ForwardMethod structure holds a reference to a
* non-empty list, so there's a whole class of failures ("not a list") we
* can ignore here.
*/
|
| ︙ | ︙ | |||
1658 1659 1660 1661 1662 1663 1664 |
* ----------------------------------------------------------------------
*/
Proc *
TclOOGetProcFromMethod(
Method *mPtr)
{
| | | | | 1672 1673 1674 1675 1676 1677 1678 1679 1680 1681 1682 1683 1684 1685 1686 1687 1688 1689 1690 1691 1692 1693 1694 1695 1696 1697 1698 1699 1700 1701 1702 1703 1704 1705 1706 1707 1708 1709 1710 1711 |
* ----------------------------------------------------------------------
*/
Proc *
TclOOGetProcFromMethod(
Method *mPtr)
{
if (mPtr->type2Ptr == &procMethodType) {
ProcedureMethod *pmPtr = (ProcedureMethod *) mPtr->clientData;
return pmPtr->procPtr;
}
return NULL;
}
Tcl_Obj *
TclOOGetMethodBody(
Method *mPtr)
{
if (mPtr->type2Ptr == &procMethodType) {
ProcedureMethod *pmPtr = (ProcedureMethod *) mPtr->clientData;
(void) TclGetString(pmPtr->procPtr->bodyPtr);
return pmPtr->procPtr->bodyPtr;
}
return NULL;
}
Tcl_Obj *
TclOOGetFwdFromMethod(
Method *mPtr)
{
if (mPtr->type2Ptr == &fwdMethodType) {
ForwardMethod *fwPtr = (ForwardMethod *) mPtr->clientData;
return fwPtr->prefixObj;
}
return NULL;
}
|
| ︙ | ︙ | |||
1716 1717 1718 1719 1720 1721 1722 |
* <------------------*lengthPtr------------------->
*
* ----------------------------------------------------------------------
*/
static Tcl_Obj **
InitEnsembleRewrite(
Tcl_Interp *interp, /* Place to log the rewrite info. */
| | | | | | 1730 1731 1732 1733 1734 1735 1736 1737 1738 1739 1740 1741 1742 1743 1744 1745 1746 1747 1748 1749 |
* <------------------*lengthPtr------------------->
*
* ----------------------------------------------------------------------
*/
static Tcl_Obj **
InitEnsembleRewrite(
Tcl_Interp *interp, /* Place to log the rewrite info. */
Tcl_Size objc, /* Number of real arguments. */
Tcl_Obj *const *objv, /* The real arguments. */
Tcl_Size toRewrite, /* Number of real arguments to replace. */
Tcl_Size rewriteLength, /* Number of arguments to insert instead. */
Tcl_Obj *const *rewriteObjs,/* Arguments to insert instead. */
Tcl_Size *lengthPtr) /* Where to write the resulting length of the
* array of rewritten arguments. */
{
size_t len = rewriteLength + objc - toRewrite;
Tcl_Obj **argObjs = (Tcl_Obj **)
TclStackAlloc(interp, sizeof(Tcl_Obj *) * len);
memcpy(argObjs, rewriteObjs, rewriteLength * sizeof(Tcl_Obj *));
|
| ︙ | ︙ | |||
1780 1781 1782 1783 1784 1785 1786 |
{
return ((Method *) method)->namePtr;
}
int
TclMethodIsType(
Tcl_Method method,
| | | > > | > | | 1794 1795 1796 1797 1798 1799 1800 1801 1802 1803 1804 1805 1806 1807 1808 1809 1810 1811 1812 1813 1814 1815 1816 1817 1818 1819 1820 1821 1822 1823 1824 1825 1826 1827 1828 1829 1830 1831 1832 1833 1834 1835 1836 1837 1838 1839 1840 1841 1842 1843 1844 1845 1846 1847 1848 1849 1850 1851 1852 1853 1854 1855 1856 1857 1858 |
{
return ((Method *) method)->namePtr;
}
int
TclMethodIsType(
Tcl_Method method,
const Tcl_MethodType2 *typePtr,
void **clientDataPtr)
{
Method *mPtr = (Method *) method;
if (mPtr->type2Ptr == typePtr) {
if (clientDataPtr != NULL) {
*clientDataPtr = mPtr->clientData;
}
return 1;
}
return 0;
}
#ifndef TCL_NO_DEPRECATED
#undef Tcl_MethodIsType
int
Tcl_MethodIsType(
Tcl_Method method,
const Tcl_MethodType *typePtr,
void **clientDataPtr)
{
Method *mPtr = (Method *) method;
if (typePtr->version > TCL_OO_METHOD_VERSION_1) {
Tcl_Panic("%s: Wrong version in typePtr->version, should be %s",
"Tcl_MethodIsType", "TCL_OO_METHOD_VERSION_1");
}
if (mPtr->typePtr == (const Tcl_MethodType *) typePtr) {
if (clientDataPtr != NULL) {
*clientDataPtr = mPtr->clientData;
}
return 1;
}
return 0;
}
#endif
int
Tcl_MethodIsType2(
Tcl_Method method,
const Tcl_MethodType2 *typePtr,
void **clientDataPtr)
{
Method *mPtr = (Method *) method;
if (typePtr->version < TCL_OO_METHOD_VERSION_2) {
Tcl_Panic("%s: Wrong version in typePtr->version, should be %s",
"Tcl_MethodIsType2", "TCL_OO_METHOD_VERSION_2");
}
if (mPtr->type2Ptr == typePtr) {
if (clientDataPtr != NULL) {
*clientDataPtr = mPtr->clientData;
}
return 1;
}
return 0;
}
|
| ︙ | ︙ |
Changes to generic/tclOOProp.c.
| ︙ | ︙ | |||
37 38 39 40 41 42 43 | /* * Forward declarations. */ static int Configurable_Getter(void *clientData, Tcl_Interp *interp, Tcl_ObjectContext context, | | | | | | | | 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 |
/*
* Forward declarations.
*/
static int Configurable_Getter(void *clientData,
Tcl_Interp *interp, Tcl_ObjectContext context,
Tcl_Size objc, Tcl_Obj *const *objv);
static int Configurable_Setter(void *clientData,
Tcl_Interp *interp, Tcl_ObjectContext context,
Tcl_Size objc, Tcl_Obj *const *objv);
static void DetailsDeleter(void *clientData);
static int DetailsCloner(Tcl_Interp *, void *oldClientData,
void **newClientData);
static void ImplementObjectProperty(Tcl_Object targetObject,
Tcl_Obj *propNamePtr, int installGetter,
int installSetter);
static void ImplementClassProperty(Tcl_Class targetObject,
Tcl_Obj *propNamePtr, int installGetter,
int installSetter);
/*
* Method descriptors
*/
static const Tcl_MethodType2 GetterType = {
TCL_OO_METHOD_VERSION_2,
"PropertyGetter",
Configurable_Getter,
DetailsDeleter,
DetailsCloner
};
static const Tcl_MethodType2 SetterType = {
TCL_OO_METHOD_VERSION_2,
"PropertySetter",
Configurable_Setter,
DetailsDeleter,
DetailsCloner
};
/*
|
| ︙ | ︙ | |||
249 250 251 252 253 254 255 |
int
TclOO_Configurable_Configure(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Interpreter used for the result, error
* reporting, etc. */
Tcl_ObjectContext context, /* The object/call context. */
| | | 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 |
int
TclOO_Configurable_Configure(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Interpreter used for the result, error
* reporting, etc. */
Tcl_ObjectContext context, /* The object/call context. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const *objv) /* The actual arguments. */
{
Object *oPtr = (Object *) Tcl_ObjectContextObject(context);
Tcl_Size skip = Tcl_ObjectContextSkippedArgs(context);
Tcl_Obj *namePtr;
Tcl_Size i, namec;
int code = TCL_OK;
|
| ︙ | ︙ | |||
369 370 371 372 373 374 375 |
Configurable_Getter(
void *clientData, /* Which property to read. Actually a Tcl_Obj*
* reference that is the name of the variable
* in the cpntext object. */
Tcl_Interp *interp, /* Interpreter used for the result, error
* reporting, etc. */
Tcl_ObjectContext context, /* The object/call context. */
| | | 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 |
Configurable_Getter(
void *clientData, /* Which property to read. Actually a Tcl_Obj*
* reference that is the name of the variable
* in the cpntext object. */
Tcl_Interp *interp, /* Interpreter used for the result, error
* reporting, etc. */
Tcl_ObjectContext context, /* The object/call context. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const *objv) /* The actual arguments. */
{
Tcl_Obj *propNamePtr = (Tcl_Obj *) clientData;
Tcl_Var varPtr, aryVar;
Tcl_Obj *valuePtr;
if (Tcl_ObjectContextSkippedArgs(context) != objc) {
|
| ︙ | ︙ | |||
405 406 407 408 409 410 411 |
Configurable_Setter(
void *clientData, /* Which property to write. Actually a Tcl_Obj*
* reference that is the name of the variable
* in the cpntext object. */
Tcl_Interp *interp, /* Interpreter used for the result, error
* reporting, etc. */
Tcl_ObjectContext context, /* The object/call context. */
| | | 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 |
Configurable_Setter(
void *clientData, /* Which property to write. Actually a Tcl_Obj*
* reference that is the name of the variable
* in the cpntext object. */
Tcl_Interp *interp, /* Interpreter used for the result, error
* reporting, etc. */
Tcl_ObjectContext context, /* The object/call context. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const *objv) /* The actual arguments. */
{
Tcl_Obj *propNamePtr = (Tcl_Obj *) clientData;
Tcl_Var varPtr, aryVar;
if (Tcl_ObjectContextSkippedArgs(context) + 1 != objc) {
Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context),
|
| ︙ | ︙ | |||
538 539 540 541 542 543 544 |
static void
FindClassProps(
Class *clsPtr, /* The object to inspect. Must exist. */
int writable, /* Whether we're after the readable or writable
* property set. */
Tcl_HashTable *accumulator) /* Where to gather the names. */
{
| | | | | 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 |
static void
FindClassProps(
Class *clsPtr, /* The object to inspect. Must exist. */
int writable, /* Whether we're after the readable or writable
* property set. */
Tcl_HashTable *accumulator) /* Where to gather the names. */
{
Tcl_Size i;
Tcl_Obj *propName;
Class *mixin, *sup;
tailRecurse:
if (writable) {
FOREACH(propName, clsPtr->properties.writable) {
Tcl_CreateHashEntry(accumulator, propName, NULL);
}
} else {
FOREACH(propName, clsPtr->properties.readable) {
Tcl_CreateHashEntry(accumulator, propName, NULL);
}
}
if (clsPtr->thisPtr->flags & ROOT_OBJECT) {
/*
* We do *not* traverse upwards from the root!
*/
return;
|
| ︙ | ︙ | |||
589 590 591 592 593 594 595 |
static void
FindObjectProps(
Object *oPtr, /* The object to inspect. Must exist. */
int writable, /* Whether we're after the readable or writable
* property set. */
Tcl_HashTable *accumulator) /* Where to gather the names. */
{
| | | | | 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 |
static void
FindObjectProps(
Object *oPtr, /* The object to inspect. Must exist. */
int writable, /* Whether we're after the readable or writable
* property set. */
Tcl_HashTable *accumulator) /* Where to gather the names. */
{
Tcl_Size i;
Tcl_Obj *propName;
Class *mixin;
if (writable) {
FOREACH(propName, oPtr->properties.writable) {
Tcl_CreateHashEntry(accumulator, propName, NULL);
}
} else {
FOREACH(propName, oPtr->properties.readable) {
Tcl_CreateHashEntry(accumulator, propName, NULL);
}
}
FOREACH(mixin, oPtr->mixins) {
FindClassProps(mixin, writable, accumulator);
}
FindClassProps(oPtr->selfCls, writable, accumulator);
}
|
| ︙ | ︙ | |||
1024 1025 1026 1027 1028 1029 1030 |
* ----------------------------------------------------------------------
*/
int
TclOODefinePropertyCmd(
void *useInstance, /* NULL for class, non-NULL for object. */
Tcl_Interp *interp, /* For error reporting and lookup. */
| | | | 1024 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 |
* ----------------------------------------------------------------------
*/
int
TclOODefinePropertyCmd(
void *useInstance, /* NULL for class, non-NULL for object. */
Tcl_Interp *interp, /* For error reporting and lookup. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const *objv) /* Arguments. */
{
Tcl_Size i;
const char *const options[] = {
"-get", "-kind", "-set", NULL
};
enum Options {
OPT_GET, OPT_KIND, OPT_SET
};
const char *const kinds[] = {
|
| ︙ | ︙ | |||
1189 1190 1191 1192 1193 1194 1195 |
* ----------------------------------------------------------------------
*/
int
TclOOInfoClassPropCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | > | | 1189 1190 1191 1192 1193 1194 1195 1196 1197 1198 1199 1200 1201 1202 1203 1204 1205 1206 1207 1208 |
* ----------------------------------------------------------------------
*/
int
TclOOInfoClassPropCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const objv[])
{
Class *clsPtr;
Tcl_Size i;
int idx, all = 0, writable = 0, allocated = 0;
Tcl_Obj *result;
if (objc < 2) {
Tcl_WrongNumArgs(interp, 1, objv, "className ?options...?");
return TCL_ERROR;
}
clsPtr = TclOOGetClassFromObj(interp, objv[1]);
|
| ︙ | ︙ | |||
1249 1250 1251 1252 1253 1254 1255 |
return TCL_OK;
}
int
TclOOInfoObjectPropCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | > | | 1250 1251 1252 1253 1254 1255 1256 1257 1258 1259 1260 1261 1262 1263 1264 1265 1266 1267 1268 1269 |
return TCL_OK;
}
int
TclOOInfoObjectPropCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const objv[])
{
Object *oPtr;
Tcl_Size i;
int idx, writable = 0, all = 0;
Tcl_Obj *result;
if (objc < 2) {
Tcl_WrongNumArgs(interp, 1, objv, "objName ?options...?");
return TCL_ERROR;
}
oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[1]);
|
| ︙ | ︙ |
Changes to generic/tclOOStubInit.c.
| ︙ | ︙ | |||
9 10 11 12 13 14 15 16 17 18 19 20 21 22 |
#include "tclOOInt.h"
MODULE_SCOPE const TclOOStubs tclOOStubs;
#ifdef __GNUC__
#pragma GCC dependency "tclOO.decls"
#endif
/* !BEGIN!: Do not edit below this line. */
static const TclOOIntStubs tclOOIntStubs = {
TCL_STUB_MAGIC,
0,
TclOOGetDefineCmdContext, /* 0 */
| > > > > > > > > > > > > > | 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 |
#include "tclOOInt.h"
MODULE_SCOPE const TclOOStubs tclOOStubs;
#ifdef __GNUC__
#pragma GCC dependency "tclOO.decls"
#endif
#ifdef TCL_NO_DEPRECATED
# undef Tcl_MethodIsType
# undef Tcl_NewInstanceMethod
# undef Tcl_NewMethod
# undef TclOOMakeProcInstanceMethod
# undef TclOOMakeProcMethod
# define Tcl_MethodIsType 0
# define Tcl_NewInstanceMethod 0
# define Tcl_NewMethod 0
# define TclOOMakeProcInstanceMethod 0
# define TclOOMakeProcMethod 0
#endif
/* !BEGIN!: Do not edit below this line. */
static const TclOOIntStubs tclOOIntStubs = {
TCL_STUB_MAGIC,
0,
TclOOGetDefineCmdContext, /* 0 */
|
| ︙ | ︙ |
Changes to generic/tclObj.c.
| ︙ | ︙ | |||
1046 1047 1048 1049 1050 1051 1052 |
* Add entry to a thread local map used to check if a Tcl_Obj was
* allocated by the currently executing thread.
*/
if (!TclInExit()) {
Tcl_HashEntry *hPtr;
Tcl_HashTable *tablePtr;
| < | | | > > > > | > | 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080 1081 1082 1083 1084 1085 1086 |
* Add entry to a thread local map used to check if a Tcl_Obj was
* allocated by the currently executing thread.
*/
if (!TclInExit()) {
Tcl_HashEntry *hPtr;
Tcl_HashTable *tablePtr;
ObjData *objData;
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
if (tsdPtr->objThreadMap == NULL) {
tsdPtr->objThreadMap = (Tcl_HashTable *)Tcl_Alloc(sizeof(Tcl_HashTable));
Tcl_InitHashTable(tsdPtr->objThreadMap, TCL_ONE_WORD_KEYS);
}
tablePtr = tsdPtr->objThreadMap;
hPtr = Tcl_AttemptCreateHashEntry(tablePtr, objPtr, NULL);
if (!hPtr) {
/* This is just for debugging, in case of memory problem just remove it */
Tcl_DeleteHashTable(tsdPtr->objThreadMap);
Tcl_Free(tsdPtr->objThreadMap);
tsdPtr->objThreadMap = NULL;
}
/*
* Record the debugging information.
*/
objData = (ObjData *)Tcl_Alloc(sizeof(ObjData));
objData->objPtr = objPtr;
objData->file = file;
objData->line = line;
if (hPtr) {
Tcl_SetHashValue(hPtr, objData);
}
}
#endif /* TCL_THREADS */
}
#endif /* TCL_MEM_DEBUG */
/*
*----------------------------------------------------------------------
|
| ︙ | ︙ | |||
1287 1288 1289 1290 1291 1292 1293 |
if (!TclInExit()) {
Tcl_HashTable *tablePtr;
Tcl_HashEntry *hPtr;
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
tablePtr = tsdPtr->objThreadMap;
if (!tablePtr) {
| | | 1291 1292 1293 1294 1295 1296 1297 1298 1299 1300 1301 1302 1303 1304 1305 |
if (!TclInExit()) {
Tcl_HashTable *tablePtr;
Tcl_HashEntry *hPtr;
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
tablePtr = tsdPtr->objThreadMap;
if (!tablePtr) {
Tcl_Panic("%s: object table not initialized", "TclFreeObj");
}
hPtr = Tcl_FindHashEntry(tablePtr, objPtr);
if (hPtr) {
/*
* As the Tcl_Obj is going to be deleted we remove the entry.
*/
|
| ︙ | ︙ | |||
2820 2821 2822 2823 2824 2825 2826 |
* function; used for debugging. */
int line) /* Line number in the source file; used for
* debugging. */
{
Tcl_Obj *objPtr;
TclDbNewObj(objPtr, file, line);
| > | > | 2824 2825 2826 2827 2828 2829 2830 2831 2832 2833 2834 2835 2836 2837 2838 2839 2840 |
* function; used for debugging. */
int line) /* Line number in the source file; used for
* debugging. */
{
Tcl_Obj *objPtr;
TclDbNewObj(objPtr, file, line);
if (objPtr) {
TclSetIntObj(objPtr, wideValue);
}
return objPtr;
}
#else /* if not TCL_MEM_DEBUG */
Tcl_Obj *
Tcl_DbNewWideIntObj(
|
| ︙ | ︙ | |||
3828 3829 3830 3831 3832 3833 3834 |
if (!TclInExit()) {
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
Tcl_HashTable *tablePtr = tsdPtr->objThreadMap;
Tcl_HashEntry *hPtr;
if (!tablePtr) {
| | | | | 3834 3835 3836 3837 3838 3839 3840 3841 3842 3843 3844 3845 3846 3847 3848 3849 3850 3851 3852 3853 |
if (!TclInExit()) {
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
Tcl_HashTable *tablePtr = tsdPtr->objThreadMap;
Tcl_HashEntry *hPtr;
if (!tablePtr) {
Tcl_Panic("%s: object table not initialized", "Tcl_DbIncrRefCount");
}
hPtr = Tcl_FindHashEntry(tablePtr, objPtr);
if (!hPtr) {
Tcl_Panic("%s: Tcl_Obj allocated in another thread",
"Tcl_DbIncrRefCount");
}
}
# endif /* TCL_THREADS */
++(objPtr)->refCount;
}
#else /* !TCL_MEM_DEBUG */
void
|
| ︙ | ︙ | |||
3901 3902 3903 3904 3905 3906 3907 |
if (!TclInExit()) {
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
Tcl_HashTable *tablePtr = tsdPtr->objThreadMap;
Tcl_HashEntry *hPtr;
if (!tablePtr) {
| | | | | 3907 3908 3909 3910 3911 3912 3913 3914 3915 3916 3917 3918 3919 3920 3921 3922 3923 3924 3925 3926 |
if (!TclInExit()) {
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
Tcl_HashTable *tablePtr = tsdPtr->objThreadMap;
Tcl_HashEntry *hPtr;
if (!tablePtr) {
Tcl_Panic("%s: object table not initialized", "Tcl_DbDecrRefCount");
}
hPtr = Tcl_FindHashEntry(tablePtr, objPtr);
if (!hPtr) {
Tcl_Panic("%s: Tcl_Obj allocated in another thread",
"Tcl_DbDecrRefCount");
}
}
# endif /* TCL_THREADS */
if (objPtr->refCount-- <= 1) {
TclFreeObj(objPtr);
}
|
| ︙ | ︙ | |||
3984 3985 3986 3987 3988 3989 3990 |
if (!TclInExit()) {
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
Tcl_HashTable *tablePtr = tsdPtr->objThreadMap;
Tcl_HashEntry *hPtr;
if (!tablePtr) {
| | | | | 3990 3991 3992 3993 3994 3995 3996 3997 3998 3999 4000 4001 4002 4003 4004 4005 4006 4007 4008 4009 |
if (!TclInExit()) {
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
Tcl_HashTable *tablePtr = tsdPtr->objThreadMap;
Tcl_HashEntry *hPtr;
if (!tablePtr) {
Tcl_Panic("%s: object table not initialized", "Tcl_DbIsShared");
}
hPtr = Tcl_FindHashEntry(tablePtr, objPtr);
if (!hPtr) {
Tcl_Panic("%s: Tcl_Obj allocated in another thread",
"Tcl_DbIsShared");
}
}
# endif /* TCL_THREADS */
#endif /* TCL_MEM_DEBUG */
#ifdef TCL_COMPILE_STATS
Tcl_MutexLock(&tclObjMutex);
|
| ︙ | ︙ | |||
4583 4584 4585 4586 4587 4588 4589 |
*----------------------------------------------------------------------
*/
int
Tcl_RepresentationCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | 4589 4590 4591 4592 4593 4594 4595 4596 4597 4598 4599 4600 4601 4602 4603 |
*----------------------------------------------------------------------
*/
int
Tcl_RepresentationCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const objv[])
{
Tcl_Obj *descObj;
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "value");
return TCL_ERROR;
|
| ︙ | ︙ |
Changes to generic/tclPkg.c.
| ︙ | ︙ | |||
101 102 103 104 105 106 107 | static Package * FindPackage(Tcl_Interp *interp, const char *name); static int PkgRequireCore(void *data[], Tcl_Interp *interp, int result); static int PkgRequireCoreFinal(void *data[], Tcl_Interp *interp, int result); static int PkgRequireCoreCleanup(void *data[], Tcl_Interp *interp, int result); static int PkgRequireCoreStep1(void *data[], Tcl_Interp *interp, int result); static int PkgRequireCoreStep2(void *data[], Tcl_Interp *interp, int result); static int TclNRPkgRequireProc(void *clientData, Tcl_Interp *interp, | | | 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 | static Package * FindPackage(Tcl_Interp *interp, const char *name); static int PkgRequireCore(void *data[], Tcl_Interp *interp, int result); static int PkgRequireCoreFinal(void *data[], Tcl_Interp *interp, int result); static int PkgRequireCoreCleanup(void *data[], Tcl_Interp *interp, int result); static int PkgRequireCoreStep1(void *data[], Tcl_Interp *interp, int result); static int PkgRequireCoreStep2(void *data[], Tcl_Interp *interp, int result); static int TclNRPkgRequireProc(void *clientData, Tcl_Interp *interp, Tcl_Size reqc, Tcl_Obj *const reqv[]); static int SelectPackage(void *data[], Tcl_Interp *interp, int result); static int SelectPackageFinal(void *data[], Tcl_Interp *interp, int result); static int TclNRPackageObjCmdCleanup(void *data[], Tcl_Interp *interp, int result); /* * Helper macros. */ |
| ︙ | ︙ | |||
435 436 437 438 439 440 441 |
* available. */
void *clientDataPtr)
{
RequireProcArgs args;
args.name = name;
args.clientDataPtr = clientDataPtr;
| | | | 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 |
* available. */
void *clientDataPtr)
{
RequireProcArgs args;
args.name = name;
args.clientDataPtr = clientDataPtr;
return Tcl_NRCallObjProc2(interp,
TclNRPkgRequireProc, (void *) &args, reqc, reqv);
}
static int
TclNRPkgRequireProc(
void *clientData,
Tcl_Interp *interp,
Tcl_Size reqc,
Tcl_Obj *const reqv[])
{
RequireProcArgs *args = (RequireProcArgs *)clientData;
Tcl_NRAddCallback(interp,
PkgRequireCore, (void *) args->name, INT2PTR(reqc), (void *) reqv,
args->clientDataPtr);
|
| ︙ | ︙ | |||
1050 1051 1052 1053 1054 1055 1056 |
*
*----------------------------------------------------------------------
*/
int
Tcl_PackageObjCmd(
void *clientData,
Tcl_Interp *interp, /* Current interpreter. */
| | | | | 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 |
*
*----------------------------------------------------------------------
*/
int
Tcl_PackageObjCmd(
void *clientData,
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
return Tcl_NRCallObjProc2(interp, TclNRPackageObjCmd, clientData, objc, objv);
}
int
TclNRPackageObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
static const char *const pkgOptions[] = {
"files", "forget", "ifneeded", "names", "prefer",
"present", "provide", "require", "unknown", "vcompare",
"versions", "vsatisfies", NULL
};
|
| ︙ | ︙ |
Changes to generic/tclProc.c.
| ︙ | ︙ | |||
29 30 31 32 33 34 35 | /* * Prototypes for static functions in this file */ static void DupLambdaInternalRep(Tcl_Obj *objPtr, Tcl_Obj *copyPtr); static void FreeLambdaInternalRep(Tcl_Obj *objPtr); | | | < | 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 |
/*
* Prototypes for static functions in this file
*/
static void DupLambdaInternalRep(Tcl_Obj *objPtr,
Tcl_Obj *copyPtr);
static void FreeLambdaInternalRep(Tcl_Obj *objPtr);
static int InitArgsAndLocals(Tcl_Interp *interp, Tcl_Size skip);
static void InitResolvedLocals(Tcl_Interp *interp,
ByteCode *codePtr, Var *defPtr,
Namespace *nsPtr);
static void InitLocalCache(Proc *procPtr);
static void ProcBodyDup(Tcl_Obj *srcPtr, Tcl_Obj *dupPtr);
static void ProcBodyFree(Tcl_Obj *objPtr);
static int ProcWrongNumArgs(Tcl_Interp *interp, Tcl_Size skip);
static void MakeProcError(Tcl_Interp *interp,
Tcl_Obj *procNameObj);
static void MakeLambdaError(Tcl_Interp *interp,
Tcl_Obj *procNameObj);
static int SetLambdaFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
static Tcl_NRPostProc ApplyNR2;
static Tcl_NRPostProc InterpProcNR2;
/*
* The ProcBodyObjType type
*/
const Tcl_ObjType tclProcBodyType = {
"procbody",
|
| ︙ | ︙ | |||
148 149 150 151 152 153 154 | * * Side effects: * A new procedure gets created. * *---------------------------------------------------------------------- */ | | | 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 |
*
* Side effects:
* A new procedure gets created.
*
*----------------------------------------------------------------------
*/
#undef TclObjInterpProc2
int
Tcl_ProcObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
|
| ︙ | ︙ | |||
206 207 208 209 210 211 212 |
Tcl_AddErrorInfo(interp, "\n (creating proc \"");
Tcl_AddErrorInfo(interp, simpleName);
Tcl_AddErrorInfo(interp, "\")");
return TCL_ERROR;
}
cmd = TclNRCreateCommandInNs(interp, simpleName, (Tcl_Namespace *) nsPtr,
| | | 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 |
Tcl_AddErrorInfo(interp, "\n (creating proc \"");
Tcl_AddErrorInfo(interp, simpleName);
Tcl_AddErrorInfo(interp, "\")");
return TCL_ERROR;
}
cmd = TclNRCreateCommandInNs(interp, simpleName, (Tcl_Namespace *) nsPtr,
TclObjInterpProc2, TclNRInterpProc, procPtr, TclProcDeleteProc);
/*
* Now initialize the new procedure's cmdPtr field. This will be used
* later when the procedure is called to determine what namespace the
* procedure will run in. This will be different than the current
* namespace if the proc was renamed into a different namespace.
*/
|
| ︙ | ︙ | |||
777 778 779 780 781 782 783 |
Tcl_Interp *interp, /* Interpreter in which to find frame. */
Tcl_Obj *objPtr, /* Object describing frame. */
CallFrame **framePtrPtr) /* Store pointer to frame here (or NULL if
* global frame indicated); when NULL itself,
* no frame resolution is wanted. */
{
Interp *iPtr = (Interp *) interp;
| | | 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 |
Tcl_Interp *interp, /* Interpreter in which to find frame. */
Tcl_Obj *objPtr, /* Object describing frame. */
CallFrame **framePtrPtr) /* Store pointer to frame here (or NULL if
* global frame indicated); when NULL itself,
* no frame resolution is wanted. */
{
Interp *iPtr = (Interp *) interp;
Tcl_Size curLevel;
int result, level;
const Tcl_ObjInternalRep *irPtr;
const char *name = NULL;
Tcl_WideInt w;
/*
* Parse object to figure out which level number to go to.
|
| ︙ | ︙ | |||
799 800 801 802 803 804 805 |
* a generation of a stringrep.
*/
if (objPtr == NULL) {
/* Do nothing */
} else if (TCL_OK == Tcl_GetIntFromObj(NULL, objPtr, &level)) {
TclGetWideIntFromObj(NULL, objPtr, &w);
| | | | | 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 |
* a generation of a stringrep.
*/
if (objPtr == NULL) {
/* Do nothing */
} else if (TCL_OK == Tcl_GetIntFromObj(NULL, objPtr, &level)) {
TclGetWideIntFromObj(NULL, objPtr, &w);
if (w < 0 || w > INT_MAX || curLevel > INT_MAX) {
result = -1;
} else {
level = (int)curLevel - level;
result = 1;
}
} else if ((irPtr = TclFetchInternalRep(objPtr, &levelReferenceType))) {
level = (int)irPtr->wideValue;
result = 1;
} else {
name = TclGetString(objPtr);
if (name[0] == '#') {
if (TCL_OK == Tcl_GetInt(NULL, name+1, &level)) {
if (level < 0 || (level > 0 && name[1] == '-')) {
result = -1;
|
| ︙ | ︙ | |||
845 846 847 848 849 850 851 |
/* if relative current level */
if (result == 0) {
if (!curLevel) {
/* we are in top-level, so simply generate bad level */
name = "1";
goto badLevel;
}
| | | 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 |
/* if relative current level */
if (result == 0) {
if (!curLevel) {
/* we are in top-level, so simply generate bad level */
name = "1";
goto badLevel;
}
level = (int)curLevel - 1;
}
if (level >= 0) {
CallFrame *framePtr;
for (framePtr = iPtr->varFramePtr; framePtr != NULL;
framePtr = framePtr->callerVarPtr) {
if ((int)framePtr->level == level) {
*framePtrPtr = framePtr;
|
| ︙ | ︙ | |||
909 910 911 912 913 914 915 |
return result;
}
int
Tcl_UplevelObjCmd(
void *clientData,
Tcl_Interp *interp, /* Current interpreter. */
| | | | | | 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 936 937 938 |
return result;
}
int
Tcl_UplevelObjCmd(
void *clientData,
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
return Tcl_NRCallObjProc2(interp, TclNRUplevelObjCmd, clientData, objc, objv);
}
int
TclNRUplevelObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Interp *iPtr = (Interp *) interp;
CmdFrame *invoker = NULL;
Tcl_Size word = 0;
int result;
CallFrame *savedVarFramePtr, *framePtr;
Tcl_Obj *objPtr;
if (objc < 2) {
/* to do
* simplify things by interpreting the argument as a command when there
|
| ︙ | ︙ | |||
1074 1075 1076 1077 1078 1079 1080 |
{
Tcl_Command origCmd = TclGetOriginalCommand((Tcl_Command) cmdPtr);
if (origCmd != NULL) {
cmdPtr = (Command *) origCmd;
}
if (cmdPtr->deleteProc == TclProcDeleteProc) {
| | | | 1073 1074 1075 1076 1077 1078 1079 1080 1081 1082 1083 1084 1085 1086 1087 1088 1089 1090 1091 1092 1093 1094 1095 |
{
Tcl_Command origCmd = TclGetOriginalCommand((Tcl_Command) cmdPtr);
if (origCmd != NULL) {
cmdPtr = (Command *) origCmd;
}
if (cmdPtr->deleteProc == TclProcDeleteProc) {
return (Proc *)cmdPtr->objClientData2;
}
return NULL;
}
static int
ProcWrongNumArgs(
Tcl_Interp *interp,
Tcl_Size skip)
{
CallFrame *framePtr = ((Interp *)interp)->varFramePtr;
Proc *procPtr = framePtr->procPtr;
Tcl_Size localCt = procPtr->numCompiledLocals, numArgs, i;
Tcl_Obj **desiredObjs;
const char *final = NULL;
|
| ︙ | ︙ | |||
1166 1167 1168 1169 1170 1171 1172 |
ByteCode *codePtr,
Var *varPtr,
Namespace *nsPtr) /* Pointer to current namespace. */
{
Interp *iPtr = (Interp *) interp;
int haveResolvers = (nsPtr->compiledVarResProc || iPtr->resolverPtr);
CompiledLocal *firstLocalPtr, *localPtr;
| | | 1165 1166 1167 1168 1169 1170 1171 1172 1173 1174 1175 1176 1177 1178 1179 |
ByteCode *codePtr,
Var *varPtr,
Namespace *nsPtr) /* Pointer to current namespace. */
{
Interp *iPtr = (Interp *) interp;
int haveResolvers = (nsPtr->compiledVarResProc || iPtr->resolverPtr);
CompiledLocal *firstLocalPtr, *localPtr;
Tcl_Size varNum;
Tcl_ResolvedVarInfo *resVarInfo;
/*
* Find the localPtr corresponding to varPtr
*/
varNum = varPtr - iPtr->framePtr->compiledLocals;
|
| ︙ | ︙ | |||
1361 1362 1363 1364 1365 1366 1367 |
*----------------------------------------------------------------------
*/
static int
InitArgsAndLocals(
Tcl_Interp *interp, /* Interpreter in which procedure was
* invoked. */
| | | 1360 1361 1362 1363 1364 1365 1366 1367 1368 1369 1370 1371 1372 1373 1374 |
*----------------------------------------------------------------------
*/
static int
InitArgsAndLocals(
Tcl_Interp *interp, /* Interpreter in which procedure was
* invoked. */
Tcl_Size skip) /* Number of initial arguments to be skipped,
* i.e., words in the "command name". */
{
CallFrame *framePtr = ((Interp *)interp)->varFramePtr;
Proc *procPtr = framePtr->procPtr;
ByteCode *codePtr;
Var *varPtr, *defPtr;
Tcl_Size localCt = procPtr->numCompiledLocals, numArgs, argCt, i, imax;
|
| ︙ | ︙ | |||
1601 1602 1603 1604 1605 1606 1607 |
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
| | | | | | 1600 1601 1602 1603 1604 1605 1606 1607 1608 1609 1610 1611 1612 1613 1614 1615 1616 1617 1618 1619 1620 1621 1622 1623 1624 1625 1626 1627 1628 1629 1630 1631 1632 1633 1634 1635 1636 1637 1638 1639 1640 1641 1642 |
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
* TclObjInterpProc2/TclNRInterpProc --
*
* When a Tcl procedure gets invoked during bytecode evaluation, this
* object-based routine gets invoked to interpret the procedure.
*
* Results:
* A standard Tcl object result value.
*
* Side effects:
* Depends on the commands in the procedure.
*
*----------------------------------------------------------------------
*/
int
TclObjInterpProc2(
void *clientData, /* Record describing procedure to be
* interpreted. */
Tcl_Interp *interp, /* Interpreter in which procedure was
* invoked. */
Tcl_Size objc, /* Count of number of arguments to this
* procedure. */
Tcl_Obj *const objv[]) /* Argument value objects. */
{
/*
* Not used much in the core; external interface for iTcl
*/
return Tcl_NRCallObjProc2(interp, TclNRInterpProc, clientData, objc, objv);
}
int
TclNRInterpProc(
void *clientData, /* Record describing procedure to be
* interpreted. */
Tcl_Interp *interp, /* Interpreter in which procedure was
|
| ︙ | ︙ | |||
1651 1652 1653 1654 1655 1656 1657 1658 1659 |
if (result != TCL_OK) {
return TCL_ERROR;
}
return TclNRInterpProcCore(interp, objv[0], 1, &MakeProcError);
}
static int
NRInterpProc(
| > | > | | | | | > | > | 1650 1651 1652 1653 1654 1655 1656 1657 1658 1659 1660 1661 1662 1663 1664 1665 1666 1667 1668 1669 1670 1671 1672 1673 1674 1675 1676 1677 1678 1679 1680 1681 1682 1683 1684 1685 1686 1687 1688 1689 1690 1691 1692 1693 1694 1695 1696 1697 1698 1699 1700 1701 1702 1703 |
if (result != TCL_OK) {
return TCL_ERROR;
}
return TclNRInterpProcCore(interp, objv[0], 1, &MakeProcError);
}
#ifndef TCL_NO_DEPRECATED
static int
NRInterpProc(
void *clientData, /* Record describing procedure to be
* interpreted. */
Tcl_Interp *interp, /* Interpreter in which procedure was
* invoked. */
int objc, /* Count of number of arguments to this
* procedure. */
Tcl_Obj *const objv[]) /* Argument value objects. */
{
int result = TclPushProcCallFrame(clientData, interp, objc, objv,
/*isLambda*/ 0);
if (result != TCL_OK) {
return TCL_ERROR;
}
return TclNRInterpProcCore(interp, objv[0], 1, &MakeProcError);
}
#undef TclObjInterpProc
int
TclObjInterpProc(
void *clientData, /* Record describing procedure to be
* interpreted. */
Tcl_Interp *interp, /* Interpreter in which procedure was
* invoked. */
int objc, /* Count of number of arguments to this
* procedure. */
Tcl_Obj *const objv[]) /* Argument value objects. */
{
/*
* Not used much in the core; external interface for iTcl
*/
return Tcl_NRCallObjProc(interp, NRInterpProc, clientData, objc, objv);
}
#endif /* TCL_NO_DEPRECATED */
/*
*----------------------------------------------------------------------
*
* TclNRInterpProcCore --
*
* When a Tcl procedure, lambda term or anything else that works like a
* procedure gets invoked during bytecode evaluation, this object-based
|
| ︙ | ︙ | |||
2010 2011 2012 2013 2014 2015 2016 |
*/
iPtr->compiledProcPtr = procPtr;
if (procPtr->numCompiledLocals > procPtr->numArgs) {
CompiledLocal *clPtr = procPtr->firstLocalPtr;
CompiledLocal *lastPtr = NULL;
| | | 2013 2014 2015 2016 2017 2018 2019 2020 2021 2022 2023 2024 2025 2026 2027 |
*/
iPtr->compiledProcPtr = procPtr;
if (procPtr->numCompiledLocals > procPtr->numArgs) {
CompiledLocal *clPtr = procPtr->firstLocalPtr;
CompiledLocal *lastPtr = NULL;
Tcl_Size i, numArgs = procPtr->numArgs;
for (i = 0; i < numArgs; i++) {
lastPtr = clPtr;
clPtr = clPtr->nextPtr;
}
if (lastPtr) {
|
| ︙ | ︙ | |||
2075 2076 2077 2078 2079 2080 2081 | } /* *---------------------------------------------------------------------- * * MakeProcError -- * | | | 2078 2079 2080 2081 2082 2083 2084 2085 2086 2087 2088 2089 2090 2091 2092 | } /* *---------------------------------------------------------------------- * * MakeProcError -- * * Function called by TclObjInterpProc2 to create the stack information * upon an error from a procedure. * * Results: * The interpreter's error info trace is set to a value that supplements * the error code. * * Side effects: |
| ︙ | ︙ | |||
2277 2278 2279 2280 2281 2282 2283 |
}
return code;
}
/*
*----------------------------------------------------------------------
*
| | | | | | | < > > | | 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 2307 2308 2309 2310 2311 2312 2313 2314 2315 2316 2317 2318 2319 2320 2321 |
}
return code;
}
/*
*----------------------------------------------------------------------
*
* TclGetObjInterpProc2 --
*
* Returns a pointer to the TclObjInterpProc2 function; this is different
* from the value obtained from the TclObjInterpProc2 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 TclObjInterpProc2 function.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
#ifndef TCL_NO_DEPRECATED
Tcl_ObjCmdProc *
TclGetObjInterpProc(void)
{
return TclObjInterpProc;
}
#endif /* TCL_NO_DEPRECATED */
Tcl_ObjCmdProc2 *
TclGetObjInterpProc2(void)
{
return TclObjInterpProc2;
}
/*
*----------------------------------------------------------------------
*
* TclNewProcBodyObj --
*
|
| ︙ | ︙ | |||
2677 2678 2679 2680 2681 2682 2683 |
*----------------------------------------------------------------------
*/
int
Tcl_ApplyObjCmd(
void *clientData,
Tcl_Interp *interp, /* Current interpreter. */
| | | | | 2681 2682 2683 2684 2685 2686 2687 2688 2689 2690 2691 2692 2693 2694 2695 2696 2697 2698 2699 2700 2701 2702 2703 2704 2705 |
*----------------------------------------------------------------------
*/
int
Tcl_ApplyObjCmd(
void *clientData,
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
return Tcl_NRCallObjProc2(interp, TclNRApplyObjCmd, clientData, objc, objv);
}
int
TclNRApplyObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Proc *procPtr = NULL;
Tcl_Obj *lambdaPtr, *nsObjPtr;
int result;
Tcl_Namespace *nsPtr;
ApplyExtraData *extraPtr;
|
| ︙ | ︙ | |||
2715 2716 2717 2718 2719 2720 2721 |
if (procPtr == NULL) {
return TCL_ERROR;
}
/*
* Push a call frame for the lambda namespace.
| | | 2719 2720 2721 2722 2723 2724 2725 2726 2727 2728 2729 2730 2731 2732 2733 |
if (procPtr == NULL) {
return TCL_ERROR;
}
/*
* Push a call frame for the lambda namespace.
* Note that TclObjInterpProc2() will pop it.
*/
result = TclGetNamespaceFromObj(interp, nsObjPtr, &nsPtr);
if (result != TCL_OK) {
return TCL_ERROR;
}
|
| ︙ | ︙ | |||
2769 2770 2771 2772 2773 2774 2775 | } /* *---------------------------------------------------------------------- * * MakeLambdaError -- * | | | 2773 2774 2775 2776 2777 2778 2779 2780 2781 2782 2783 2784 2785 2786 2787 | } /* *---------------------------------------------------------------------- * * MakeLambdaError -- * * Function called by TclObjInterpProc2 to create the stack information * upon an error from a lambda term. * * Results: * The interpreter's error info trace is set to a value that supplements * the error code. * * Side effects: |
| ︙ | ︙ | |||
2933 2934 2935 2936 2937 2938 2939 |
goto procError;
}
origLocal = origLocal->nextPtr;
}
// Create the new command backed by the procedure.
newProc->cmdPtr = (Command *) TclNRCreateCommandInNs(interp, cmdName,
| | | 2937 2938 2939 2940 2941 2942 2943 2944 2945 2946 2947 2948 2949 2950 2951 |
goto procError;
}
origLocal = origLocal->nextPtr;
}
// Create the new command backed by the procedure.
newProc->cmdPtr = (Command *) TclNRCreateCommandInNs(interp, cmdName,
(Tcl_Namespace *) nsPtr, TclObjInterpProc2, TclNRInterpProc, newProc,
TclProcDeleteProc);
// TIP #280: Duplicate the origin information (if we have it).
origHePtr = Tcl_FindHashEntry(iPtr->linePBodyPtr, origProc);
if (origHePtr) {
CmdFrame *newCfPtr = (CmdFrame *) Tcl_Alloc(sizeof(CmdFrame));
const CmdFrame *origCfPtr = (CmdFrame *) Tcl_GetHashValue(origHePtr);
|
| ︙ | ︙ | |||
3002 3003 3004 3005 3006 3007 3008 |
for (Tcl_HashEntry *entryPtr = Tcl_FirstHashEntry(&srcNsPtr->cmdTable, &search);
entryPtr; entryPtr = Tcl_NextHashEntry(&search)) {
const char *cmdName = (const char *)
Tcl_GetHashKey(&srcNsPtr->cmdTable, entryPtr);
Command *cmdPtr = (Command *) Tcl_GetHashValue(entryPtr);
// For non-procedures, check if this is an import of a procedure; those
| | | | 3006 3007 3008 3009 3010 3011 3012 3013 3014 3015 3016 3017 3018 3019 3020 3021 3022 3023 3024 3025 3026 3027 3028 3029 3030 3031 |
for (Tcl_HashEntry *entryPtr = Tcl_FirstHashEntry(&srcNsPtr->cmdTable, &search);
entryPtr; entryPtr = Tcl_NextHashEntry(&search)) {
const char *cmdName = (const char *)
Tcl_GetHashKey(&srcNsPtr->cmdTable, entryPtr);
Command *cmdPtr = (Command *) Tcl_GetHashValue(entryPtr);
// For non-procedures, check if this is an import of a procedure; those
// also get copied.s
if (!TclIsProc(cmdPtr)) {
Command *realCmdPtr = (Command *)
TclGetOriginalCommand((Tcl_Command) cmdPtr);
if (!realCmdPtr || !TclIsProc(realCmdPtr)) {
continue;
}
cmdPtr = realCmdPtr;
}
// Make the copy
Proc *procPtr = (Proc *) cmdPtr->objClientData2;
if (DuplicateProc(interp, tgtNsPtr, cmdName, procPtr, cmdPtr) != TCL_OK) {
return TCL_ERROR;
}
}
return TCL_OK;
}
|
| ︙ | ︙ |
Changes to generic/tclProcess.c.
| ︙ | ︙ | |||
48 49 50 51 52 53 54 | Tcl_Size resolvedPid); static void FreeProcessInfo(ProcessInfo *info); static int RefreshProcessInfo(ProcessInfo *info, int options); static TclProcessWaitStatus WaitProcessStatus(Tcl_Pid pid, Tcl_Size resolvedPid, int options, int *codePtr, Tcl_Obj **msgPtr, Tcl_Obj **errorObjPtr); static Tcl_Obj * BuildProcessStatusObj(ProcessInfo *info); | | | | | | 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 |
Tcl_Size resolvedPid);
static void FreeProcessInfo(ProcessInfo *info);
static int RefreshProcessInfo(ProcessInfo *info, int options);
static TclProcessWaitStatus WaitProcessStatus(Tcl_Pid pid, Tcl_Size resolvedPid,
int options, int *codePtr, Tcl_Obj **msgPtr,
Tcl_Obj **errorObjPtr);
static Tcl_Obj * BuildProcessStatusObj(ProcessInfo *info);
static Tcl_ObjCmdProc2 ProcessListObjCmd;
static Tcl_ObjCmdProc2 ProcessStatusObjCmd;
static Tcl_ObjCmdProc2 ProcessPurgeObjCmd;
static Tcl_ObjCmdProc2 ProcessAutopurgeObjCmd;
const EnsembleImplMap tclProcessImplMap[] = {
{"list", ProcessListObjCmd, TclCompileBasic0ArgCmd, NULL, NULL, 1},
{"status", ProcessStatusObjCmd, TclCompileBasicMin0ArgCmd, NULL, NULL, 1},
{"purge", ProcessPurgeObjCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 1},
{"autopurge", ProcessAutopurgeObjCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 1},
{NULL, NULL, NULL, NULL, NULL, 0}
|
| ︙ | ︙ | |||
424 425 426 427 428 429 430 |
*----------------------------------------------------------------------
*/
static int
ProcessListObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 |
*----------------------------------------------------------------------
*/
static int
ProcessListObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_Obj *list;
Tcl_HashEntry *entry;
Tcl_HashSearch search;
ProcessInfo *info;
|
| ︙ | ︙ | |||
475 476 477 478 479 480 481 |
*----------------------------------------------------------------------
*/
static int
ProcessStatusObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 |
*----------------------------------------------------------------------
*/
static int
ProcessStatusObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_Obj *dict;
int options = WNOHANG;
Tcl_HashEntry *entry;
Tcl_HashSearch search;
ProcessInfo *info;
|
| ︙ | ︙ | |||
623 624 625 626 627 628 629 |
*----------------------------------------------------------------------
*/
static int
ProcessPurgeObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 |
*----------------------------------------------------------------------
*/
static int
ProcessPurgeObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_HashEntry *entry;
Tcl_HashSearch search;
ProcessInfo *info;
Tcl_Size i, numPids;
Tcl_Obj **pidObjs;
|
| ︙ | ︙ | |||
721 722 723 724 725 726 727 |
*----------------------------------------------------------------------
*/
static int
ProcessAutopurgeObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 |
*----------------------------------------------------------------------
*/
static int
ProcessAutopurgeObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
if (objc != 1 && objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "?flag?");
return TCL_ERROR;
}
|
| ︙ | ︙ |
Changes to generic/tclRegexp.c.
| ︙ | ︙ | |||
931 932 933 934 935 936 937 |
numChars = Tcl_DStringLength(&stringBuf) / sizeof(Tcl_UniChar);
/*
* Compile the string and check for errors.
*/
regexpPtr->flags = flags;
| | | 931 932 933 934 935 936 937 938 939 940 941 942 943 944 945 |
numChars = Tcl_DStringLength(&stringBuf) / sizeof(Tcl_UniChar);
/*
* Compile the string and check for errors.
*/
regexpPtr->flags = flags;
status = TclReComp(®expPtr->re, uniString, (size_t)numChars, flags);
Tcl_DStringFree(&stringBuf);
if (status != REG_OKAY) {
/*
* Clean up and report errors in the interpreter, if possible.
*/
|
| ︙ | ︙ |
Changes to generic/tclResult.c.
| ︙ | ︙ | |||
1219 1220 1221 1222 1223 1224 1225 |
*
*----------------------------------------------------------------------
*/
int
TclSafeCatchCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | 1219 1220 1221 1222 1223 1224 1225 1226 1227 1228 1229 1230 1231 1232 1233 |
*
*----------------------------------------------------------------------
*/
int
TclSafeCatchCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const objv[])
{
Interp *iPtr = (Interp *)interp;
int ret, flags = 0;
InterpState *statePtr;
if (objc == 1) {
|
| ︙ | ︙ |
Changes to generic/tclScan.c.
| ︙ | ︙ | |||
72 73 74 75 76 77 78 |
*/
static const char *
BuildCharSet(
CharSet *cset,
const char *format) /* Points to first char of set. */
{
| < < > > > | 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 |
*/
static const char *
BuildCharSet(
CharSet *cset,
const char *format) /* Points to first char of set. */
{
const char *end;
Tcl_Size offset;
int nranges;
Tcl_UniChar ch = 0, start;
memset(cset, 0, sizeof(CharSet));
offset = TclUtfToUniChar(format, &ch);
if (ch == '^') {
cset->exclude = 1;
format += offset;
|
| ︙ | ︙ | |||
591 592 593 594 595 596 597 |
*----------------------------------------------------------------------
*/
int
Tcl_ScanObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | | | | | 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 |
*----------------------------------------------------------------------
*/
int
Tcl_ScanObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
const char *format;
int numVars, nconversions, totalVars = -1;
int objIndex, value, i, result, code;
Tcl_Size offset;
const char *string, *end, *baseString;
char op = 0;
int underflow = 0;
Tcl_Size width;
Tcl_WideInt wideValue;
Tcl_UniChar ch = 0, sch = 0;
Tcl_Obj **objs = NULL, *objPtr = NULL;
int flags;
if (objc < 3 || objc - 3 > INT_MAX) {
Tcl_WrongNumArgs(interp, 1, objv,
"string format ?varName ...?");
return TCL_ERROR;
}
format = TclGetString(objv[2]);
numVars = (int)objc-3;
/*
* Check for errors in the format string.
*/
if (ValidateFormat(interp, format, numVars, &totalVars) == TCL_ERROR) {
return TCL_ERROR;
|
| ︙ | ︙ |
Changes to generic/tclStrIdxTree.c.
| ︙ | ︙ | |||
483 484 485 486 487 488 489 |
}
TclUnsetObjRef(obj[0]);
}
int
TclStrIdxTreeTestObjCmd(
void *clientData, Tcl_Interp *interp,
| | | 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 |
}
TclUnsetObjRef(obj[0]);
}
int
TclStrIdxTreeTestObjCmd(
void *clientData, Tcl_Interp *interp,
Tcl_Size objc, Tcl_Obj *const objv[])
{
const char *cs, *cin, *ret;
static const char *const options[] = {
"findequal", "index", "puts-index", NULL
};
enum optionInd {
O_FINDEQUAL, O_INDEX, O_PUTS_INDEX
|
| ︙ | ︙ |
Changes to generic/tclStrIdxTree.h.
| ︙ | ︙ | |||
149 150 151 152 153 154 155 | MODULE_SCOPE int TclStrIdxTreeBuildFromList(TclStrIdxTree *idxTree, Tcl_Size lstc, Tcl_Obj **lstv, void **values); MODULE_SCOPE Tcl_Obj * TclStrIdxTreeNewObj(void); MODULE_SCOPE TclStrIdxTree*TclStrIdxTreeGetFromObj(Tcl_Obj *objPtr); #ifdef TEST_STR_IDX_TREE /* currently unused, debug resp. test purposes only */ | | | 149 150 151 152 153 154 155 156 157 158 159 | MODULE_SCOPE int TclStrIdxTreeBuildFromList(TclStrIdxTree *idxTree, Tcl_Size lstc, Tcl_Obj **lstv, void **values); MODULE_SCOPE Tcl_Obj * TclStrIdxTreeNewObj(void); MODULE_SCOPE TclStrIdxTree*TclStrIdxTreeGetFromObj(Tcl_Obj *objPtr); #ifdef TEST_STR_IDX_TREE /* currently unused, debug resp. test purposes only */ MODULE_SCOPE Tcl_ObjCmdProc2 TclStrIdxTreeTestObjCmd; #endif #endif /* _TCLSTRIDXTREE_H */ |
Changes to generic/tclStringObj.c.
| ︙ | ︙ | |||
1886 1887 1888 1889 1890 1891 1892 | int gotMinus = 0, gotHash = 0, gotZero = 0, gotSpace = 0, gotPlus = 0; int gotPrecision, sawFlag, useShort = 0, useBig = 0; Tcl_WideInt width, precision; int useWide = 0; int newXpg, allocSegment = 0; Tcl_Size numChars, segmentLimit, segmentNumBytes; Tcl_Obj *segment; | | | 1886 1887 1888 1889 1890 1891 1892 1893 1894 1895 1896 1897 1898 1899 1900 |
int gotMinus = 0, gotHash = 0, gotZero = 0, gotSpace = 0, gotPlus = 0;
int gotPrecision, sawFlag, useShort = 0, useBig = 0;
Tcl_WideInt width, precision;
int useWide = 0;
int newXpg, allocSegment = 0;
Tcl_Size numChars, segmentLimit, segmentNumBytes;
Tcl_Obj *segment;
Tcl_Size step = TclUtfToUniChar(format, &ch);
format += step;
if (ch != '%') {
numBytes += step;
continue;
}
if (numBytes) {
|
| ︙ | ︙ | |||
2030 2031 2032 2033 2034 2035 2036 | goto errorMsg; } /* * Step 4. Precision. */ | | | 2030 2031 2032 2033 2034 2035 2036 2037 2038 2039 2040 2041 2042 2043 2044 |
goto errorMsg;
}
/*
* Step 4. Precision.
*/
gotPrecision = (int)(precision = 0);
if (ch == '.') {
gotPrecision = 1;
format += step;
step = TclUtfToUniChar(format, &ch);
}
if (isdigit(UCHAR(ch))) {
/* Note ull will be >= 0 because of isdigit check above */
|
| ︙ | ︙ | |||
2151 2152 2153 2154 2155 2156 2157 2158 |
numChars = precision;
Tcl_IncrRefCount(segment);
allocSegment = 1;
}
}
break;
case 'c': {
char buf[4] = "";
| > > < | 2151 2152 2153 2154 2155 2156 2157 2158 2159 2160 2161 2162 2163 2164 2165 2166 2167 |
numChars = precision;
Tcl_IncrRefCount(segment);
allocSegment = 1;
}
}
break;
case 'c': {
Tcl_Size length;
int code;
char buf[4] = "";
if (TclGetIntFromObj(interp, segment, &code) != TCL_OK) {
goto error;
}
if ((unsigned)code > 0x10FFFF) {
code = 0xFFFD;
}
|
| ︙ | ︙ | |||
2370 2371 2372 2373 2374 2375 2376 |
}
if (useShort) {
unsigned short us = (unsigned short) s;
bits = (Tcl_WideUInt) us;
while (us) {
numDigits++;
| | | 2371 2372 2373 2374 2375 2376 2377 2378 2379 2380 2381 2382 2383 2384 2385 |
}
if (useShort) {
unsigned short us = (unsigned short) s;
bits = (Tcl_WideUInt) us;
while (us) {
numDigits++;
us = (unsigned short)(us / base);
}
} else if (useWide) {
Tcl_WideUInt uw = (Tcl_WideUInt) w;
bits = uw;
while (uw) {
numDigits++;
|
| ︙ | ︙ | |||
2427 2428 2429 2430 2431 2432 2433 |
if (index < big.used && (size_t) shift <
CHAR_BIT*sizeof(Tcl_WideUInt) - MP_DIGIT_BIT) {
bits |= ((Tcl_WideUInt) big.dp[index++]) << shift;
shift += MP_DIGIT_BIT;
}
shift -= numBits;
}
| | | | | | 2428 2429 2430 2431 2432 2433 2434 2435 2436 2437 2438 2439 2440 2441 2442 2443 2444 2445 2446 2447 2448 2449 2450 |
if (index < big.used && (size_t) shift <
CHAR_BIT*sizeof(Tcl_WideUInt) - MP_DIGIT_BIT) {
bits |= ((Tcl_WideUInt) big.dp[index++]) << shift;
shift += MP_DIGIT_BIT;
}
shift -= numBits;
}
digitOffset = (int)(bits % base);
if (digitOffset > 9) {
if (ch == 'X') {
bytes[numDigits] = 'A' + (char)digitOffset - 10;
} else {
bytes[numDigits] = 'a' + (char)digitOffset - 10;
}
} else {
bytes[numDigits] = '0' + (char)digitOffset;
}
bits /= base;
}
if (useBig) {
mp_clear(&big);
}
if (gotPrecision) {
|
| ︙ | ︙ | |||
2512 2513 2514 2515 2516 2517 2518 |
}
if (gotPlus) {
*p++ = '+';
}
if (width) {
p += snprintf(p, TCL_INTEGER_SPACE, "%" TCL_LL_MODIFIER "d", width);
if (width > length) {
| | | | | 2513 2514 2515 2516 2517 2518 2519 2520 2521 2522 2523 2524 2525 2526 2527 2528 2529 2530 2531 2532 2533 2534 2535 2536 2537 2538 |
}
if (gotPlus) {
*p++ = '+';
}
if (width) {
p += snprintf(p, TCL_INTEGER_SPACE, "%" TCL_LL_MODIFIER "d", width);
if (width > length) {
length = (int)width;
}
}
if (gotPrecision) {
*p++ = '.';
p += snprintf(p, TCL_INTEGER_SPACE, "%" TCL_LL_MODIFIER "d", precision);
if (precision > INT_MAX - length) {
msg = overflow;
errCode = "OVERFLOW";
goto errorMsg;
}
length += (int)precision;
}
/*
* Don't pass length modifiers!
*/
*p++ = (char) ch;
|
| ︙ | ︙ | |||
3810 3811 3812 3813 3814 3815 3816 |
* The comparison function should compare up to the minimum byte
* length only.
*/
match = memCmpFn(s1, s2, length);
}
if ((match == 0) && (reqlength > length)) {
| | | | > | 3811 3812 3813 3814 3815 3816 3817 3818 3819 3820 3821 3822 3823 3824 3825 3826 3827 3828 |
* The comparison function should compare up to the minimum byte
* length only.
*/
match = memCmpFn(s1, s2, length);
}
if ((match == 0) && (reqlength > length)) {
match = (s1len > s2len) ? 1 : (s1len < s2len) ? -1 : 0;
} else {
match = (match > 0) ? 1 : (match < 0) ? -1 : 0;
}
}
matchdone:
return match;
}
/*
*---------------------------------------------------------------------------
|
| ︙ | ︙ | |||
4140 4141 4142 4143 4144 4145 4146 |
while (bytesLeft) {
/*
* NOTE: We know that the from buffer is NUL-terminated. It's
* part of the contract for objPtr->bytes values. Thus, we can
* skip calling Tcl_UtfCharComplete() here.
*/
| | | 4142 4143 4144 4145 4146 4147 4148 4149 4150 4151 4152 4153 4154 4155 4156 |
while (bytesLeft) {
/*
* NOTE: We know that the from buffer is NUL-terminated. It's
* part of the contract for objPtr->bytes values. Thus, we can
* skip calling Tcl_UtfCharComplete() here.
*/
Tcl_Size bytesInChar = TclUtfToUniChar(from, &chw);
ReverseBytes((unsigned char *)to, (unsigned char *)from,
bytesInChar);
to += bytesInChar;
from += bytesInChar;
bytesLeft -= bytesInChar;
}
|
| ︙ | ︙ | |||
4453 4454 4455 4456 4457 4458 4459 |
* bother copying it. Don't even bother allocating space in which to
* copy it. Just let the copy be untyped.
*/
return;
}
if (srcStringPtr->hasUnicode) {
| | | 4455 4456 4457 4458 4459 4460 4461 4462 4463 4464 4465 4466 4467 4468 4469 |
* bother copying it. Don't even bother allocating space in which to
* copy it. Just let the copy be untyped.
*/
return;
}
if (srcStringPtr->hasUnicode) {
Tcl_Size copyMaxChars;
if (srcStringPtr->maxChars / 2 >= srcStringPtr->numChars) {
copyMaxChars = 2 * srcStringPtr->numChars;
} else {
copyMaxChars = srcStringPtr->maxChars;
}
copyStringPtr = stringAttemptAlloc(copyMaxChars);
|
| ︙ | ︙ |
Changes to generic/tclStubInit.c.
| ︙ | ︙ | |||
47 48 49 50 51 52 53 | #undef Tcl_SetIntObj #undef Tcl_SetLongObj #undef Tcl_SplitPath #undef Tcl_FSSplitPath #undef Tcl_ParseArgsObjv #undef TclStaticLibrary #define TclStaticLibrary Tcl_StaticLibrary | < > > > > | > > > > > | | | | > > > | 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 | #undef Tcl_SetIntObj #undef Tcl_SetLongObj #undef Tcl_SplitPath #undef Tcl_FSSplitPath #undef Tcl_ParseArgsObjv #undef TclStaticLibrary #define TclStaticLibrary Tcl_StaticLibrary #if !defined(_WIN32) && !defined(__CYGWIN__) # undef Tcl_WinConvertError # define Tcl_WinConvertError 0 #endif #undef TclGetStringFromObj #ifdef TCL_NO_DEPRECATED # define TclGetStringFromObj 0 # define TclGetBytesFromObj 0 # define TclGetUnicodeFromObj 0 #endif #define TclUnusedStubEntry 0 #ifdef TCL_NO_DEPRECATED # undef Tcl_CreateObjCommand # undef Tcl_CreateTrace # undef Tcl_CreateObjTrace # undef Tcl_NRCallObjProc # undef Tcl_NRCreateCommand # undef TclGetObjInterpProc # define Tcl_CreateObjCommand 0 # define Tcl_CreateTrace 0 # define Tcl_CreateObjTrace 0 # define Tcl_NRCallObjProc 0 # define Tcl_NRCreateCommand 0 # define TclGetObjInterpProc 0 #endif #define TclUtfCharComplete Tcl_UtfCharComplete #define TclUtfNext Tcl_UtfNext #define TclUtfPrev Tcl_UtfPrev #undef TclListObjGetElements #undef TclListObjLength #ifdef TCL_NO_DEPRECATED |
| ︙ | ︙ | |||
178 179 180 181 182 183 184 |
}
int TclGetAliasObj(Tcl_Interp *interp, const char *childCmd,
Tcl_Interp **targetInterpPtr, const char **targetCmdPtr,
int *objcPtr, Tcl_Obj ***objv) {
Tcl_Size n = TCL_INDEX_NONE;
int result = Tcl_GetAliasObj(interp, childCmd, targetInterpPtr, targetCmdPtr, &n, objv);
if (objcPtr) {
| | | 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 |
}
int TclGetAliasObj(Tcl_Interp *interp, const char *childCmd,
Tcl_Interp **targetInterpPtr, const char **targetCmdPtr,
int *objcPtr, Tcl_Obj ***objv) {
Tcl_Size n = TCL_INDEX_NONE;
int result = Tcl_GetAliasObj(interp, childCmd, targetInterpPtr, targetCmdPtr, &n, objv);
if (objcPtr) {
if ((sizeof(int) != sizeof(size_t)) && (result == TCL_OK) && (n > INT_MAX)) {
if (interp) {
Tcl_AppendResult(interp, "List too large to be processed", (char *)NULL);
}
return TCL_ERROR;
}
*objcPtr = (int)n;
}
|
| ︙ | ︙ |
Changes to generic/tclTest.c.
| ︙ | ︙ | |||
175 176 177 178 179 180 181 | static int AsyncHandlerProc(void *clientData, Tcl_Interp *interp, int code); static Tcl_ThreadCreateType AsyncThreadProc(void *); static void CleanupTestSetassocdataTests( void *clientData, Tcl_Interp *interp); static void CmdDelProc1(void *clientData); static void CmdDelProc2(void *clientData); | | | | | | | | | | | | | | | | | | | | | | | | | | < | | | | | | | | | > | | | | | | | | | | | | | | | | | | | | | | | | | | < | | | | | | | | | | | | | | | | | | | | | | 175 176 177 178 179 180 181 182 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 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 | static int AsyncHandlerProc(void *clientData, Tcl_Interp *interp, int code); static Tcl_ThreadCreateType AsyncThreadProc(void *); static void CleanupTestSetassocdataTests( void *clientData, Tcl_Interp *interp); static void CmdDelProc1(void *clientData); static void CmdDelProc2(void *clientData); static Tcl_ObjCmdProc2 CmdProc1; static Tcl_CmdProc CmdProc2; static Tcl_CmdObjTraceProc2 CmdTraceDeleteProc; static Tcl_CmdObjTraceProc2 CmdTraceProc; static Tcl_ObjCmdProc2 CreatedCommandProc; static Tcl_ObjCmdProc2 CreatedCommandProc2; static void DelCallbackProc(void *clientData, Tcl_Interp *interp); static Tcl_ObjCmdProc2 DelCmdProc; static void DelDeleteProc(void *clientData); static void EncodingFreeProc(void *clientData); static int EncodingToUtfProc(void *clientData, const char *src, int srcLen, int flags, Tcl_EncodingState *statePtr, char *dst, int dstLen, int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr); static int EncodingFromUtfProc(void *clientData, const char *src, int srcLen, int flags, Tcl_EncodingState *statePtr, char *dst, int dstLen, int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr); static void ExitProcEven(void *clientData); static void ExitProcOdd(void *clientData); static Tcl_ObjCmdProc2 GetTimesCmd; static Tcl_ResolveCompiledVarProc InterpCompiledVarResolver; static void MainLoop(void); static Tcl_ObjCmdProc2 NoopCmd; static Tcl_ObjCmdProc2 NoopObjCmd; static Tcl_CmdObjTraceProc2 TraceProc; static void ObjTraceDeleteProc(void *clientData); static void PrintParse(Tcl_Interp *interp, Tcl_Parse *parsePtr); static Tcl_FreeProc SpecialFree; static int StaticInitProc(Tcl_Interp *interp); static Tcl_ObjCmdProc2 TestasyncCmd; static Tcl_ObjCmdProc2 TestbumpinterpepochCmd; static Tcl_ObjCmdProc2 TestbytestringCmd; static Tcl_ObjCmdProc2 TestsetbytearraylengthCmd; static Tcl_ObjCmdProc2 TestpurebytesobjCmd; static Tcl_ObjCmdProc2 TeststringbytesCmd; static Tcl_ObjCmdProc2 TestcmdinfoCmd; static Tcl_ObjCmdProc2 TestcmdtokenCmd; static Tcl_ObjCmdProc2 TestcmdtraceCmd; static Tcl_ObjCmdProc2 TestconcatobjCmd; static Tcl_ObjCmdProc2 TestcreatecommandCmd; static Tcl_ObjCmdProc2 TestdcallCmd; static Tcl_ObjCmdProc2 TestdelCmd; static Tcl_ObjCmdProc2 TestdelassocdataCmd; static Tcl_ObjCmdProc2 TestdoubledigitsCmd; static Tcl_ObjCmdProc2 TestdstringCmd; static Tcl_ObjCmdProc2 TestencodingCmd; static Tcl_ObjCmdProc2 TestevalexCmd; static Tcl_ObjCmdProc2 TestevalobjvCmd; static Tcl_ObjCmdProc2 TesteventCmd; static int TesteventProc(Tcl_Event *event, int flags); static int TesteventDeleteProc(Tcl_Event *event, void *clientData); static Tcl_ObjCmdProc2 TestexithandlerCmd; static Tcl_ObjCmdProc2 TestexprlongCmd; static Tcl_ObjCmdProc2 TestexprlongobjCmd; static Tcl_ObjCmdProc2 TestexprdoubleCmd; static Tcl_ObjCmdProc2 TestexprdoubleobjCmd; static Tcl_ObjCmdProc2 TestexprparserCmd; static Tcl_ObjCmdProc2 TestexprstringCmd; static Tcl_ObjCmdProc2 TestfileCmd; static Tcl_ObjCmdProc2 TestfilelinkCmd; static Tcl_ObjCmdProc2 TestfeventCmd; static Tcl_ObjCmdProc2 TestgetassocdataCmd; static Tcl_ObjCmdProc2 TestgetintCmd; static Tcl_ObjCmdProc2 TestlongsizeCmd; static Tcl_ObjCmdProc2 TestgetplatformCmd; static Tcl_ObjCmdProc2 TestgetvarfullnameCmd; static Tcl_ObjCmdProc2 TestinterpdeleteCmd; static Tcl_ObjCmdProc2 TestlinkCmd; static Tcl_ObjCmdProc2 TestlinkarrayCmd; static Tcl_ObjCmdProc2 TestlistapiCmd; static Tcl_ObjCmdProc2 TestlistrepCmd; static Tcl_ObjCmdProc2 TestlocaleCmd; static Tcl_ObjCmdProc2 TestmainthreadCmd; static Tcl_ObjCmdProc2 TestmsbObjCmd; static Tcl_ObjCmdProc2 TestsetmainloopCmd; static Tcl_ObjCmdProc2 TestexitmainloopCmd; static Tcl_ObjCmdProc2 TestpanicCmd; static Tcl_ObjCmdProc2 TestparseargsCmd; static Tcl_ObjCmdProc2 TestparserCmd; static Tcl_ObjCmdProc2 TestparsevarCmd; static Tcl_ObjCmdProc2 TestparsevarnameCmd; static Tcl_ObjCmdProc2 TestpreferstableCmd; static Tcl_ObjCmdProc2 TestprintCmd; static Tcl_ObjCmdProc2 TestregexpCmd; static Tcl_ObjCmdProc2 TestreturnCmd; static void TestregexpXflags(const char *string, size_t length, int *cflagsPtr, int *eflagsPtr); static Tcl_ObjCmdProc2 TestsetassocdataCmd; static Tcl_ObjCmdProc2 TestsetCmd; static Tcl_ObjCmdProc2 Testset2Cmd; static Tcl_ObjCmdProc2 TestseterrorcodeCmd; static Tcl_ObjCmdProc2 TestsetobjerrorcodeCmd; static Tcl_ObjCmdProc2 TestsetplatformCmd; static Tcl_ObjCmdProc2 TestSizeCmd; static Tcl_ObjCmdProc2 TeststaticlibraryCmd; static Tcl_ObjCmdProc2 TesttranslatefilenameCmd; static Tcl_ObjCmdProc2 TestfstildeexpandCmd; static Tcl_ObjCmdProc2 TestuniClassCmd; static Tcl_ObjCmdProc2 TestupvarCmd; static Tcl_ObjCmdProc2 TestWrongNumArgsCmd; static Tcl_ObjCmdProc2 TestGetIndexFromObjStructCmd; static Tcl_ObjCmdProc2 TestChannelCmd; static Tcl_ObjCmdProc2 TestChannelEventCmd; static Tcl_ObjCmdProc2 TestSocketCmd; static Tcl_ObjCmdProc2 TestFilesystemCmd; static Tcl_ObjCmdProc2 TestSimpleFilesystemCmd; static void TestReport(const char *cmd, Tcl_Obj *arg1, Tcl_Obj *arg2); static Tcl_Obj * TestReportGetNativePath(Tcl_Obj *pathPtr); static Tcl_FSStatProc TestReportStat; static Tcl_FSAccessProc TestReportAccess; static Tcl_FSOpenFileChannelProc TestReportOpenFileChannel; static Tcl_FSMatchInDirectoryProc TestReportMatchInDirectory; |
| ︙ | ︙ | |||
314 315 316 317 318 319 320 | static Tcl_FSFileAttrsGetProc TestReportFileAttrsGet; static Tcl_FSFileAttrsSetProc TestReportFileAttrsSet; static Tcl_FSUtimeProc TestReportUtime; static Tcl_FSNormalizePathProc TestReportNormalizePath; static Tcl_FSPathInFilesystemProc TestReportInFilesystem; static Tcl_FSFreeInternalRepProc TestReportFreeInternalRep; static Tcl_FSDupInternalRepProc TestReportDupInternalRep; | | | | | | | | | | | | | | | | | | | | | 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 |
static Tcl_FSFileAttrsGetProc TestReportFileAttrsGet;
static Tcl_FSFileAttrsSetProc TestReportFileAttrsSet;
static Tcl_FSUtimeProc TestReportUtime;
static Tcl_FSNormalizePathProc TestReportNormalizePath;
static Tcl_FSPathInFilesystemProc TestReportInFilesystem;
static Tcl_FSFreeInternalRepProc TestReportFreeInternalRep;
static Tcl_FSDupInternalRepProc TestReportDupInternalRep;
static Tcl_ObjCmdProc2 TestServiceModeCmd;
static Tcl_FSStatProc SimpleStat;
static Tcl_FSAccessProc SimpleAccess;
static Tcl_FSOpenFileChannelProc SimpleOpenFileChannel;
static Tcl_FSListVolumesProc SimpleListVolumes;
static Tcl_FSPathInFilesystemProc SimplePathInFilesystem;
static Tcl_Obj * SimpleRedirect(Tcl_Obj *pathPtr);
static Tcl_FSMatchInDirectoryProc SimpleMatchInDirectory;
static Tcl_ObjCmdProc2 TestUtfNextCmd;
static Tcl_ObjCmdProc2 TestUtfPrevCmd;
static Tcl_ObjCmdProc2 TestUtfToNormalizedDStringCmd;
static Tcl_ObjCmdProc2 TestUtfToNormalizedCmd;
static Tcl_ObjCmdProc2 TestNumUtfCharsCmd;
static Tcl_ObjCmdProc2 TestGetUniCharCmd;
static Tcl_ObjCmdProc2 TestFindFirstCmd;
static Tcl_ObjCmdProc2 TestFindLastCmd;
static Tcl_ObjCmdProc2 TestHashSystemHashCmd;
static Tcl_ObjCmdProc2 TestGetIntForIndexCmd;
static Tcl_ObjCmdProc2 TestLutilCmd;
static Tcl_NRPostProc NREUnwind_callback;
static Tcl_ObjCmdProc2 TestNREUnwind;
static Tcl_ObjCmdProc2 TestNRELevels;
static Tcl_ObjCmdProc2 TestInterpResolverCmd;
#if defined(HAVE_CPUID) && !defined(MAC_OSX_TCL)
static Tcl_ObjCmdProc2 TestcpuidCmd;
#endif
static Tcl_ObjCmdProc2 TestApplyLambdaCmd;
#ifdef _WIN32
static Tcl_ObjCmdProc2 TestHandleCountCmd;
static Tcl_ObjCmdProc2 TestAppVerifierPresentCmd;
#endif
static const Tcl_Filesystem testReportingFilesystem = {
"reporting",
sizeof(Tcl_Filesystem),
TCL_FILESYSTEM_VERSION_1,
TestReportInFilesystem, /* path in */
|
| ︙ | ︙ | |||
536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 |
if (Tcl_InitStubs(interp, "9.0-", 0) == NULL) {
return TCL_ERROR;
}
if (Tcl_GetCommandInfo(interp, "::tcl::build-info", &info)) {
if (info.isNativeObjectProc == 2) {
Tcl_CreateObjCommand2(interp, "::tcl::test::build-info",
info.objProc2, (void *)version, NULL);
} else {
Tcl_CreateObjCommand(interp, "::tcl::test::build-info",
info.objProc, (void *)version, NULL);
}
}
if (Tcl_PkgProvideEx(interp, "tcl::test", TCL_PATCH_LEVEL, NULL) == TCL_ERROR) {
return TCL_ERROR;
}
return TCL_OK;
}
| > > | 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 |
if (Tcl_InitStubs(interp, "9.0-", 0) == NULL) {
return TCL_ERROR;
}
if (Tcl_GetCommandInfo(interp, "::tcl::build-info", &info)) {
if (info.isNativeObjectProc == 2) {
Tcl_CreateObjCommand2(interp, "::tcl::test::build-info",
info.objProc2, (void *)version, NULL);
#ifndef TCL_NO_DEPRECATED
} else {
Tcl_CreateObjCommand(interp, "::tcl::test::build-info",
info.objProc, (void *)version, NULL);
#endif /* TCL_NO_DEPRECATED */
}
}
if (Tcl_PkgProvideEx(interp, "tcl::test", TCL_PATCH_LEVEL, NULL) == TCL_ERROR) {
return TCL_ERROR;
}
return TCL_OK;
}
|
| ︙ | ︙ | |||
569 570 571 572 573 574 575 |
if (Tcl_OOInitStubs(interp) == NULL) {
return TCL_ERROR;
}
/*
* Create additional commands and math functions for testing Tcl.
*/
| | | | | | | | | | | | | | | | | < < | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 |
if (Tcl_OOInitStubs(interp) == NULL) {
return TCL_ERROR;
}
/*
* Create additional commands and math functions for testing Tcl.
*/
Tcl_CreateObjCommand2(interp, "gettimes", GetTimesCmd, NULL, NULL);
Tcl_CreateObjCommand2(interp, "noop", NoopCmd, NULL, NULL);
Tcl_CreateObjCommand2(interp, "noop", NoopObjCmd, NULL, NULL);
Tcl_CreateObjCommand2(interp, "testpurebytesobj", TestpurebytesobjCmd, NULL, NULL);
Tcl_CreateObjCommand2(interp, "testsetbytearraylength", TestsetbytearraylengthCmd, NULL, NULL);
Tcl_CreateObjCommand2(interp, "testbytestring", TestbytestringCmd, NULL, NULL);
Tcl_CreateObjCommand2(interp, "teststringbytes", TeststringbytesCmd, NULL, NULL);
Tcl_CreateObjCommand2(interp, "testwrongnumargs", TestWrongNumArgsCmd,
NULL, NULL);
Tcl_CreateObjCommand2(interp, "testfilesystem", TestFilesystemCmd,
NULL, NULL);
Tcl_CreateObjCommand2(interp, "testsimplefilesystem", TestSimpleFilesystemCmd,
NULL, NULL);
Tcl_CreateObjCommand2(interp, "testgetindexfromobjstruct",
TestGetIndexFromObjStructCmd, NULL, NULL);
Tcl_CreateObjCommand2(interp, "testasync", TestasyncCmd, NULL, NULL);
Tcl_CreateObjCommand2(interp, "testbumpinterpepoch",
TestbumpinterpepochCmd, NULL, NULL);
Tcl_CreateObjCommand2(interp, "testchannel", TestChannelCmd,
NULL, NULL);
Tcl_CreateObjCommand2(interp, "testchannelevent", TestChannelEventCmd,
NULL, NULL);
Tcl_CreateObjCommand2(interp, "testcmdtoken", TestcmdtokenCmd, NULL,
NULL);
Tcl_CreateObjCommand2(interp, "testcmdinfo", TestcmdinfoCmd, NULL,
NULL);
Tcl_CreateObjCommand2(interp, "testcmdtrace", TestcmdtraceCmd,
NULL, NULL);
Tcl_CreateObjCommand2(interp, "testconcatobj", TestconcatobjCmd,
NULL, NULL);
Tcl_CreateObjCommand2(interp, "testcreatecommand", TestcreatecommandCmd,
NULL, NULL);
Tcl_CreateObjCommand2(interp, "testdcall", TestdcallCmd, NULL, NULL);
Tcl_CreateObjCommand2(interp, "testdel", TestdelCmd, NULL, NULL);
Tcl_CreateObjCommand2(interp, "testdelassocdata", TestdelassocdataCmd,
NULL, NULL);
Tcl_CreateObjCommand2(interp, "testdoubledigits", TestdoubledigitsCmd,
NULL, NULL);
Tcl_DStringInit(&dstring);
Tcl_CreateObjCommand2(interp, "testdstring", TestdstringCmd, NULL,
NULL);
Tcl_CreateObjCommand2(interp, "testencoding", TestencodingCmd, NULL,
NULL);
Tcl_CreateObjCommand2(interp, "testevalex", TestevalexCmd,
NULL, NULL);
Tcl_CreateObjCommand2(interp, "testevalobjv", TestevalobjvCmd,
NULL, NULL);
Tcl_CreateObjCommand2(interp, "testevent", TesteventCmd,
NULL, NULL);
Tcl_CreateObjCommand2(interp, "testexithandler", TestexithandlerCmd,
NULL, NULL);
Tcl_CreateObjCommand2(interp, "testexprlong", TestexprlongCmd,
NULL, NULL);
Tcl_CreateObjCommand2(interp, "testexprlongobj", TestexprlongobjCmd,
NULL, NULL);
Tcl_CreateObjCommand2(interp, "testexprdouble", TestexprdoubleCmd,
NULL, NULL);
Tcl_CreateObjCommand2(interp, "testexprdoubleobj", TestexprdoubleobjCmd,
NULL, NULL);
Tcl_CreateObjCommand2(interp, "testexprparser", TestexprparserCmd,
NULL, NULL);
Tcl_CreateObjCommand2(interp, "testexprstring", TestexprstringCmd,
NULL, NULL);
Tcl_CreateObjCommand2(interp, "testfevent", TestfeventCmd, NULL,
NULL);
Tcl_CreateObjCommand2(interp, "testfilelink", TestfilelinkCmd,
NULL, NULL);
Tcl_CreateObjCommand2(interp, "testfile", TestfileCmd,
NULL, NULL);
Tcl_CreateObjCommand2(interp, "testhashsystemhash",
TestHashSystemHashCmd, NULL, NULL);
Tcl_CreateObjCommand2(interp, "testgetassocdata", TestgetassocdataCmd,
NULL, NULL);
Tcl_CreateObjCommand2(interp, "testgetint", TestgetintCmd,
NULL, NULL);
Tcl_CreateObjCommand2(interp, "testlongsize", TestlongsizeCmd,
NULL, NULL);
Tcl_CreateObjCommand2(interp, "testgetplatform", TestgetplatformCmd,
NULL, NULL);
Tcl_CreateObjCommand2(interp, "testgetvarfullname",
TestgetvarfullnameCmd, NULL, NULL);
Tcl_CreateObjCommand2(interp, "testinterpdelete", TestinterpdeleteCmd,
NULL, NULL);
Tcl_CreateObjCommand2(interp, "testlink", TestlinkCmd, NULL, NULL);
Tcl_CreateObjCommand2(interp, "testlinkarray", TestlinkarrayCmd, NULL, NULL);
Tcl_CreateObjCommand2(interp, "testlistapi", TestlistapiCmd, NULL, NULL);
Tcl_CreateObjCommand2(interp, "testlistrep", TestlistrepCmd, NULL, NULL);
Tcl_CreateObjCommand2(interp, "testlocale", TestlocaleCmd, NULL,
NULL);
Tcl_CreateObjCommand2(interp, "testmsb", TestmsbObjCmd, NULL, NULL);
Tcl_CreateObjCommand2(interp, "testpanic", TestpanicCmd, NULL, NULL);
Tcl_CreateObjCommand2(interp, "testparseargs", TestparseargsCmd,NULL,NULL);
Tcl_CreateObjCommand2(interp, "testparser", TestparserCmd,
NULL, NULL);
Tcl_CreateObjCommand2(interp, "testparsevar", TestparsevarCmd,
NULL, NULL);
Tcl_CreateObjCommand2(interp, "testparsevarname", TestparsevarnameCmd,
NULL, NULL);
Tcl_CreateObjCommand2(interp, "testpreferstable", TestpreferstableCmd,
NULL, NULL);
Tcl_CreateObjCommand2(interp, "testprint", TestprintCmd,
NULL, NULL);
Tcl_CreateObjCommand2(interp, "testregexp", TestregexpCmd,
NULL, NULL);
Tcl_CreateObjCommand2(interp, "testreturn", TestreturnCmd,
NULL, NULL);
Tcl_CreateObjCommand2(interp, "testservicemode", TestServiceModeCmd,
NULL, NULL);
Tcl_CreateObjCommand2(interp, "testsetassocdata", TestsetassocdataCmd,
NULL, NULL);
Tcl_CreateObjCommand2(interp, "testsetnoerr", TestsetCmd,
NULL, NULL);
Tcl_CreateObjCommand2(interp, "testseterr", TestsetCmd,
INT2PTR(TCL_LEAVE_ERR_MSG), NULL);
Tcl_CreateObjCommand2(interp, "testset2", Testset2Cmd,
INT2PTR(TCL_LEAVE_ERR_MSG), NULL);
Tcl_CreateObjCommand2(interp, "testseterrorcode", TestseterrorcodeCmd,
NULL, NULL);
Tcl_CreateObjCommand2(interp, "testsetobjerrorcode",
TestsetobjerrorcodeCmd, NULL, NULL);
Tcl_CreateObjCommand2(interp, "testutfnext",
TestUtfNextCmd, NULL, NULL);
Tcl_CreateObjCommand2(interp, "testutfprev",
TestUtfPrevCmd, NULL, NULL);
Tcl_CreateObjCommand2(interp, "testnumutfchars",
TestNumUtfCharsCmd, NULL, NULL);
Tcl_CreateObjCommand2(interp, "testgetunichar",
TestGetUniCharCmd, NULL, NULL);
Tcl_CreateObjCommand2(interp, "testfindfirst",
TestFindFirstCmd, NULL, NULL);
Tcl_CreateObjCommand2(interp, "testfindlast",
TestFindLastCmd, NULL, NULL);
Tcl_CreateObjCommand2(interp, "testgetintforindex",
TestGetIntForIndexCmd, NULL, NULL);
Tcl_CreateObjCommand2(interp, "testsetplatform", TestsetplatformCmd,
NULL, NULL);
Tcl_CreateObjCommand2(interp, "testsize", TestSizeCmd, NULL, NULL);
Tcl_CreateObjCommand2(interp, "testsocket", TestSocketCmd,
NULL, NULL);
Tcl_CreateObjCommand2(interp, "teststaticlibrary", TeststaticlibraryCmd,
NULL, NULL);
Tcl_CreateObjCommand2(interp, "testtranslatefilename",
TesttranslatefilenameCmd, NULL, NULL);
Tcl_CreateObjCommand2(interp, "testfstildeexpand",
TestfstildeexpandCmd, NULL, NULL);
Tcl_CreateObjCommand2(interp, "testupvar", TestupvarCmd, NULL, NULL);
Tcl_CreateObjCommand2(interp, "testuniclass", TestuniClassCmd, NULL, NULL);
Tcl_CreateObjCommand2(interp, "testmainthread", TestmainthreadCmd, NULL,
NULL);
Tcl_CreateObjCommand2(interp, "testsetmainloop", TestsetmainloopCmd,
NULL, NULL);
Tcl_CreateObjCommand2(interp, "testexitmainloop", TestexitmainloopCmd,
NULL, NULL);
#if defined(HAVE_CPUID) && !defined(MAC_OSX_TCL)
Tcl_CreateObjCommand2(interp, "testcpuid", TestcpuidCmd,
NULL, NULL);
#endif
Tcl_CreateObjCommand2(interp, "testnreunwind", TestNREUnwind,
NULL, NULL);
Tcl_CreateObjCommand2(interp, "testnrelevels", TestNRELevels,
NULL, NULL);
Tcl_CreateObjCommand2(interp, "testinterpresolver", TestInterpResolverCmd,
NULL, NULL);
Tcl_CreateObjCommand2(interp, "testapplylambda", TestApplyLambdaCmd,
NULL, NULL);
Tcl_CreateObjCommand2(interp, "testlutil", TestLutilCmd,
NULL, NULL);
Tcl_CreateObjCommand2(interp, "testutftonormalized",
TestUtfToNormalizedCmd, NULL, NULL);
Tcl_CreateObjCommand2(interp, "testutftonormalizeddstring",
TestUtfToNormalizedDStringCmd, NULL, NULL);
#if defined(_WIN32)
Tcl_CreateObjCommand2(interp, "testhandlecount", TestHandleCountCmd,
NULL, NULL);
Tcl_CreateObjCommand2(interp, "testappverifierpresent",
TestAppVerifierPresentCmd, NULL, NULL);
#endif
if (TclObjTest_Init(interp) != TCL_OK) {
return TCL_ERROR;
}
if (Procbodytest_Init(interp) != TCL_OK) {
|
| ︙ | ︙ | |||
858 859 860 861 862 863 864 |
*----------------------------------------------------------------------
*/
static int
TestasyncCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 857 858 859 860 861 862 863 864 865 866 867 868 869 870 871 |
*----------------------------------------------------------------------
*/
static int
TestasyncCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const *objv) /* Arguments. */
{
TestAsyncHandler *asyncPtr, *prevPtr;
int id, code;
static int nextId = 1;
if (objc < 2) {
|
| ︙ | ︙ | |||
1059 1060 1061 1062 1063 1064 1065 |
TCL_THREAD_CREATE_RETURN;
}
static int
TestbumpinterpepochCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080 1081 1082 1083 1084 |
TCL_THREAD_CREATE_RETURN;
}
static int
TestbumpinterpepochCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Interp *iPtr = (Interp *)interp;
if (objc != 1) {
Tcl_WrongNumArgs(interp, 1, objv, "");
return TCL_ERROR;
}
iPtr->compileEpoch++;
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
* TestcmdinfoCmd --
*
* This procedure implements the "testcmdinfo" command. It is used to
* test Tcl_GetCommandInfo, Tcl_SetCommandInfo, and command creation and
|
| ︙ | ︙ | |||
1128 1129 1130 1131 1132 1133 1134 |
*----------------------------------------------------------------------
*/
static int
TestcmdinfoCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | | < < < < < < < < < < < < < < < < < < < < < < < < < | | | | 1093 1094 1095 1096 1097 1098 1099 1100 1101 1102 1103 1104 1105 1106 1107 1108 1109 1110 1111 1112 1113 1114 1115 1116 1117 1118 1119 1120 1121 1122 1123 1124 1125 1126 1127 1128 1129 1130 1131 1132 1133 1134 1135 1136 1137 1138 1139 1140 1141 1142 1143 1144 |
*----------------------------------------------------------------------
*/
static int
TestcmdinfoCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
static const char *const subcmds[] = {
"create", "delete", "get", "modify", NULL
};
enum options {
CMDINFO_CREATE,
CMDINFO_DELETE, CMDINFO_GET, CMDINFO_MODIFY
} idx;
Tcl_CmdInfo info;
if (objc != 3) {
Tcl_WrongNumArgs(interp, 1, objv, "command arg");
return TCL_ERROR;
}
if (Tcl_GetIndexFromObj(interp, objv[1], subcmds, "option", 0,
&idx) != TCL_OK) {
return TCL_ERROR;
}
switch (idx) {
case CMDINFO_CREATE:
Tcl_CreateObjCommand2(interp, Tcl_GetString(objv[2]), CmdProc1,
(void *)"original", CmdDelProc1);
break;
case CMDINFO_DELETE:
Tcl_DStringInit(&delString);
Tcl_DeleteCommand(interp, Tcl_GetString(objv[2]));
Tcl_DStringResult(interp, &delString);
break;
case CMDINFO_GET:
if (Tcl_GetCommandInfo(interp, Tcl_GetString(objv[2]), &info) ==0) {
Tcl_AppendResult(interp, "??", (char *)NULL);
return TCL_OK;
}
if (info.objProc2 == CmdProc1) {
Tcl_AppendResult(interp, "CmdProc1", " ",
(char *)info.objClientData2, (char *)NULL);
} else if (info.proc == CmdProc2) {
Tcl_AppendResult(interp, "CmdProc2", " ",
(char *)info.clientData, (char *)NULL);
} else {
Tcl_AppendResult(interp, "unknown", (char *)NULL);
}
if (info.deleteProc == CmdDelProc1) {
|
| ︙ | ︙ | |||
1222 1223 1224 1225 1226 1227 1228 1229 1230 1231 1232 1233 1234 1235 1236 1237 1238 1239 1240 1241 1242 1243 1244 1245 1246 1247 1248 1249 1250 |
info.isNativeObjectProc));
return TCL_ERROR;
}
break;
case CMDINFO_MODIFY:
info.proc = CmdProc2;
info.clientData = (void *) "new_command_data";
info.objProc = NULL;
info.objClientData = NULL;
info.deleteProc = CmdDelProc2;
info.deleteData = (void *) "new_delete_data";
info.namespacePtr = NULL;
info.objProc2 = NULL;
info.objClientData2 = NULL;
if (Tcl_SetCommandInfo(interp, Tcl_GetString(objv[2]), &info) == 0) {
Tcl_SetObjResult(interp, Tcl_NewWideIntObj(0));
} else {
Tcl_SetObjResult(interp, Tcl_NewWideIntObj(1));
}
break;
}
return TCL_OK;
}
static int
CmdProc0(
void *clientData, /* String to return. */
Tcl_Interp *interp, /* Current interpreter. */
| > > | | | | 1162 1163 1164 1165 1166 1167 1168 1169 1170 1171 1172 1173 1174 1175 1176 1177 1178 1179 1180 1181 1182 1183 1184 1185 1186 1187 1188 1189 1190 1191 1192 1193 1194 1195 1196 1197 1198 1199 1200 1201 1202 1203 1204 1205 1206 1207 1208 1209 1210 1211 1212 1213 |
info.isNativeObjectProc));
return TCL_ERROR;
}
break;
case CMDINFO_MODIFY:
info.proc = CmdProc2;
info.clientData = (void *) "new_command_data";
#ifndef TCL_NO_DEPRECATED
info.objProc = NULL;
info.objClientData = NULL;
#endif
info.deleteProc = CmdDelProc2;
info.deleteData = (void *) "new_delete_data";
info.namespacePtr = NULL;
info.objProc2 = NULL;
info.objClientData2 = NULL;
if (Tcl_SetCommandInfo(interp, Tcl_GetString(objv[2]), &info) == 0) {
Tcl_SetObjResult(interp, Tcl_NewWideIntObj(0));
} else {
Tcl_SetObjResult(interp, Tcl_NewWideIntObj(1));
}
break;
}
return TCL_OK;
}
static int
CmdProc0(
void *clientData, /* String to return. */
Tcl_Interp *interp, /* Current interpreter. */
TCL_UNUSED(Tcl_Size) /*objc*/,
TCL_UNUSED(Tcl_Obj *const *) /*objv*/)
{
TestCommandTokenRef *refPtr = (TestCommandTokenRef *) clientData;
Tcl_AppendResult(interp, "CmdProc1 ", refPtr->value, (char *)NULL);
return TCL_OK;
}
static int
CmdProc1(
void *clientData, /* String to return. */
Tcl_Interp *interp, /* Current interpreter. */
TCL_UNUSED(Tcl_Size) /*argc*/,
TCL_UNUSED(Tcl_Obj *const *) /*argv*/)
{
Tcl_AppendResult(interp, "CmdProc1 ", (char *)clientData, (char *)NULL);
return TCL_OK;
}
static int
CmdProc2(
|
| ︙ | ︙ | |||
1335 1336 1337 1338 1339 1340 1341 |
*----------------------------------------------------------------------
*/
static int
TestcmdtokenCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | | 1277 1278 1279 1280 1281 1282 1283 1284 1285 1286 1287 1288 1289 1290 1291 1292 1293 1294 1295 1296 1297 1298 1299 1300 1301 1302 1303 1304 |
*----------------------------------------------------------------------
*/
static int
TestcmdtokenCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const *objv) /* Arguments. */
{
TestCommandTokenRef *refPtr;
int id;
char buf[30];
if (objc != 3) {
Tcl_WrongNumArgs(interp, 1, objv, "option arg");
return TCL_ERROR;
}
if (strcmp(Tcl_GetString(objv[1]), "create") == 0) {
refPtr = (TestCommandTokenRef *)Tcl_Alloc(sizeof(TestCommandTokenRef));
refPtr->token = Tcl_CreateObjCommand2(interp, Tcl_GetString(objv[2]), CmdProc0,
refPtr, CmdDelProc0);
refPtr->id = nextCommandTokenRefId;
refPtr->value = "original";
nextCommandTokenRefId++;
refPtr->nextPtr = firstCommandTokenRef;
firstCommandTokenRef = refPtr;
snprintf(buf, sizeof(buf), "%d", refPtr->id);
|
| ︙ | ︙ | |||
1419 1420 1421 1422 1423 1424 1425 |
*----------------------------------------------------------------------
*/
static int
TestcmdtraceCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | | | | | | | 1361 1362 1363 1364 1365 1366 1367 1368 1369 1370 1371 1372 1373 1374 1375 1376 1377 1378 1379 1380 1381 1382 1383 1384 1385 1386 1387 1388 1389 1390 1391 1392 1393 1394 1395 1396 1397 1398 1399 1400 1401 1402 1403 1404 1405 1406 1407 1408 1409 1410 1411 1412 1413 1414 1415 1416 1417 1418 1419 1420 1421 1422 1423 1424 1425 1426 1427 1428 1429 1430 1431 1432 1433 1434 1435 1436 1437 1438 1439 1440 1441 1442 |
*----------------------------------------------------------------------
*/
static int
TestcmdtraceCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const *objv) /* Argument strings. */
{
Tcl_DString buffer;
int result;
if (objc != 3) {
Tcl_WrongNumArgs(interp, 1, objv, "option script");
return TCL_ERROR;
}
if (strcmp(Tcl_GetString(objv[1]), "tracetest") == 0) {
Tcl_DStringInit(&buffer);
cmdTrace = Tcl_CreateObjTrace2(interp, 50000, 0, CmdTraceProc, &buffer, NULL);
result = Tcl_EvalEx(interp, Tcl_GetString(objv[2]), TCL_INDEX_NONE, 0);
if (result == TCL_OK) {
Tcl_ResetResult(interp);
Tcl_AppendResult(interp, Tcl_DStringValue(&buffer), (char *)NULL);
}
Tcl_DeleteTrace(interp, cmdTrace);
Tcl_DStringFree(&buffer);
} else if (strcmp(Tcl_GetString(objv[1]), "deletetest") == 0) {
/*
* Create a command trace then eval a script to check whether it is
* called. Note that this trace procedure removes itself as a further
* check of the robustness of the trace proc calling code in
* TclNRExecuteByteCode.
*/
cmdTrace = Tcl_CreateObjTrace2(interp, 50000, 0, CmdTraceDeleteProc, NULL, NULL);
Tcl_EvalEx(interp, Tcl_GetString(objv[2]), TCL_INDEX_NONE, 0);
} else if (strcmp(Tcl_GetString(objv[1]), "leveltest") == 0) {
Interp *iPtr = (Interp *) interp;
Tcl_DStringInit(&buffer);
cmdTrace = Tcl_CreateObjTrace2(interp, iPtr->numLevels + 4, 0, CmdTraceProc,
&buffer, NULL);
result = Tcl_EvalEx(interp, Tcl_GetString(objv[2]), TCL_INDEX_NONE, 0);
if (result == TCL_OK) {
Tcl_ResetResult(interp);
Tcl_AppendResult(interp, Tcl_DStringValue(&buffer), (char *)NULL);
}
Tcl_DeleteTrace(interp, cmdTrace);
Tcl_DStringFree(&buffer);
} else if (strcmp(Tcl_GetString(objv[1]), "resulttest") == 0) {
/* 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, TraceProc,
&deleteCalled, ObjTraceDeleteProc);
result = Tcl_EvalEx(interp, Tcl_GetString(objv[2]), TCL_INDEX_NONE, 0);
Tcl_DeleteTrace(interp, cmdTrace);
if (!deleteCalled) {
Tcl_AppendResult(interp, "Delete wasn't called", (char *)NULL);
return TCL_ERROR;
} else {
return result;
}
} else if (strcmp(Tcl_GetString(objv[1]), "doubletest") == 0) {
Tcl_Trace t1, t2;
Tcl_DStringInit(&buffer);
t1 = Tcl_CreateObjTrace2(interp, 1, 0, CmdTraceProc, &buffer, NULL);
t2 = Tcl_CreateObjTrace2(interp, 50000, 0, CmdTraceProc, &buffer, NULL);
result = Tcl_EvalEx(interp, Tcl_GetString(objv[2]), TCL_INDEX_NONE, 0);
if (result == TCL_OK) {
Tcl_ResetResult(interp);
Tcl_AppendResult(interp, Tcl_DStringValue(&buffer), (char *)NULL);
}
Tcl_DeleteTrace(interp, t2);
Tcl_DeleteTrace(interp, t1);
|
| ︙ | ︙ | |||
1509 1510 1511 1512 1513 1514 1515 |
static int
CmdTraceProc(
void *clientData, /* Pointer to buffer in which the
* command and arguments are appended.
* Accumulates test result. */
TCL_UNUSED(Tcl_Interp *),
| | | | | | | | | 1451 1452 1453 1454 1455 1456 1457 1458 1459 1460 1461 1462 1463 1464 1465 1466 1467 1468 1469 1470 1471 1472 1473 1474 1475 1476 1477 1478 1479 1480 1481 1482 1483 1484 1485 1486 1487 1488 1489 1490 1491 1492 1493 1494 1495 1496 1497 1498 1499 1500 1501 1502 1503 1504 1505 1506 1507 1508 1509 1510 1511 1512 |
static int
CmdTraceProc(
void *clientData, /* Pointer to buffer in which the
* command and arguments are appended.
* Accumulates test result. */
TCL_UNUSED(Tcl_Interp *),
TCL_UNUSED(Tcl_Size) /*level*/,
const char *command, /* The command being traced (after
* substitutions). */
TCL_UNUSED(Tcl_Command) /*cmdProc*/,
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const *objv) /* Arguments. */
{
Tcl_DString *bufPtr = (Tcl_DString *) clientData;
Tcl_Size i;
Tcl_DStringAppendElement(bufPtr, command);
Tcl_DStringStartSublist(bufPtr);
for (i = 0; i < objc; i++) {
Tcl_DStringAppendElement(bufPtr, Tcl_GetString(objv[i]));
}
Tcl_DStringEndSublist(bufPtr);
return TCL_OK;
}
static int
CmdTraceDeleteProc(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
TCL_UNUSED(Tcl_Size) /*level*/,
TCL_UNUSED(const char *) /*command*/,
TCL_UNUSED(Tcl_Command),
TCL_UNUSED(Tcl_Size) /*objc*/,
TCL_UNUSED(Tcl_Obj *const *) /*objv*/)
{
/*
* Remove ourselves to test whether calling Tcl_DeleteTrace within a trace
* callback causes the for loop in TclNRExecuteByteCode that calls traces to
* reference freed memory.
*/
Tcl_DeleteTrace(interp, cmdTrace);
return TCL_OK;
}
static int
TraceProc(
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;
|
| ︙ | ︙ | |||
1610 1611 1612 1613 1614 1615 1616 |
*----------------------------------------------------------------------
*/
static int
TestcreatecommandCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | | | | 1552 1553 1554 1555 1556 1557 1558 1559 1560 1561 1562 1563 1564 1565 1566 1567 1568 1569 1570 1571 1572 1573 1574 1575 1576 1577 1578 1579 1580 1581 1582 1583 1584 1585 1586 1587 1588 1589 1590 1591 1592 1593 1594 1595 |
*----------------------------------------------------------------------
*/
static int
TestcreatecommandCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument strings. */
{
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "option");
return TCL_ERROR;
}
if (strcmp(Tcl_GetString(objv[1]), "create") == 0) {
Tcl_CreateObjCommand2(interp, "test_ns_basic::createdcommand",
CreatedCommandProc, NULL, NULL);
} else if (strcmp(Tcl_GetString(objv[1]), "delete") == 0) {
Tcl_DeleteCommand(interp, "test_ns_basic::createdcommand");
} else if (strcmp(Tcl_GetString(objv[1]), "create2") == 0) {
Tcl_CreateObjCommand2(interp, "value:at:",
CreatedCommandProc2, NULL, NULL);
} else if (strcmp(Tcl_GetString(objv[1]), "delete2") == 0) {
Tcl_DeleteCommand(interp, "value:at:");
} else {
Tcl_AppendResult(interp, "bad option \"", Tcl_GetString(objv[1]),
"\": must be create, delete, create2, or delete2", (char *)NULL);
return TCL_ERROR;
}
return TCL_OK;
}
static int
CreatedCommandProc(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
TCL_UNUSED(Tcl_Size) /*objc*/,
TCL_UNUSED(Tcl_Obj *const *) /*objv*/)
{
Tcl_CmdInfo info;
int found;
found = Tcl_GetCommandInfo(interp, "test_ns_basic::createdcommand",
&info);
|
| ︙ | ︙ | |||
1662 1663 1664 1665 1666 1667 1668 |
return TCL_OK;
}
static int
CreatedCommandProc2(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 1604 1605 1606 1607 1608 1609 1610 1611 1612 1613 1614 1615 1616 1617 1618 |
return TCL_OK;
}
static int
CreatedCommandProc2(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
TCL_UNUSED(Tcl_Size) /*objc*/,
TCL_UNUSED(Tcl_Obj *const *) /*objv*/)
{
Tcl_CmdInfo info;
int found;
found = Tcl_GetCommandInfo(interp, "value:at:", &info);
if (!found) {
|
| ︙ | ︙ | |||
1701 1702 1703 1704 1705 1706 1707 |
*----------------------------------------------------------------------
*/
static int
TestdcallCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | | 1643 1644 1645 1646 1647 1648 1649 1650 1651 1652 1653 1654 1655 1656 1657 1658 1659 1660 |
*----------------------------------------------------------------------
*/
static int
TestdcallCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const *objv) /* Arguments. */
{
Tcl_Size i;
int id;
delInterp = Tcl_CreateInterp();
Tcl_DStringInit(&delString);
for (i = 1; i < objc; i++) {
if (Tcl_GetIntFromObj(interp, objv[i], &id) != TCL_OK) {
return TCL_ERROR;
|
| ︙ | ︙ | |||
1766 1767 1768 1769 1770 1771 1772 |
*----------------------------------------------------------------------
*/
static int
TestdelCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | | | 1708 1709 1710 1711 1712 1713 1714 1715 1716 1717 1718 1719 1720 1721 1722 1723 1724 1725 1726 1727 1728 1729 1730 1731 1732 1733 1734 1735 1736 1737 1738 1739 1740 1741 1742 1743 1744 1745 1746 1747 1748 1749 1750 1751 1752 |
*----------------------------------------------------------------------
*/
static int
TestdelCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const *objv) /* Arguments. */
{
DelCmd *dPtr;
Tcl_Interp *child;
if (objc != 4) {
Tcl_WrongNumArgs(interp, 1, objv, "interp name delcmdname");
return TCL_ERROR;
}
child = Tcl_GetChild(interp, Tcl_GetString(objv[1]));
if (child == NULL) {
return TCL_ERROR;
}
dPtr = (DelCmd *)Tcl_Alloc(sizeof(DelCmd));
dPtr->interp = interp;
dPtr->deleteCmd = (char *)Tcl_Alloc(strlen(Tcl_GetString(objv[3])) + 1);
strcpy(dPtr->deleteCmd, Tcl_GetString(objv[3]));
Tcl_CreateObjCommand2(child, Tcl_GetString(objv[2]), DelCmdProc, dPtr,
DelDeleteProc);
return TCL_OK;
}
static int
DelCmdProc(
void *clientData, /* String result to return. */
Tcl_Interp *interp, /* Current interpreter. */
TCL_UNUSED(Tcl_Size) /*objv*/,
TCL_UNUSED(Tcl_Obj *const *) /*objv*/)
{
DelCmd *dPtr = (DelCmd *) clientData;
Tcl_AppendResult(interp, dPtr->deleteCmd, (char *)NULL);
Tcl_Free(dPtr->deleteCmd);
Tcl_Free(dPtr);
|
| ︙ | ︙ | |||
1841 1842 1843 1844 1845 1846 1847 |
*----------------------------------------------------------------------
*/
static int
TestdelassocdataCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 1783 1784 1785 1786 1787 1788 1789 1790 1791 1792 1793 1794 1795 1796 1797 |
*----------------------------------------------------------------------
*/
static int
TestdelassocdataCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const *objv) /* Arguments. */
{
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "data_key");
return TCL_ERROR;
}
Tcl_DeleteAssocData(interp, Tcl_GetString(objv[1]));
|
| ︙ | ︙ | |||
1877 1878 1879 1880 1881 1882 1883 |
*-----------------------------------------------------------------------------
*/
static int
TestdoubledigitsCmd(
TCL_UNUSED(void *),
Tcl_Interp* interp, /* Tcl interpreter */
| | | 1819 1820 1821 1822 1823 1824 1825 1826 1827 1828 1829 1830 1831 1832 1833 |
*-----------------------------------------------------------------------------
*/
static int
TestdoubledigitsCmd(
TCL_UNUSED(void *),
Tcl_Interp* interp, /* Tcl interpreter */
Tcl_Size objc, /* Parameter count */
Tcl_Obj* const objv[]) /* Parameter vector */
{
static const char *options[] = {
"shortest",
"e",
"f",
NULL
|
| ︙ | ︙ | |||
1964 1965 1966 1967 1968 1969 1970 |
*----------------------------------------------------------------------
*/
static int
TestdstringCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 1906 1907 1908 1909 1910 1911 1912 1913 1914 1915 1916 1917 1918 1919 1920 |
*----------------------------------------------------------------------
*/
static int
TestdstringCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const *objv) /* Arguments. */
{
int count;
if (objc < 2) {
wrongNumArgs:
Tcl_WrongNumArgs(interp, 1, objv, "option ?args?");
|
| ︙ | ︙ | |||
2125 2126 2127 2128 2129 2130 2131 |
Tcl_Size srcLen, int flags, Tcl_EncodingState *statePtr, char *dst,
Tcl_Size dstLen, int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr);
static int
UtfExtWrapper(
Tcl_Interp *interp,
UtfTransformFn *transformer,
| | | 2067 2068 2069 2070 2071 2072 2073 2074 2075 2076 2077 2078 2079 2080 2081 |
Tcl_Size srcLen, int flags, Tcl_EncodingState *statePtr, char *dst,
Tcl_Size dstLen, int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr);
static int
UtfExtWrapper(
Tcl_Interp *interp,
UtfTransformFn *transformer,
Tcl_Size objc,
Tcl_Obj *const objv[])
{
Tcl_Encoding encoding;
Tcl_EncodingState encState, *encStatePtr;
Tcl_Size srcLen, bufLen;
const unsigned char *bytes;
unsigned char *bufPtr;
|
| ︙ | ︙ | |||
2323 2324 2325 2326 2327 2328 2329 |
*----------------------------------------------------------------------
*/
static int
TestencodingCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 2265 2266 2267 2268 2269 2270 2271 2272 2273 2274 2275 2276 2277 2278 2279 |
*----------------------------------------------------------------------
*/
static int
TestencodingCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_Encoding encoding;
Tcl_Size length;
const char *string;
TclEncoding *encodingPtr;
static const char *const optionStrings[] = {
|
| ︙ | ︙ | |||
2529 2530 2531 2532 2533 2534 2535 |
*----------------------------------------------------------------------
*/
static int
TestevalexCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 2471 2472 2473 2474 2475 2476 2477 2478 2479 2480 2481 2482 2483 2484 2485 |
*----------------------------------------------------------------------
*/
static int
TestevalexCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
int flags;
Tcl_Size length;
const char *script;
flags = 0;
|
| ︙ | ︙ | |||
2575 2576 2577 2578 2579 2580 2581 |
*----------------------------------------------------------------------
*/
static int
TestevalobjvCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 2517 2518 2519 2520 2521 2522 2523 2524 2525 2526 2527 2528 2529 2530 2531 |
*----------------------------------------------------------------------
*/
static int
TestevalobjvCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
int evalGlobal;
if (objc < 3) {
Tcl_WrongNumArgs(interp, 1, objv, "global word ?word ...?");
return TCL_ERROR;
|
| ︙ | ︙ | |||
2624 2625 2626 2627 2628 2629 2630 |
*----------------------------------------------------------------------
*/
static int
TesteventCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Tcl interpreter */
| | | 2566 2567 2568 2569 2570 2571 2572 2573 2574 2575 2576 2577 2578 2579 2580 |
*----------------------------------------------------------------------
*/
static int
TesteventCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Tcl interpreter */
Tcl_Size objc, /* Parameter count */
Tcl_Obj *const objv[]) /* Parameter vector */
{
static const char *const subcommands[] = { /* Possible subcommands */
"queue", "delete", NULL
};
int subCmdIndex; /* Index of the chosen subcommand */
static const char *const positions[] = { /* Possible queue positions */
|
| ︙ | ︙ | |||
2803 2804 2805 2806 2807 2808 2809 |
*----------------------------------------------------------------------
*/
static int
TestexithandlerCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 2745 2746 2747 2748 2749 2750 2751 2752 2753 2754 2755 2756 2757 2758 2759 |
*----------------------------------------------------------------------
*/
static int
TestexithandlerCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const *objv) /* Arguments. */
{
int value;
if (objc != 3) {
Tcl_WrongNumArgs(interp, 1, objv, "create|delete value");
return TCL_ERROR;
|
| ︙ | ︙ | |||
2878 2879 2880 2881 2882 2883 2884 |
*----------------------------------------------------------------------
*/
static int
TestexprlongCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 2820 2821 2822 2823 2824 2825 2826 2827 2828 2829 2830 2831 2832 2833 2834 |
*----------------------------------------------------------------------
*/
static int
TestexprlongCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const *objv) /* Arguments. */
{
long exprResult;
char buf[4 + TCL_INTEGER_SPACE];
int result;
if (objc != 2) {
|
| ︙ | ︙ | |||
2920 2921 2922 2923 2924 2925 2926 |
*----------------------------------------------------------------------
*/
static int
TestexprlongobjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 2862 2863 2864 2865 2866 2867 2868 2869 2870 2871 2872 2873 2874 2875 2876 |
*----------------------------------------------------------------------
*/
static int
TestexprlongobjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const *objv) /* Argument objects. */
{
long exprResult;
char buf[4 + TCL_INTEGER_SPACE];
int result;
if (objc != 2) {
|
| ︙ | ︙ | |||
2962 2963 2964 2965 2966 2967 2968 |
*----------------------------------------------------------------------
*/
static int
TestexprdoubleCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 2904 2905 2906 2907 2908 2909 2910 2911 2912 2913 2914 2915 2916 2917 2918 |
*----------------------------------------------------------------------
*/
static int
TestexprdoubleCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const *objv) /* Arguments. */
{
double exprResult;
char buf[4 + TCL_DOUBLE_SPACE];
int result;
if (objc != 2) {
|
| ︙ | ︙ | |||
3005 3006 3007 3008 3009 3010 3011 |
*----------------------------------------------------------------------
*/
static int
TestexprdoubleobjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 2947 2948 2949 2950 2951 2952 2953 2954 2955 2956 2957 2958 2959 2960 2961 |
*----------------------------------------------------------------------
*/
static int
TestexprdoubleobjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const *objv) /* Argument objects. */
{
double exprResult;
char buf[4 + TCL_DOUBLE_SPACE];
int result;
if (objc != 2) {
|
| ︙ | ︙ | |||
3047 3048 3049 3050 3051 3052 3053 |
*----------------------------------------------------------------------
*/
static int
TestexprstringCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 2989 2990 2991 2992 2993 2994 2995 2996 2997 2998 2999 3000 3001 3002 3003 |
*----------------------------------------------------------------------
*/
static int
TestexprstringCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const *objv) /* Argument strings. */
{
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "expression");
return TCL_ERROR;
}
return Tcl_ExprString(interp, Tcl_GetString(objv[1]));
|
| ︙ | ︙ | |||
3078 3079 3080 3081 3082 3083 3084 |
*----------------------------------------------------------------------
*/
static int
TestfilelinkCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 3020 3021 3022 3023 3024 3025 3026 3027 3028 3029 3030 3031 3032 3033 3034 |
*----------------------------------------------------------------------
*/
static int
TestfilelinkCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* The argument objects. */
{
Tcl_Obj *contents;
if (objc < 2 || objc > 3) {
Tcl_WrongNumArgs(interp, 1, objv, "source ?target?");
return TCL_ERROR;
|
| ︙ | ︙ | |||
3145 3146 3147 3148 3149 3150 3151 |
*----------------------------------------------------------------------
*/
static int
TestgetassocdataCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 3087 3088 3089 3090 3091 3092 3093 3094 3095 3096 3097 3098 3099 3100 3101 |
*----------------------------------------------------------------------
*/
static int
TestgetassocdataCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const *objv) /* Arguments. */
{
char *res;
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "data_key");
return TCL_ERROR;
|
| ︙ | ︙ | |||
3182 3183 3184 3185 3186 3187 3188 |
*----------------------------------------------------------------------
*/
static int
TestgetplatformCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 3124 3125 3126 3127 3128 3129 3130 3131 3132 3133 3134 3135 3136 3137 3138 |
*----------------------------------------------------------------------
*/
static int
TestgetplatformCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const *objv) /* Arguments. */
{
static const char *const platformStrings[] = { "unix", "mac", "windows" };
TclPlatformType *platform;
platform = TclGetPlatform();
|
| ︙ | ︙ | |||
3221 3222 3223 3224 3225 3226 3227 |
*----------------------------------------------------------------------
*/
static int
TestinterpdeleteCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 3163 3164 3165 3166 3167 3168 3169 3170 3171 3172 3173 3174 3175 3176 3177 |
*----------------------------------------------------------------------
*/
static int
TestinterpdeleteCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const *objv) /* Arguments. */
{
Tcl_Interp *childToDelete;
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "path");
return TCL_ERROR;
|
| ︙ | ︙ | |||
3260 3261 3262 3263 3264 3265 3266 |
*----------------------------------------------------------------------
*/
static int
TestlinkCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 3202 3203 3204 3205 3206 3207 3208 3209 3210 3211 3212 3213 3214 3215 3216 |
*----------------------------------------------------------------------
*/
static int
TestlinkCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const *objv) /* Arguments. */
{
static int intVar = 43;
static int boolVar = 4;
static double realVar = 1.23;
static Tcl_WideInt wideVar = 79;
static char *stringVar = NULL;
|
| ︙ | ︙ | |||
3721 3722 3723 3724 3725 3726 3727 |
*----------------------------------------------------------------------
*/
static int
TestlinkarrayCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | > | 3663 3664 3665 3666 3667 3668 3669 3670 3671 3672 3673 3674 3675 3676 3677 3678 3679 3680 3681 3682 3683 3684 3685 3686 3687 3688 3689 3690 3691 3692 3693 3694 3695 3696 3697 3698 |
*----------------------------------------------------------------------
*/
static int
TestlinkarrayCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
static const char *LinkOption[] = {
"update", "remove", "create", NULL
};
enum LinkOptionEnum { LINK_UPDATE, LINK_REMOVE, LINK_CREATE } optionIndex;
static const char *LinkType[] = {
"char", "uchar", "short", "ushort", "int", "uint", "long", "ulong",
"wide", "uwide", "float", "double", "string", "char*", "binary", NULL
};
/* all values after TCL_LINK_CHARS_ARRAY are used as arrays (see below) */
static int LinkTypes[] = {
TCL_LINK_CHAR, TCL_LINK_UCHAR,
TCL_LINK_SHORT, TCL_LINK_USHORT, TCL_LINK_INT, TCL_LINK_UINT,
TCL_LINK_LONG, TCL_LINK_ULONG, TCL_LINK_WIDE_INT, TCL_LINK_WIDE_UINT,
TCL_LINK_FLOAT, TCL_LINK_DOUBLE, TCL_LINK_STRING, TCL_LINK_CHARS,
TCL_LINK_BINARY
};
int typeIndex, readonly, size;
Tcl_Size i;
Tcl_Size length;
char *name, *arg;
Tcl_WideInt addr;
if (objc < 2) {
Tcl_WrongNumArgs(interp, 1, objv, "option args");
return TCL_ERROR;
}
|
| ︙ | ︙ | |||
3840 3841 3842 3843 3844 3845 3846 |
*----------------------------------------------------------------------
*/
static int
TestlistrepCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 3783 3784 3785 3786 3787 3788 3789 3790 3791 3792 3793 3794 3795 3796 3797 |
*----------------------------------------------------------------------
*/
static int
TestlistrepCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
/* Subcommands supported by this command */
static const char *const subcommands[] = {
"new",
"describe",
"config",
|
| ︙ | ︙ | |||
4008 4009 4010 4011 4012 4013 4014 |
*----------------------------------------------------------------------
*/
static int
TestlistapiCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 3951 3952 3953 3954 3955 3956 3957 3958 3959 3960 3961 3962 3963 3964 3965 |
*----------------------------------------------------------------------
*/
static int
TestlistapiCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
static const char* const subcommands[] = {
"Tcl_ListObjRange",
"Tcl_ListObjRepeat",
"Tcl_ListObjReverse",
NULL
|
| ︙ | ︙ | |||
4178 4179 4180 4181 4182 4183 4184 |
*----------------------------------------------------------------------
*/
static int
TestlocaleCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 4121 4122 4123 4124 4125 4126 4127 4128 4129 4130 4131 4132 4133 4134 4135 |
*----------------------------------------------------------------------
*/
static int
TestlocaleCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* The argument objects. */
{
int index;
const char *locale;
static const char *const optionStrings[] = {
"ctype", "numeric", "time", "collate", "monetary",
"all", NULL
|
| ︙ | ︙ | |||
4264 4265 4266 4267 4268 4269 4270 |
*----------------------------------------------------------------------
*/
static int
TestmsbObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 4207 4208 4209 4210 4211 4212 4213 4214 4215 4216 4217 4218 4219 4220 4221 |
*----------------------------------------------------------------------
*/
static int
TestmsbObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* The argument objects. */
{
Tcl_WideInt w = 0;
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "integer");
return TCL_ERROR;
|
| ︙ | ︙ | |||
4306 4307 4308 4309 4310 4311 4312 |
*----------------------------------------------------------------------
*/
static int
TestparserCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 4249 4250 4251 4252 4253 4254 4255 4256 4257 4258 4259 4260 4261 4262 4263 |
*----------------------------------------------------------------------
*/
static int
TestparserCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* The argument objects. */
{
const char *script;
Tcl_Size dummy;
Tcl_Size length;
Tcl_Parse parse;
|
| ︙ | ︙ | |||
4363 4364 4365 4366 4367 4368 4369 |
*----------------------------------------------------------------------
*/
static int
TestexprparserCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 4306 4307 4308 4309 4310 4311 4312 4313 4314 4315 4316 4317 4318 4319 4320 |
*----------------------------------------------------------------------
*/
static int
TestexprparserCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* The argument objects. */
{
const char *script;
Tcl_Size dummy;
Tcl_Size length;
Tcl_Parse parse;
|
| ︙ | ︙ | |||
4512 4513 4514 4515 4516 4517 4518 |
*----------------------------------------------------------------------
*/
static int
TestparsevarCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 4455 4456 4457 4458 4459 4460 4461 4462 4463 4464 4465 4466 4467 4468 4469 |
*----------------------------------------------------------------------
*/
static int
TestparsevarCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* The argument objects. */
{
const char *value, *name, *termPtr;
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "varName");
return TCL_ERROR;
|
| ︙ | ︙ | |||
4553 4554 4555 4556 4557 4558 4559 |
*----------------------------------------------------------------------
*/
static int
TestparsevarnameCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 4496 4497 4498 4499 4500 4501 4502 4503 4504 4505 4506 4507 4508 4509 4510 |
*----------------------------------------------------------------------
*/
static int
TestparsevarnameCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* The argument objects. */
{
const char *script;
int append;
Tcl_Size length, dummy;
Tcl_Parse parse;
|
| ︙ | ︙ | |||
4617 4618 4619 4620 4621 4622 4623 |
*----------------------------------------------------------------------
*/
static int
TestpreferstableCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 4560 4561 4562 4563 4564 4565 4566 4567 4568 4569 4570 4571 4572 4573 4574 |
*----------------------------------------------------------------------
*/
static int
TestpreferstableCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
TCL_UNUSED(Tcl_Size) /*objc*/,
TCL_UNUSED(Tcl_Obj *const *) /*objv*/)
{
Interp *iPtr = (Interp *) interp;
iPtr->packagePrefer = PKG_PREFER_STABLE;
return TCL_OK;
}
|
| ︙ | ︙ | |||
4647 4648 4649 4650 4651 4652 4653 |
*----------------------------------------------------------------------
*/
static int
TestprintCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 4590 4591 4592 4593 4594 4595 4596 4597 4598 4599 4600 4601 4602 4603 4604 |
*----------------------------------------------------------------------
*/
static int
TestprintCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* The argument objects. */
{
Tcl_WideInt argv1 = 0;
size_t argv2;
long argv3;
if (objc != 3) {
|
| ︙ | ︙ | |||
4689 4690 4691 4692 4693 4694 4695 |
*----------------------------------------------------------------------
*/
static int
TestregexpCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | > | | 4632 4633 4634 4635 4636 4637 4638 4639 4640 4641 4642 4643 4644 4645 4646 4647 4648 4649 4650 4651 |
*----------------------------------------------------------------------
*/
static int
TestregexpCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
int indices, match, about;
Tcl_Size i;
Tcl_Size stringLength, ii;
int hasxflags, cflags, eflags;
Tcl_RegExp regExpr;
const char *string;
Tcl_Obj *objPtr;
Tcl_RegExpInfo info;
static const char *const options[] = {
"-indices", "-nocase", "-about", "-expanded",
|
| ︙ | ︙ | |||
4849 4850 4851 4852 4853 4854 4855 |
Tcl_RegExpGetInfo(regExpr, &info);
for (i = 0; i < objc; i++) {
Tcl_Size start, end;
Tcl_Obj *newPtr, *varPtr, *valuePtr;
varPtr = objv[i];
| | | 4793 4794 4795 4796 4797 4798 4799 4800 4801 4802 4803 4804 4805 4806 4807 |
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;
|
| ︙ | ︙ | |||
5013 5014 5015 5016 5017 5018 5019 |
*----------------------------------------------------------------------
*/
static int
TestreturnCmd(
TCL_UNUSED(void *),
TCL_UNUSED(Tcl_Interp *),
| | | 4957 4958 4959 4960 4961 4962 4963 4964 4965 4966 4967 4968 4969 4970 4971 |
*----------------------------------------------------------------------
*/
static int
TestreturnCmd(
TCL_UNUSED(void *),
TCL_UNUSED(Tcl_Interp *),
TCL_UNUSED(Tcl_Size) /*objc*/,
TCL_UNUSED(Tcl_Obj *const *) /*objv*/)
{
return TCL_RETURN;
}
/*
*----------------------------------------------------------------------
|
| ︙ | ︙ | |||
5041 5042 5043 5044 5045 5046 5047 |
*----------------------------------------------------------------------
*/
static int
TestsetassocdataCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 4985 4986 4987 4988 4989 4990 4991 4992 4993 4994 4995 4996 4997 4998 4999 |
*----------------------------------------------------------------------
*/
static int
TestsetassocdataCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const *objv) /* Arguments. */
{
char *buf, *oldData;
Tcl_InterpDeleteProc *procPtr;
if (objc != 3) {
Tcl_WrongNumArgs(interp, 1, objv, "data_key data_item");
|
| ︙ | ︙ | |||
5091 5092 5093 5094 5095 5096 5097 |
*----------------------------------------------------------------------
*/
static int
TestsetplatformCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 5035 5036 5037 5038 5039 5040 5041 5042 5043 5044 5045 5046 5047 5048 5049 |
*----------------------------------------------------------------------
*/
static int
TestsetplatformCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const *objv) /* Arguments. */
{
Tcl_Size length;
TclPlatformType *platform;
platform = TclGetPlatform();
|
| ︙ | ︙ | |||
5121 5122 5123 5124 5125 5126 5127 |
return TCL_OK;
}
static int
TestSizeCmd(
TCL_UNUSED(void *), /* Unused */
Tcl_Interp* interp, /* Tcl interpreter */
| | | 5065 5066 5067 5068 5069 5070 5071 5072 5073 5074 5075 5076 5077 5078 5079 |
return TCL_OK;
}
static int
TestSizeCmd(
TCL_UNUSED(void *), /* Unused */
Tcl_Interp* interp, /* Tcl interpreter */
Tcl_Size objc, /* Parameter count */
Tcl_Obj *const * objv) /* Parameter vector */
{
if (objc != 2) {
goto syntax;
}
if (strcmp(Tcl_GetString(objv[1]), "st_mtime") == 0) {
Tcl_StatBuf *statPtr;
|
| ︙ | ︙ | |||
5160 5161 5162 5163 5164 5165 5166 |
*----------------------------------------------------------------------
*/
static int
TeststaticlibraryCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 5104 5105 5106 5107 5108 5109 5110 5111 5112 5113 5114 5115 5116 5117 5118 |
*----------------------------------------------------------------------
*/
static int
TeststaticlibraryCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const *objv) /* Argument strings. */
{
int safe, loaded;
if (objc != 4) {
Tcl_WrongNumArgs(interp, 1, objv, "prefix safe loaded");
return TCL_ERROR;
|
| ︙ | ︙ | |||
5210 5211 5212 5213 5214 5215 5216 |
*----------------------------------------------------------------------
*/
static int
TesttranslatefilenameCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 5154 5155 5156 5157 5158 5159 5160 5161 5162 5163 5164 5165 5166 5167 5168 |
*----------------------------------------------------------------------
*/
static int
TesttranslatefilenameCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const *objv) /* Arguments. */
{
Tcl_DString buffer;
const char *result;
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "path");
|
| ︙ | ︙ | |||
5252 5253 5254 5255 5256 5257 5258 |
*----------------------------------------------------------------------
*/
static int
TestfstildeexpandCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 5196 5197 5198 5199 5200 5201 5202 5203 5204 5205 5206 5207 5208 5209 5210 |
*----------------------------------------------------------------------
*/
static int
TestfstildeexpandCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* The argument objects. */
{
Tcl_DString buffer;
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "PATH");
return TCL_ERROR;
|
| ︙ | ︙ | |||
5289 5290 5291 5292 5293 5294 5295 |
*----------------------------------------------------------------------
*/
static int
TestupvarCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 5233 5234 5235 5236 5237 5238 5239 5240 5241 5242 5243 5244 5245 5246 5247 |
*----------------------------------------------------------------------
*/
static int
TestupvarCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const *objv) /* Arguments. */
{
int flags = 0;
if ((objc != 5) && (objc != 6)) {
Tcl_WrongNumArgs(interp, 1, objv, "level name ?name2? dest global");
return TCL_ERROR;
|
| ︙ | ︙ | |||
5340 5341 5342 5343 5344 5345 5346 |
*----------------------------------------------------------------------
*/
static int
TestuniClassCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 5284 5285 5286 5287 5288 5289 5290 5291 5292 5293 5294 5295 5296 5297 5298 |
*----------------------------------------------------------------------
*/
static int
TestuniClassCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const *objv) /* Arguments. */
{
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "integer");
return TCL_ERROR;
}
|
| ︙ | ︙ | |||
5415 5416 5417 5418 5419 5420 5421 |
*----------------------------------------------------------------------
*/
static int
TestseterrorcodeCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 5359 5360 5361 5362 5363 5364 5365 5366 5367 5368 5369 5370 5371 5372 5373 |
*----------------------------------------------------------------------
*/
static int
TestseterrorcodeCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const *objv) /* Arguments. */
{
if (objc > 6) {
Tcl_AppendResult(interp, "too many args", (char *)NULL);
return TCL_ERROR;
}
switch (objc) {
|
| ︙ | ︙ | |||
5471 5472 5473 5474 5475 5476 5477 |
*----------------------------------------------------------------------
*/
static int
TestsetobjerrorcodeCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 5415 5416 5417 5418 5419 5420 5421 5422 5423 5424 5425 5426 5427 5428 5429 |
*----------------------------------------------------------------------
*/
static int
TestsetobjerrorcodeCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* The argument objects. */
{
Tcl_SetObjErrorCode(interp, Tcl_ConcatObj(objc - 1, objv + 1));
return TCL_ERROR;
}
/*
|
| ︙ | ︙ | |||
5499 5500 5501 5502 5503 5504 5505 |
*----------------------------------------------------------------------
*/
static int
TestfeventCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 5443 5444 5445 5446 5447 5448 5449 5450 5451 5452 5453 5454 5455 5456 5457 |
*----------------------------------------------------------------------
*/
static int
TestfeventCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const *objv) /* Arguments. */
{
static Tcl_Interp *interp2 = NULL;
int code;
Tcl_Channel chan;
if (objc < 2) {
|
| ︙ | ︙ | |||
5569 5570 5571 5572 5573 5574 5575 |
*----------------------------------------------------------------------
*/
static int
TestpanicCmd(
TCL_UNUSED(void *),
TCL_UNUSED(Tcl_Interp *),
| | | | | 5513 5514 5515 5516 5517 5518 5519 5520 5521 5522 5523 5524 5525 5526 5527 5528 5529 5530 5531 5532 5533 5534 5535 5536 5537 5538 5539 5540 5541 5542 5543 5544 5545 5546 5547 5548 5549 5550 5551 5552 |
*----------------------------------------------------------------------
*/
static int
TestpanicCmd(
TCL_UNUSED(void *),
TCL_UNUSED(Tcl_Interp *),
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const *objv) /* Arguments. */
{
/*
* Put the arguments into a var args structure
* Append all of the arguments together separated by spaces
*/
Tcl_Obj *list = Tcl_NewListObj(objc-1, objv+1);
Tcl_Panic("%s", Tcl_GetString(list));
Tcl_DecrRefCount(list);
return TCL_OK;
}
static int
TestfileCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const *objv) /* The argument objects. */
{
int force, i, result;
Tcl_Obj *error = NULL;
const char *subcmd;
Tcl_Size j;
if (objc < 3) {
return TCL_ERROR;
}
force = 0;
i = 2;
|
| ︙ | ︙ | |||
5671 5672 5673 5674 5675 5676 5677 |
*----------------------------------------------------------------------
*/
static int
TestgetvarfullnameCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 5615 5616 5617 5618 5619 5620 5621 5622 5623 5624 5625 5626 5627 5628 5629 |
*----------------------------------------------------------------------
*/
static int
TestgetvarfullnameCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* The argument objects. */
{
const char *name, *arg;
int flags = 0;
Tcl_Namespace *namespacePtr;
Tcl_CallFrame *framePtr;
Tcl_Var variable;
|
| ︙ | ︙ | |||
5745 5746 5747 5748 5749 5750 5751 |
*----------------------------------------------------------------------
*/
static int
GetTimesCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* The current interpreter. */
| | | 5689 5690 5691 5692 5693 5694 5695 5696 5697 5698 5699 5700 5701 5702 5703 |
*----------------------------------------------------------------------
*/
static int
GetTimesCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* The current interpreter. */
TCL_UNUSED(Tcl_Size) /*cobjc*/,
TCL_UNUSED(Tcl_Obj *const *) /*cobjv*/)
{
Interp *iPtr = (Interp *) interp;
int i, n;
double timePer;
Tcl_Time start, stop;
Tcl_Obj *objPtr, **objv;
|
| ︙ | ︙ | |||
5924 5925 5926 5927 5928 5929 5930 |
*----------------------------------------------------------------------
*/
static int
NoopCmd(
TCL_UNUSED(void *),
TCL_UNUSED(Tcl_Interp *),
| | | | 5868 5869 5870 5871 5872 5873 5874 5875 5876 5877 5878 5879 5880 5881 5882 5883 |
*----------------------------------------------------------------------
*/
static int
NoopCmd(
TCL_UNUSED(void *),
TCL_UNUSED(Tcl_Interp *),
TCL_UNUSED(Tcl_Size) /*objc*/,
TCL_UNUSED(Tcl_Obj *const *) /*objv*/)
{
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
|
| ︙ | ︙ | |||
5951 5952 5953 5954 5955 5956 5957 |
*----------------------------------------------------------------------
*/
static int
NoopObjCmd(
TCL_UNUSED(void *),
TCL_UNUSED(Tcl_Interp *),
| | | 5895 5896 5897 5898 5899 5900 5901 5902 5903 5904 5905 5906 5907 5908 5909 |
*----------------------------------------------------------------------
*/
static int
NoopObjCmd(
TCL_UNUSED(void *),
TCL_UNUSED(Tcl_Interp *),
TCL_UNUSED(Tcl_Size) /*objc*/,
TCL_UNUSED(Tcl_Obj *const *) /*objv*/)
{
return TCL_OK;
}
/*
*----------------------------------------------------------------------
|
| ︙ | ︙ | |||
5976 5977 5978 5979 5980 5981 5982 |
*----------------------------------------------------------------------
*/
static int
TeststringbytesCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 5920 5921 5922 5923 5924 5925 5926 5927 5928 5929 5930 5931 5932 5933 5934 |
*----------------------------------------------------------------------
*/
static int
TeststringbytesCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* The argument objects. */
{
Tcl_Size n;
const unsigned char *p;
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "value");
|
| ︙ | ︙ | |||
6016 6017 6018 6019 6020 6021 6022 |
*----------------------------------------------------------------------
*/
static int
TestpurebytesobjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 5960 5961 5962 5963 5964 5965 5966 5967 5968 5969 5970 5971 5972 5973 5974 |
*----------------------------------------------------------------------
*/
static int
TestpurebytesobjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* The argument objects. */
{
Tcl_Obj *objPtr;
if (objc > 2) {
Tcl_WrongNumArgs(interp, 1, objv, "?string?");
return TCL_ERROR;
|
| ︙ | ︙ | |||
6063 6064 6065 6066 6067 6068 6069 |
*----------------------------------------------------------------------
*/
static int
TestsetbytearraylengthCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 6007 6008 6009 6010 6011 6012 6013 6014 6015 6016 6017 6018 6019 6020 6021 |
*----------------------------------------------------------------------
*/
static int
TestsetbytearraylengthCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* The argument objects. */
{
int n;
Tcl_Obj *obj = NULL;
if (objc != 3) {
Tcl_WrongNumArgs(interp, 1, objv, "value length");
|
| ︙ | ︙ | |||
6112 6113 6114 6115 6116 6117 6118 |
*----------------------------------------------------------------------
*/
static int
TestbytestringCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 6056 6057 6058 6059 6060 6061 6062 6063 6064 6065 6066 6067 6068 6069 6070 |
*----------------------------------------------------------------------
*/
static int
TestbytestringCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* The argument objects. */
{
struct {
#ifndef TCL_NO_DEPRECATED
int n; /* On purpose, not Tcl_Size, in order to demonstrate what happens */
#else
Tcl_Size n;
|
| ︙ | ︙ | |||
6164 6165 6166 6167 6168 6169 6170 |
*----------------------------------------------------------------------
*/
static int
TestsetCmd(
void *data, /* Additional flags for Get/SetVar2. */
Tcl_Interp *interp, /* Current interpreter. */
| | | 6108 6109 6110 6111 6112 6113 6114 6115 6116 6117 6118 6119 6120 6121 6122 |
*----------------------------------------------------------------------
*/
static int
TestsetCmd(
void *data, /* Additional flags for Get/SetVar2. */
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const *objv) /* Arguments. */
{
int flags = (int)PTR2INT(data);
const char *value;
if (objc == 2) {
Tcl_AppendResult(interp, "before get", (char *)NULL);
|
| ︙ | ︙ | |||
6196 6197 6198 6199 6200 6201 6202 |
return TCL_ERROR;
}
}
static int
Testset2Cmd(
void *data, /* Additional flags for Get/SetVar2. */
Tcl_Interp *interp, /* Current interpreter. */
| | | 6140 6141 6142 6143 6144 6145 6146 6147 6148 6149 6150 6151 6152 6153 6154 |
return TCL_ERROR;
}
}
static int
Testset2Cmd(
void *data, /* Additional flags for Get/SetVar2. */
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const *objv) /* Argument strings. */
{
int flags = (int)PTR2INT(data);
const char *value;
if (objc == 3) {
Tcl_AppendResult(interp, "before get", (char *)NULL);
|
| ︙ | ︙ | |||
6247 6248 6249 6250 6251 6252 6253 |
*----------------------------------------------------------------------
*/
static int
TestmainthreadCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 6191 6192 6193 6194 6195 6196 6197 6198 6199 6200 6201 6202 6203 6204 6205 |
*----------------------------------------------------------------------
*/
static int
TestmainthreadCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const *objv)
{
if (objc == 1) {
Tcl_Obj *idObj = Tcl_NewWideIntObj((Tcl_WideInt)(size_t)Tcl_GetCurrentThread());
Tcl_SetObjResult(interp, idObj);
return TCL_OK;
|
| ︙ | ︙ | |||
6308 6309 6310 6311 6312 6313 6314 |
*----------------------------------------------------------------------
*/
static int
TestsetmainloopCmd(
TCL_UNUSED(void *),
TCL_UNUSED(Tcl_Interp *),
| | | 6252 6253 6254 6255 6256 6257 6258 6259 6260 6261 6262 6263 6264 6265 6266 |
*----------------------------------------------------------------------
*/
static int
TestsetmainloopCmd(
TCL_UNUSED(void *),
TCL_UNUSED(Tcl_Interp *),
TCL_UNUSED(Tcl_Size) /*objc*/,
TCL_UNUSED(Tcl_Obj *const *) /*objv*/)
{
exitMainLoop = 0;
Tcl_SetMainLoop(MainLoop);
return TCL_OK;
}
|
| ︙ | ︙ | |||
6337 6338 6339 6340 6341 6342 6343 |
*----------------------------------------------------------------------
*/
static int
TestexitmainloopCmd(
TCL_UNUSED(void *),
TCL_UNUSED(Tcl_Interp *),
| | | 6281 6282 6283 6284 6285 6286 6287 6288 6289 6290 6291 6292 6293 6294 6295 |
*----------------------------------------------------------------------
*/
static int
TestexitmainloopCmd(
TCL_UNUSED(void *),
TCL_UNUSED(Tcl_Interp *),
TCL_UNUSED(Tcl_Size) /*objc*/,
TCL_UNUSED(Tcl_Obj *const *) /*objv*/)
{
exitMainLoop = 1;
return TCL_OK;
}
/*
|
| ︙ | ︙ | |||
6365 6366 6367 6368 6369 6370 6371 |
*----------------------------------------------------------------------
*/
static int
TestChannelCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Interpreter for result. */
| | | 6309 6310 6311 6312 6313 6314 6315 6316 6317 6318 6319 6320 6321 6322 6323 |
*----------------------------------------------------------------------
*/
static int
TestChannelCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Interpreter for result. */
Tcl_Size objc, /* Count of additional args. */
Tcl_Obj *const *objv) /* Additional args. */
{
const char *cmdName; /* Sub command. */
Tcl_HashTable *hTblPtr; /* Hash table of channels. */
Tcl_HashSearch hSearch; /* Search variable. */
Tcl_HashEntry *hPtr; /* Search variable. */
Channel *chanPtr; /* The actual channel. */
|
| ︙ | ︙ | |||
6414 6415 6416 6417 6418 6419 6420 |
}
} else {
chan = Tcl_GetChannel(interp, Tcl_GetString(objv[2]), &mode);
}
if (chan == (Tcl_Channel) NULL) {
return TCL_ERROR;
}
| | | 6358 6359 6360 6361 6362 6363 6364 6365 6366 6367 6368 6369 6370 6371 6372 |
}
} else {
chan = Tcl_GetChannel(interp, Tcl_GetString(objv[2]), &mode);
}
if (chan == (Tcl_Channel) NULL) {
return TCL_ERROR;
}
chanPtr = (Channel *) chan;
statePtr = chanPtr->state;
chanPtr = statePtr->topChanPtr;
chan = (Tcl_Channel) chanPtr;
} else {
statePtr = NULL;
chan = NULL;
}
|
| ︙ | ︙ | |||
6737 6738 6739 6740 6741 6742 6743 |
hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(interp, "tclIO", NULL);
if (hTblPtr == NULL) {
return TCL_OK;
}
for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch);
hPtr != NULL;
hPtr = Tcl_NextHashEntry(&hSearch)) {
| | | 6681 6682 6683 6684 6685 6686 6687 6688 6689 6690 6691 6692 6693 6694 6695 |
hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(interp, "tclIO", NULL);
if (hTblPtr == NULL) {
return TCL_OK;
}
for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch);
hPtr != NULL;
hPtr = Tcl_NextHashEntry(&hSearch)) {
chanPtr = (Channel *) Tcl_GetHashValue(hPtr);
statePtr = chanPtr->state;
if (statePtr->flags & TCL_READABLE) {
Tcl_AppendElement(interp, (char *)Tcl_GetHashKey(hTblPtr, hPtr));
}
}
return TCL_OK;
}
|
| ︙ | ︙ | |||
6794 6795 6796 6797 6798 6799 6800 |
if ((cmdName[0] == 'w') && (strncmp(cmdName, "writable", len) == 0)) {
hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(interp, "tclIO", NULL);
if (hTblPtr == NULL) {
return TCL_OK;
}
for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch);
hPtr != NULL; hPtr = Tcl_NextHashEntry(&hSearch)) {
| | | 6738 6739 6740 6741 6742 6743 6744 6745 6746 6747 6748 6749 6750 6751 6752 |
if ((cmdName[0] == 'w') && (strncmp(cmdName, "writable", len) == 0)) {
hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(interp, "tclIO", NULL);
if (hTblPtr == NULL) {
return TCL_OK;
}
for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch);
hPtr != NULL; hPtr = Tcl_NextHashEntry(&hSearch)) {
chanPtr = (Channel *) Tcl_GetHashValue(hPtr);
statePtr = chanPtr->state;
if (statePtr->flags & TCL_WRITABLE) {
Tcl_AppendElement(interp, (char *)Tcl_GetHashKey(hTblPtr, hPtr));
}
}
return TCL_OK;
}
|
| ︙ | ︙ | |||
6860 6861 6862 6863 6864 6865 6866 |
*----------------------------------------------------------------------
*/
static int
TestChannelEventCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | | 6804 6805 6806 6807 6808 6809 6810 6811 6812 6813 6814 6815 6816 6817 6818 6819 6820 6821 6822 6823 6824 6825 6826 6827 6828 6829 6830 6831 6832 6833 |
*----------------------------------------------------------------------
*/
static int
TestChannelEventCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const *objv) /* Arguments. */
{
Tcl_Obj *resultListPtr;
Channel *chanPtr;
ChannelState *statePtr; /* state info for channel */
EventScriptRecord *esPtr, *prevEsPtr, *nextEsPtr;
const char *cmd;
int index, i, mask;
Tcl_Size len;
if ((objc < 3) || (objc > 5)) {
Tcl_WrongNumArgs(interp, 1, objv, "channel cmd ?arg1? ?arg2?");
return TCL_ERROR;
}
chanPtr = (Channel *) Tcl_GetChannel(interp, Tcl_GetString(objv[1]), NULL);
if (chanPtr == NULL) {
return TCL_ERROR;
}
statePtr = chanPtr->state;
cmd = Tcl_GetStringFromObj(objv[2], &len);
if ((cmd[0] == 'a') && (strncmp(cmd, "add", len) == 0)) {
|
| ︙ | ︙ | |||
7071 7072 7073 7074 7075 7076 7077 |
* process. */
};
static int
TestSocketCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Interpreter for result. */
| | | 7015 7016 7017 7018 7019 7020 7021 7022 7023 7024 7025 7026 7027 7028 7029 |
* process. */
};
static int
TestSocketCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Interpreter for result. */
Tcl_Size objc, /* Count of additional objc. */
Tcl_Obj *const *objv) /* Additional args. */
{
const char *cmdName; /* Sub command. */
Tcl_Size len; /* Length of subcommand string. */
if (objc < 2) {
Tcl_WrongNumArgs(interp, 1, objv, "subcommand ?additional args..?");
|
| ︙ | ︙ | |||
7147 7148 7149 7150 7151 7152 7153 |
*----------------------------------------------------------------------
*/
static int
TestServiceModeCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 7091 7092 7093 7094 7095 7096 7097 7098 7099 7100 7101 7102 7103 7104 7105 |
*----------------------------------------------------------------------
*/
static int
TestServiceModeCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const *objv) /* Arguments. */
{
int newmode, oldmode;
if (objc > 2) {
Tcl_WrongNumArgs(interp, 1, objv, "?newmode?");
return TCL_ERROR;
}
|
| ︙ | ︙ | |||
7242 7243 7244 7245 7246 7247 7248 |
*----------------------------------------------------------------------
*/
static int
TestGetIndexFromObjStructCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 7186 7187 7188 7189 7190 7191 7192 7193 7194 7195 7196 7197 7198 7199 7200 |
*----------------------------------------------------------------------
*/
static int
TestGetIndexFromObjStructCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
const char *const ary[] = {
"a", "b", "c", "d", "ee", "ff", NULL, NULL
};
int target, flags = 0;
signed char idx[8];
|
| ︙ | ︙ | |||
7306 7307 7308 7309 7310 7311 7312 |
*----------------------------------------------------------------------
*/
static int
TestFilesystemCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | 7250 7251 7252 7253 7254 7255 7256 7257 7258 7259 7260 7261 7262 7263 7264 |
*----------------------------------------------------------------------
*/
static int
TestFilesystemCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const objv[])
{
int res, boolVal;
const char *msg;
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "boolean");
|
| ︙ | ︙ | |||
7677 7678 7679 7680 7681 7682 7683 |
* important features.
*/
static int
TestSimpleFilesystemCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | 7621 7622 7623 7624 7625 7626 7627 7628 7629 7630 7631 7632 7633 7634 7635 |
* important features.
*/
static int
TestSimpleFilesystemCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const objv[])
{
int res, boolVal;
const char *msg;
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "boolean");
|
| ︙ | ︙ | |||
7839 7840 7841 7842 7843 7844 7845 |
* Usage: testutfnext -bytestring $bytes
*/
static int
TestUtfNextCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | 7783 7784 7785 7786 7787 7788 7789 7790 7791 7792 7793 7794 7795 7796 7797 |
* Usage: testutfnext -bytestring $bytes
*/
static int
TestUtfNextCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const objv[])
{
Tcl_Size numBytes;
char *bytes;
const char *result, *first;
char buffer[32];
static const char tobetested[] = "A\xA0\xC0\xC1\xC2\xD0\xE0\xE8\xF2\xF7\xF8\xFE\xFF";
|
| ︙ | ︙ | |||
7900 7901 7902 7903 7904 7905 7906 |
* Usage: testutfprev $bytes $offset
*/
static int
TestUtfPrevCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | 7844 7845 7846 7847 7848 7849 7850 7851 7852 7853 7854 7855 7856 7857 7858 |
* Usage: testutfprev $bytes $offset
*/
static int
TestUtfPrevCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const objv[])
{
Tcl_Size numBytes, offset;
char *bytes;
const char *result;
if (objc < 2 || objc > 3) {
|
| ︙ | ︙ | |||
7940 7941 7942 7943 7944 7945 7946 |
* Used to check correct string-length determining in Tcl_NumUtfChars
*/
static int
TestNumUtfCharsCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | 7884 7885 7886 7887 7888 7889 7890 7891 7892 7893 7894 7895 7896 7897 7898 |
* Used to check correct string-length determining in Tcl_NumUtfChars
*/
static int
TestNumUtfCharsCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const objv[])
{
if (objc > 1) {
Tcl_Size numBytes, len, limit = TCL_INDEX_NONE;
const char *bytes = Tcl_GetStringFromObj(objv[1], &numBytes);
if (objc > 2) {
|
| ︙ | ︙ | |||
7972 7973 7974 7975 7976 7977 7978 |
* This differs from just using "string index" in being a direct
* call to Tcl_GetUniChar without any prior range checking.
*/
static int
TestGetUniCharCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter */
| | | 7916 7917 7918 7919 7920 7921 7922 7923 7924 7925 7926 7927 7928 7929 7930 |
* This differs from just using "string index" in being a direct
* call to Tcl_GetUniChar without any prior range checking.
*/
static int
TestGetUniCharCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter */
Tcl_Size objc,
Tcl_Obj *const objv[]) /* Argument strings */
{
int index;
int c ;
if (objc != 3) {
Tcl_WrongNumArgs(interp, 1, objv, "STRING INDEX");
return TCL_ERROR;
|
| ︙ | ︙ | |||
7996 7997 7998 7999 8000 8001 8002 |
* Used to check correct operation of Tcl_UtfFindFirst
*/
static int
TestFindFirstCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | 7940 7941 7942 7943 7944 7945 7946 7947 7948 7949 7950 7951 7952 7953 7954 |
* Used to check correct operation of Tcl_UtfFindFirst
*/
static int
TestFindFirstCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const objv[])
{
if (objc > 1) {
int len = -1;
if (objc > 2) {
(void) Tcl_GetIntFromObj(interp, objv[2], &len);
|
| ︙ | ︙ | |||
8018 8019 8020 8021 8022 8023 8024 |
* Used to check correct operation of Tcl_UtfFindLast
*/
static int
TestFindLastCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | | 7962 7963 7964 7965 7966 7967 7968 7969 7970 7971 7972 7973 7974 7975 7976 7977 7978 7979 7980 7981 7982 7983 7984 7985 7986 7987 7988 7989 7990 7991 7992 7993 7994 |
* Used to check correct operation of Tcl_UtfFindLast
*/
static int
TestFindLastCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const objv[])
{
if (objc > 1) {
int len = -1;
if (objc > 2) {
(void) Tcl_GetIntFromObj(interp, objv[2], &len);
}
Tcl_SetObjResult(interp, Tcl_NewStringObj(Tcl_UtfFindLast(Tcl_GetString(objv[1]), len), -1));
}
return TCL_OK;
}
static int
TestGetIntForIndexCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const objv[])
{
Tcl_Size result;
Tcl_WideInt endvalue;
if (objc != 3) {
Tcl_WrongNumArgs(interp, 1, objv, "index endvalue");
|
| ︙ | ︙ | |||
8087 8088 8089 8090 8091 8092 8093 |
*----------------------------------------------------------------------
*/
static int
TestcpuidCmd(
TCL_UNUSED(void *),
Tcl_Interp* interp, /* Tcl interpreter */
| | | 8031 8032 8033 8034 8035 8036 8037 8038 8039 8040 8041 8042 8043 8044 8045 |
*----------------------------------------------------------------------
*/
static int
TestcpuidCmd(
TCL_UNUSED(void *),
Tcl_Interp* interp, /* Tcl interpreter */
Tcl_Size objc, /* Parameter count */
Tcl_Obj *const * objv) /* Parameter vector */
{
int status, index, i;
int regs[4];
Tcl_Obj *regsObjs[4];
if (objc != 2) {
|
| ︙ | ︙ | |||
8123 8124 8125 8126 8127 8128 8129 |
* Used to do basic checks of the TCL_HASH_KEY_SYSTEM_HASH flag
*/
static int
TestHashSystemHashCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | 8067 8068 8069 8070 8071 8072 8073 8074 8075 8076 8077 8078 8079 8080 8081 |
* Used to do basic checks of the TCL_HASH_KEY_SYSTEM_HASH flag
*/
static int
TestHashSystemHashCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const objv[])
{
static const Tcl_HashKeyType hkType = {
TCL_HASH_KEY_TYPE_VERSION, TCL_HASH_KEY_SYSTEM_HASH,
NULL, NULL, NULL, NULL
};
Tcl_HashTable hash;
|
| ︙ | ︙ | |||
8199 8200 8201 8202 8203 8204 8205 |
* Used for testing Tcl_GetInt which is no longer used directly by the
* core very much.
*/
static int
TestgetintCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | | | 8143 8144 8145 8146 8147 8148 8149 8150 8151 8152 8153 8154 8155 8156 8157 8158 8159 8160 8161 8162 8163 8164 8165 8166 8167 8168 8169 8170 8171 8172 8173 8174 8175 8176 8177 8178 8179 8180 8181 8182 8183 8184 8185 |
* Used for testing Tcl_GetInt which is no longer used directly by the
* core very much.
*/
static int
TestgetintCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const *objv)
{
if (objc < 2) {
Tcl_WrongNumArgs(interp, 1, objv, "?args?");
return TCL_ERROR;
} else {
int val, total=0;
Tcl_Size i;
for (i=1 ; i<objc ; i++) {
if (Tcl_GetInt(interp, Tcl_GetString(objv[i]), &val) != TCL_OK) {
return TCL_ERROR;
}
total += val;
}
Tcl_SetObjResult(interp, Tcl_NewWideIntObj(total));
return TCL_OK;
}
}
/*
* Used for determining sizeof(long) at script level.
*/
static int
TestlongsizeCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const *objv)
{
if (objc > 1) {
Tcl_WrongNumArgs(interp, 1, objv, "");
return TCL_ERROR;
}
Tcl_SetObjResult(interp, Tcl_NewWideIntObj(sizeof(long)));
|
| ︙ | ︙ | |||
8269 8270 8271 8272 8273 8274 8275 |
return TCL_OK;
}
static int
TestNREUnwind(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | | 8213 8214 8215 8216 8217 8218 8219 8220 8221 8222 8223 8224 8225 8226 8227 8228 8229 8230 8231 8232 8233 8234 8235 8236 8237 8238 8239 8240 8241 8242 8243 8244 8245 |
return TCL_OK;
}
static int
TestNREUnwind(
TCL_UNUSED(void *),
Tcl_Interp *interp,
TCL_UNUSED(Tcl_Size) /*objc*/,
TCL_UNUSED(Tcl_Obj *const *) /*objv*/)
{
/*
* Insure that callbacks effectively run at the proper level during the
* unwinding of the NRE stack.
*/
Tcl_NRAddCallback(interp, NREUnwind_callback, INT2PTR(-1), INT2PTR(-1),
INT2PTR(-1), NULL);
return TCL_OK;
}
static int
TestNRELevels(
TCL_UNUSED(void *),
Tcl_Interp *interp,
TCL_UNUSED(Tcl_Size) /*objc*/,
TCL_UNUSED(Tcl_Obj *const *) /*objv*/)
{
Interp *iPtr = (Interp *) interp;
static Tcl_Size *refDepth = NULL;
Tcl_Size depth;
Tcl_Obj *levels[6];
Tcl_Size i = 0;
|
| ︙ | ︙ | |||
8343 8344 8345 8346 8347 8348 8349 |
*----------------------------------------------------------------------
*/
static int
TestconcatobjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 8287 8288 8289 8290 8291 8292 8293 8294 8295 8296 8297 8298 8299 8300 8301 |
*----------------------------------------------------------------------
*/
static int
TestconcatobjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
TCL_UNUSED(Tcl_Size) /*objc*/,
TCL_UNUSED(Tcl_Obj *const *) /*objv*/)
{
Tcl_Obj *list1Ptr, *list2Ptr, *emptyPtr, *concatPtr, *tmpPtr;
int result = TCL_OK;
Tcl_Size len;
Tcl_Obj *objv[3];
|
| ︙ | ︙ | |||
8660 8661 8662 8663 8664 8665 8666 |
return 1;
}
static int
TestparseargsCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 8604 8605 8606 8607 8608 8609 8610 8611 8612 8613 8614 8615 8616 8617 8618 |
return 1;
}
static int
TestparseargsCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Arguments. */
{
static int foo = 0;
const char *media = NULL, *color = NULL;
Tcl_Size count = objc;
Tcl_Obj **remObjv, *result[5];
const Tcl_ArgvInfo argTable[] = {
|
| ︙ | ︙ | |||
8901 8902 8903 8904 8905 8906 8907 |
return TCL_CONTINUE;
}
static int
TestInterpResolverCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | 8845 8846 8847 8848 8849 8850 8851 8852 8853 8854 8855 8856 8857 8858 8859 |
return TCL_CONTINUE;
}
static int
TestInterpResolverCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const objv[])
{
static const char *const table[] = {
"down", "up", NULL
};
int idx;
#define RESOLVER_KEY "testInterpResolver"
|
| ︙ | ︙ | |||
8964 8965 8966 8967 8968 8969 8970 |
*
*------------------------------------------------------------------------
*/
int
TestApplyLambdaCmd(
TCL_UNUSED(void*),
Tcl_Interp *interp, /* Current interpreter. */
| | | 8908 8909 8910 8911 8912 8913 8914 8915 8916 8917 8918 8919 8920 8921 8922 |
*
*------------------------------------------------------------------------
*/
int
TestApplyLambdaCmd(
TCL_UNUSED(void*),
Tcl_Interp *interp, /* Current interpreter. */
TCL_UNUSED(Tcl_Size), /* objc. */
TCL_UNUSED(Tcl_Obj *const *)) /* objv. */
{
Tcl_Obj *lambdaObjs[2];
Tcl_Obj *evalObjs[2];
Tcl_Obj *lambdaObj;
int result;
|
| ︙ | ︙ | |||
9041 9042 9043 9044 9045 9046 9047 |
*----------------------------------------------------------------------
*/
static int
TestLutilCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 8985 8986 8987 8988 8989 8990 8991 8992 8993 8994 8995 8996 8997 8998 8999 |
*----------------------------------------------------------------------
*/
static int
TestLutilCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Arguments. */
{
Tcl_Size nL1, nL2;
Tcl_Obj *l1Obj = NULL;
Tcl_Obj *l2Obj = NULL;
Tcl_Obj **l1Elems;
Tcl_Obj **l2Elems;
|
| ︙ | ︙ | |||
9138 9139 9140 9141 9142 9143 9144 |
*
*----------------------------------------------------------------------
*/
static int
TestUtfToNormalizedCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 9082 9083 9084 9085 9086 9087 9088 9089 9090 9091 9092 9093 9094 9095 9096 |
*
*----------------------------------------------------------------------
*/
static int
TestUtfToNormalizedCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Arguments. */
{
if (objc != 5 && objc != 6) {
Tcl_WrongNumArgs(interp, 1, objv, "BYTES NORMALFORM PROFILE ?LENGTH? BUFLENGTH");
return TCL_ERROR;
}
Tcl_Size bufLen, len, slen;
|
| ︙ | ︙ | |||
9219 9220 9221 9222 9223 9224 9225 |
*
*----------------------------------------------------------------------
*/
static int
TestUtfToNormalizedDStringCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 9163 9164 9165 9166 9167 9168 9169 9170 9171 9172 9173 9174 9175 9176 9177 |
*
*----------------------------------------------------------------------
*/
static int
TestUtfToNormalizedDStringCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Arguments. */
{
if (objc != 4 && objc != 5) {
Tcl_WrongNumArgs(interp, 1, objv, "BYTES NORMALFORM PROFILE ?LENGTH?");
}
Tcl_Size len, slen;
unsigned char *s = Tcl_GetBytesFromObj(interp, objv[1], &slen);
|
| ︙ | ︙ | |||
9284 9285 9286 9287 9288 9289 9290 |
*
*----------------------------------------------------------------------
*/
static int
TestHandleCountCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 9228 9229 9230 9231 9232 9233 9234 9235 9236 9237 9238 9239 9240 9241 9242 |
*
*----------------------------------------------------------------------
*/
static int
TestHandleCountCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Arguments. */
{
DWORD count;
if (objc != 1) {
Tcl_WrongNumArgs(interp, 1, objv, "");
return TCL_ERROR;
}
|
| ︙ | ︙ | |||
9322 9323 9324 9325 9326 9327 9328 |
*
*----------------------------------------------------------------------
*/
static int
TestAppVerifierPresentCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 9266 9267 9268 9269 9270 9271 9272 9273 9274 9275 9276 9277 9278 9279 9280 |
*
*----------------------------------------------------------------------
*/
static int
TestAppVerifierPresentCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Arguments. */
{
if (objc != 1) {
Tcl_WrongNumArgs(interp, 1, objv, "");
return TCL_ERROR;
}
const char *dlls[] = {
|
| ︙ | ︙ |
Changes to generic/tclTestABSList.c.
| ︙ | ︙ | |||
659 660 661 662 663 664 665 |
*
*----------------------------------------------------------------------
*/
static Tcl_Obj *
my_NewLStringObj(
Tcl_Interp *interp,
| | | 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 |
*
*----------------------------------------------------------------------
*/
static Tcl_Obj *
my_NewLStringObj(
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj * const objv[])
{
LString *lstringRepPtr;
Tcl_ObjInternalRep itr;
size_t repSize;
Tcl_Obj *lstringPtr;
const char *string;
|
| ︙ | ︙ | |||
918 919 920 921 922 923 924 |
*----------------------------------------------------------------------
*/
static int
lLStringObjCmd(
void *clientData,
Tcl_Interp *interp,
| | | 918 919 920 921 922 923 924 925 926 927 928 929 930 931 932 |
*----------------------------------------------------------------------
*/
static int
lLStringObjCmd(
void *clientData,
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj * const objv[])
{
Tcl_Obj *lstringObj;
(void)clientData;
if (objc < 2) {
Tcl_WrongNumArgs(interp, 1, objv, "string");
|
| ︙ | ︙ | |||
1136 1137 1138 1139 1140 1141 1142 |
/*
* Create a new lgen Tcl_Obj
*/
Tcl_Obj *
newLgenObj(
Tcl_Interp *interp,
| | | 1136 1137 1138 1139 1140 1141 1142 1143 1144 1145 1146 1147 1148 1149 1150 |
/*
* Create a new lgen Tcl_Obj
*/
Tcl_Obj *
newLgenObj(
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj * const objv[])
{
Tcl_WideInt length;
LgenSeries *lGenSeriesRepPtr;
Tcl_Size repSize;
Tcl_Obj *lGenSeriesObj;
|
| ︙ | ︙ | |||
1187 1188 1189 1190 1191 1192 1193 |
/*
* The [lgen] command
*/
static int
lGenObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | 1187 1188 1189 1190 1191 1192 1193 1194 1195 1196 1197 1198 1199 1200 1201 |
/*
* The [lgen] command
*/
static int
lGenObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj * const objv[])
{
Tcl_Obj *genObj = newLgenObj(interp, objc-1, &objv[1]);
if (genObj) {
Tcl_SetObjResult(interp, genObj);
return TCL_OK;
}
|
| ︙ | ︙ | |||
1209 1210 1211 1212 1213 1214 1215 |
int
Lgen_Init(
Tcl_Interp *interp)
{
if (Tcl_InitStubs(interp, "9.0-", 0) == NULL) {
return TCL_ERROR;
}
| | | 1209 1210 1211 1212 1213 1214 1215 1216 1217 1218 1219 1220 1221 1222 1223 |
int
Lgen_Init(
Tcl_Interp *interp)
{
if (Tcl_InitStubs(interp, "9.0-", 0) == NULL) {
return TCL_ERROR;
}
Tcl_CreateObjCommand2(interp, "lgen", lGenObjCmd, NULL, NULL);
Tcl_PkgProvide(interp, "lgen", "1.0");
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
|
| ︙ | ︙ | |||
1253 1254 1255 1256 1257 1258 1259 |
int
Tcl_ABSListTest_Init(
Tcl_Interp *interp)
{
if (Tcl_InitStubs(interp, "9.0-", 0) == NULL) {
return TCL_ERROR;
}
| | | | 1253 1254 1255 1256 1257 1258 1259 1260 1261 1262 1263 1264 |
int
Tcl_ABSListTest_Init(
Tcl_Interp *interp)
{
if (Tcl_InitStubs(interp, "9.0-", 0) == NULL) {
return TCL_ERROR;
}
Tcl_CreateObjCommand2(interp, "lstring", lLStringObjCmd, NULL, NULL);
Tcl_CreateObjCommand2(interp, "lgen", lGenObjCmd, NULL, NULL);
Tcl_PkgProvide(interp, "abstractlisttest", "1.0.0");
return TCL_OK;
}
|
Changes to generic/tclTestObj.c.
| ︙ | ︙ | |||
33 34 35 36 37 38 39 | static int CheckIfVarUnset(Tcl_Interp *interp, Tcl_Obj **varPtr, Tcl_Size varIndex); static int GetVariableIndex(Tcl_Interp *interp, Tcl_Obj *obj, Tcl_Size *indexPtr); static void SetVarToObj(Tcl_Obj **varPtr, Tcl_Size varIndex, Tcl_Obj *objPtr); | | | | | | | | | | | | 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 |
static int CheckIfVarUnset(Tcl_Interp *interp, Tcl_Obj **varPtr,
Tcl_Size varIndex);
static int GetVariableIndex(Tcl_Interp *interp,
Tcl_Obj *obj, Tcl_Size *indexPtr);
static void SetVarToObj(Tcl_Obj **varPtr, Tcl_Size varIndex,
Tcl_Obj *objPtr);
static Tcl_ObjCmdProc2 TestbignumobjCmd;
static Tcl_ObjCmdProc2 TestbooleanobjCmd;
static Tcl_ObjCmdProc2 TestdoubleobjCmd;
static Tcl_ObjCmdProc2 TestindexobjCmd;
static Tcl_ObjCmdProc2 TestintobjCmd;
static Tcl_ObjCmdProc2 TestlistobjCmd;
static Tcl_ObjCmdProc2 TestobjCmd;
static Tcl_ObjCmdProc2 TeststringobjCmd;
static Tcl_ObjCmdProc2 TestbigdataCmd;
static Tcl_ObjCmdProc2 TestisemptyCmd;
#define VARPTR_KEY "TCLOBJTEST_VARPTR"
#define NUMBER_OF_OBJECT_VARS 20
static void
VarPtrDeleteProc(
void *clientData,
|
| ︙ | ︙ | |||
115 116 117 118 119 120 121 |
return TCL_ERROR;
}
Tcl_SetAssocData(interp, VARPTR_KEY, VarPtrDeleteProc, varPtr);
for (i = 0; i < NUMBER_OF_OBJECT_VARS; i++) {
varPtr[i] = NULL;
}
| | | | | | | | | | | | 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 |
return TCL_ERROR;
}
Tcl_SetAssocData(interp, VARPTR_KEY, VarPtrDeleteProc, varPtr);
for (i = 0; i < NUMBER_OF_OBJECT_VARS; i++) {
varPtr[i] = NULL;
}
Tcl_CreateObjCommand2(interp, "testbignumobj", TestbignumobjCmd,
NULL, NULL);
Tcl_CreateObjCommand2(interp, "testbooleanobj", TestbooleanobjCmd,
NULL, NULL);
Tcl_CreateObjCommand2(interp, "testdoubleobj", TestdoubleobjCmd,
NULL, NULL);
Tcl_CreateObjCommand2(interp, "testintobj", TestintobjCmd,
NULL, NULL);
Tcl_CreateObjCommand2(interp, "testindexobj", TestindexobjCmd,
NULL, NULL);
Tcl_CreateObjCommand2(interp, "testlistobj", TestlistobjCmd,
NULL, NULL);
Tcl_CreateObjCommand2(interp, "testobj", TestobjCmd, NULL, NULL);
Tcl_CreateObjCommand2(interp, "teststringobj", TeststringobjCmd,
NULL, NULL);
Tcl_CreateObjCommand2(interp, "testisempty", TestisemptyCmd,
NULL, NULL);
if (sizeof(Tcl_Size) == sizeof(Tcl_WideInt)) {
Tcl_CreateObjCommand2(interp, "testbigdata", TestbigdataCmd,
NULL, NULL);
}
return TCL_OK;
}
/*
*----------------------------------------------------------------------
|
| ︙ | ︙ | |||
161 162 163 164 165 166 167 |
*----------------------------------------------------------------------
*/
static int
TestbignumobjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Tcl interpreter */
| | | 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 |
*----------------------------------------------------------------------
*/
static int
TestbignumobjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Tcl interpreter */
Tcl_Size objc, /* Argument count */
Tcl_Obj *const objv[]) /* Argument vector */
{
static const char *const subcmds[] = {
"set", "get", "mult10", "div10", "iseven", "radixsize", NULL
};
enum options {
BIGNUM_SET, BIGNUM_GET, BIGNUM_MULT10, BIGNUM_DIV10, BIGNUM_ISEVEN,
|
| ︙ | ︙ | |||
360 361 362 363 364 365 366 |
*----------------------------------------------------------------------
*/
static int
TestbooleanobjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 |
*----------------------------------------------------------------------
*/
static int
TestbooleanobjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_Size varIndex;
int boolValue;
const char *subCmd;
Tcl_Obj **varPtr;
|
| ︙ | ︙ | |||
460 461 462 463 464 465 466 |
*----------------------------------------------------------------------
*/
static int
TestdoubleobjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 |
*----------------------------------------------------------------------
*/
static int
TestdoubleobjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_Size varIndex;
double doubleValue;
const char *subCmd;
Tcl_Obj **varPtr;
|
| ︙ | ︙ | |||
576 577 578 579 580 581 582 |
*----------------------------------------------------------------------
*/
static int
TestindexobjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | > | 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 |
*----------------------------------------------------------------------
*/
static int
TestindexobjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
int allowAbbrev, index, setError, result;
Tcl_Size i;
Tcl_Size index2;
const char **argv;
static const char *const tablePtr[] = {"a", "b", "check", NULL};
/*
* Keep this structure declaration in sync with tclIndexObj.c
*/
|
| ︙ | ︙ | |||
666 667 668 669 670 671 672 |
*----------------------------------------------------------------------
*/
static int
TestintobjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 667 668 669 670 671 672 673 674 675 676 677 678 679 680 681 |
*----------------------------------------------------------------------
*/
static int
TestintobjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_Size varIndex;
#if (INT_MAX != LONG_MAX) /* int is not the same size as long */
int i;
#endif
Tcl_WideInt wideValue;
|
| ︙ | ︙ | |||
894 895 896 897 898 899 900 |
*-----------------------------------------------------------------------------
*/
static int
TestlistobjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Tcl interpreter */
| | | 895 896 897 898 899 900 901 902 903 904 905 906 907 908 909 |
*-----------------------------------------------------------------------------
*/
static int
TestlistobjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Tcl interpreter */
Tcl_Size objc, /* Number of arguments */
Tcl_Obj *const objv[]) /* Argument objects */
{
/* Subcommands supported by this command */
static const char* const subcommands[] = {
"set",
"get",
"replace",
|
| ︙ | ︙ | |||
1114 1115 1116 1117 1118 1119 1120 |
TCL_OBJTYPE_V0
};
static int
TestobjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 1115 1116 1117 1118 1119 1120 1121 1122 1123 1124 1125 1126 1127 1128 1129 |
TCL_OBJTYPE_V0
};
static int
TestobjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_Size varIndex, destIndex;
int i;
const Tcl_ObjType *targetType;
Tcl_Obj **varPtr;
static const char *const subcommands[] = {
|
| ︙ | ︙ | |||
1353 1354 1355 1356 1357 1358 1359 |
*----------------------------------------------------------------------
*/
static int
TeststringobjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | | | 1354 1355 1356 1357 1358 1359 1360 1361 1362 1363 1364 1365 1366 1367 1368 1369 1370 1371 1372 1373 |
*----------------------------------------------------------------------
*/
static int
TeststringobjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_UniChar *unicode;
Tcl_Size size, varIndex, i;
int option;
Tcl_Size length;
#define MAX_STRINGS 11
const char *string, *strings[MAX_STRINGS+1];
String *strPtr;
Tcl_Obj **varPtr;
static const char *const options[] = {
"append", "appendstrings", "get", "get2", "length", "length2",
|
| ︙ | ︙ | |||
1649 1650 1651 1652 1653 1654 1655 |
* Interpreter result holds result or error message.
*
*------------------------------------------------------------------------
*/
static int
TestbigdataCmd(
TCL_UNUSED(void *),
| | | | | 1650 1651 1652 1653 1654 1655 1656 1657 1658 1659 1660 1661 1662 1663 1664 1665 1666 |
* Interpreter result holds result or error message.
*
*------------------------------------------------------------------------
*/
static int
TestbigdataCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
static const char *const subcmds[] = {
"string", "bytearray", "list", "dict", NULL
};
enum options {
BIGDATA_STRING, BIGDATA_BYTEARRAY, BIGDATA_LIST, BIGDATA_DICT
} idx;
|
| ︙ | ︙ | |||
1870 1871 1872 1873 1874 1875 1876 |
}
return 0;
}
static int
TestisemptyCmd(
TCL_UNUSED(void *),
| | | | | 1871 1872 1873 1874 1875 1876 1877 1878 1879 1880 1881 1882 1883 1884 1885 1886 1887 |
}
return 0;
}
static int
TestisemptyCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_Obj *result;
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "value");
return TCL_ERROR;
}
result = Tcl_NewIntObj(Tcl_IsEmpty(objv[1]));
|
| ︙ | ︙ |
Changes to generic/tclTestProcBodyObj.c.
| ︙ | ︙ | |||
35 36 37 38 39 40 41 |
/*
* this struct describes an entry in the table of command names and command
* procs
*/
typedef struct {
const char *cmdName; /* command name */
| | | | | | | | | 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 |
/*
* this struct describes an entry in the table of command names and command
* procs
*/
typedef struct {
const char *cmdName; /* command name */
Tcl_ObjCmdProc2 *proc; /* command proc */
int exportIt; /* if 1, export the command */
} CmdTable;
/*
* Declarations for functions defined in this file.
*/
static Tcl_ObjCmdProc2 ProcBodyTestProcObjCmd;
static Tcl_ObjCmdProc2 ProcBodyTestCheckObjCmd;
static int ProcBodyTestInitInternal(Tcl_Interp *interp, int isSafe);
static int RegisterCommand(Tcl_Interp* interp,
const char *namesp, const CmdTable *cmdTablePtr);
/*
* List of commands to create when the package is loaded; must go after the
* declarations of the enable command procedure.
*/
static const CmdTable commands[] = {
{ procCommand, ProcBodyTestProcObjCmd, 1 },
{ checkCommand, ProcBodyTestCheckObjCmd, 1 },
{ 0, 0, 0 }
};
static const CmdTable safeCommands[] = {
{ procCommand, ProcBodyTestProcObjCmd, 1 },
{ checkCommand, ProcBodyTestCheckObjCmd, 1 },
{ 0, 0, 0 }
};
/*
*----------------------------------------------------------------------
*
* Procbodytest_Init --
|
| ︙ | ︙ | |||
150 151 152 153 154 155 156 |
namesp, cmdTablePtr->cmdName);
if (Tcl_EvalEx(interp, buf, TCL_INDEX_NONE, 0) != TCL_OK) {
return TCL_ERROR;
}
}
snprintf(buf, sizeof(buf), "%s::%s", namesp, cmdTablePtr->cmdName);
| | | 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 |
namesp, cmdTablePtr->cmdName);
if (Tcl_EvalEx(interp, buf, TCL_INDEX_NONE, 0) != TCL_OK) {
return TCL_ERROR;
}
}
snprintf(buf, sizeof(buf), "%s::%s", namesp, cmdTablePtr->cmdName);
Tcl_CreateObjCommand2(interp, buf, cmdTablePtr->proc, 0, 0);
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
* ProcBodyTestInitInternal --
|
| ︙ | ︙ | |||
192 193 194 195 196 197 198 |
return Tcl_PkgProvideEx(interp, packageName, packageVersion, NULL);
}
/*
*----------------------------------------------------------------------
*
| | | 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 |
return Tcl_PkgProvideEx(interp, packageName, packageVersion, NULL);
}
/*
*----------------------------------------------------------------------
*
* ProcBodyTestProcObjCmd --
*
* Implements the "procbodytest::proc" command. Here is the command
* description:
* procbodytest::proc newName argList bodyName
* Looks up a procedure called $bodyName and, if the procedure exists,
* constructs a Tcl_Obj of type "procbody" and calls Tcl_ProcObjCmd.
* Arguments:
|
| ︙ | ︙ | |||
223 224 225 226 227 228 229 | * A new procedure is created. * Leaves an error message in the interp's result on error. * *---------------------------------------------------------------------- */ static int | | | | 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 |
* A new procedure is created.
* Leaves an error message in the interp's result on error.
*
*----------------------------------------------------------------------
*/
static int
ProcBodyTestProcObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* the current interpreter */
Tcl_Size objc, /* argument count */
Tcl_Obj *const objv[]) /* arguments */
{
const char *fullName;
Tcl_Command procCmd;
Command *cmdPtr;
Proc *procPtr = NULL;
Tcl_Obj *bodyObjPtr;
|
| ︙ | ︙ | |||
259 260 261 262 263 264 265 |
cmdPtr = (Command *) procCmd;
/*
* check that this is a procedure and not a builtin command:
* If a procedure, cmdPtr->objClientData is TclIsProc(cmdPtr).
*/
| | | | 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 |
cmdPtr = (Command *) procCmd;
/*
* check that this is a procedure and not a builtin command:
* If a procedure, cmdPtr->objClientData is TclIsProc(cmdPtr).
*/
if (cmdPtr->objClientData2 != TclIsProc(cmdPtr)) {
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
"command \"", fullName, "\" is not a Tcl procedure", (char *)NULL);
return TCL_ERROR;
}
/*
* it is a Tcl procedure: the client data is the Proc structure
*/
procPtr = (Proc *) cmdPtr->objClientData2;
if (procPtr == NULL) {
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "procedure \"",
fullName, "\" does not have a Proc struct!", (char *)NULL);
return TCL_ERROR;
}
/*
|
| ︙ | ︙ | |||
304 305 306 307 308 309 310 |
return result;
}
/*
*----------------------------------------------------------------------
*
| | | | | 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 |
return result;
}
/*
*----------------------------------------------------------------------
*
* ProcBodyTestCheckObjCmd --
*
* Implements the "procbodytest::check" command. Here is the command
* description:
* procbodytest::check
*
* Performs an internal check that the Tcl_PkgPresent() command returns
* the same version number as was registered when the tcl::procbodytest package
* was provided. Places a boolean in the interp result indicating the
* test outcome.
*
* Results:
* Returns a standard Tcl code.
*
*----------------------------------------------------------------------
*/
static int
ProcBodyTestCheckObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* the current interpreter */
Tcl_Size objc, /* argument count */
Tcl_Obj *const objv[]) /* arguments */
{
const char *version;
if (objc != 1) {
Tcl_WrongNumArgs(interp, 1, objv, "");
return TCL_ERROR;
|
| ︙ | ︙ |
Changes to generic/tclThreadTest.c.
| ︙ | ︙ | |||
117 118 119 120 121 122 123 | /* * Access to the list of threads and to the thread send results is guarded by * this mutex. */ TCL_DECLARE_MUTEX(threadMutex) | | | 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 | /* * Access to the list of threads and to the thread send results is guarded by * this mutex. */ TCL_DECLARE_MUTEX(threadMutex) static Tcl_ObjCmdProc2 ThreadObjCmd; static int ThreadCreate(Tcl_Interp *interp, const char *script, int joinable); static int ThreadList(Tcl_Interp *interp); static int ThreadSend(Tcl_Interp *interp, Tcl_ThreadId id, const char *script, int wait); static int ThreadCancel(Tcl_Interp *interp, Tcl_ThreadId id, const char *result, int flags); |
| ︙ | ︙ | |||
173 174 175 176 177 178 179 |
Tcl_MutexLock(&threadMutex);
if (mainThreadId == 0) {
mainThreadId = Tcl_GetCurrentThread();
}
Tcl_MutexUnlock(&threadMutex);
| | | | 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 |
Tcl_MutexLock(&threadMutex);
if (mainThreadId == 0) {
mainThreadId = Tcl_GetCurrentThread();
}
Tcl_MutexUnlock(&threadMutex);
Tcl_CreateObjCommand2(interp, "testthread", ThreadObjCmd, NULL, NULL);
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
* ThreadObjCmd --
*
* This procedure is invoked to process the "testthread" Tcl command. See
* the user documentation for details on what it does.
*
* thread cancel ?-unwind? id ?result?
* thread create ?-joinable? ?script?
* thread send ?-async? id script
|
| ︙ | ︙ | |||
206 207 208 209 210 211 212 | * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ static int | | | | 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 |
* Side effects:
* See the user documentation.
*
*----------------------------------------------------------------------
*/
static int
ThreadObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
static const char *const threadOptions[] = {
"cancel", "create", "event", "exit", "id",
"join", "names", "send", "wait", "errorproc",
NULL
|
| ︙ | ︙ | |||
249 250 251 252 253 254 255 |
Tcl_MutexUnlock(&threadMutex);
}
switch (option) {
case THREAD_CANCEL: {
Tcl_WideInt id;
const char *result;
| | > | 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 |
Tcl_MutexUnlock(&threadMutex);
}
switch (option) {
case THREAD_CANCEL: {
Tcl_WideInt id;
const char *result;
int flags;
Tcl_Size arg;
if ((objc < 3) || (objc > 5)) {
Tcl_WrongNumArgs(interp, 2, objv, "?-unwind? id ?result?");
return TCL_ERROR;
}
flags = 0;
arg = 2;
|
| ︙ | ︙ |
Changes to generic/tclTimer.c.
| ︙ | ︙ | |||
779 780 781 782 783 784 785 |
*----------------------------------------------------------------------
*/
int
Tcl_AfterObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 |
*----------------------------------------------------------------------
*/
int
Tcl_AfterObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_WideInt ms = 0; /* Number of milliseconds to wait */
Tcl_Time wakeup;
AfterInfo *afterPtr;
AfterAssocData *assocPtr;
Tcl_Size length;
|
| ︙ | ︙ | |||
866 867 868 869 870 871 872 | * around when wrap-around occurs. */ afterPtr->id = tsdPtr->afterId; tsdPtr->afterId += 1; Tcl_GetTime(&wakeup); wakeup.sec += ms / 1000; | | | 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 |
* around when wrap-around occurs.
*/
afterPtr->id = tsdPtr->afterId;
tsdPtr->afterId += 1;
Tcl_GetTime(&wakeup);
wakeup.sec += ms / 1000;
wakeup.usec += (long)ms % 1000 * 1000;
if (wakeup.usec > 1000000) {
wakeup.sec++;
wakeup.usec -= 1000000;
}
afterPtr->token = TclCreateAbsoluteTimerHandler(&wakeup,
AfterProc, afterPtr);
afterPtr->nextPtr = assocPtr->firstAfterPtr;
|
| ︙ | ︙ | |||
1014 1015 1016 1017 1018 1019 1020 |
Tcl_Time endTime, now;
Tcl_WideInt diff;
Tcl_GetTime(&now);
endTime = now;
endTime.sec += (ms / 1000);
| | | 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 |
Tcl_Time endTime, now;
Tcl_WideInt diff;
Tcl_GetTime(&now);
endTime = now;
endTime.sec += (ms / 1000);
endTime.usec += ((long)ms % 1000) * 1000;
if (endTime.usec >= 1000000) {
endTime.sec++;
endTime.usec -= 1000000;
}
do {
if (Tcl_AsyncReady()) {
|
| ︙ | ︙ |
Changes to generic/tclTrace.c.
| ︙ | ︙ | |||
48 49 50 51 52 53 54 |
* traces, store the level at which the step
* trace was invoked */
char *startCmd; /* Used for bookkeeping with step execution
* traces, store the command name which
* invoked step trace */
int curFlags; /* Trace flags for the current command */
int curCode; /* Return code for the current command */
| | | 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 |
* traces, store the level at which the step
* trace was invoked */
char *startCmd; /* Used for bookkeeping with step execution
* traces, store the command name which
* invoked step trace */
int curFlags; /* Trace flags for the current command */
int curCode; /* Return code for the current command */
Tcl_Size refCount; /* Used to ensure this structure is not
* deleted too early. Keeps track of how many
* pieces of code have a pointer to this
* structure. */
char command[TCLFLEXARRAY]; /* Space for Tcl command to invoke. Actual
* size will be as large as necessary to hold
* command. This field must be the last in the
* structure, so that it can be larger than 1
|
| ︙ | ︙ | |||
128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 |
Tcl_Size objc, Tcl_Obj *const objv[]);
static char * TraceVarProc(void *clientData, Tcl_Interp *interp,
const char *name1, const char *name2, int flags);
static void TraceCommandProc(void *clientData,
Tcl_Interp *interp, const char *oldName,
const char *newName, int flags);
static Tcl_CmdObjTraceProc2 TraceExecutionProc;
static int StringTraceProc(void *clientData,
Tcl_Interp *interp, Tcl_Size level,
const char *command, Tcl_Command commandInfo,
Tcl_Size objc, Tcl_Obj *const objv[]);
static void StringTraceDeleteProc(void *clientData);
static void DisposeTraceResult(int flags, char *result);
static int TraceVarEx(Tcl_Interp *interp, const char *part1,
const char *part2, VarTrace *tracePtr);
/*
* The following structure holds the client data for string-based
* trace procs
*/
typedef struct {
void *clientData; /* Client data from Tcl_CreateTrace */
Tcl_CmdTraceProc *proc; /* Trace function from Tcl_CreateTrace */
} StringTraceData;
/*
* Convenience macros for iterating over the list of traces. Note that each of
* these *must* be treated as a command, and *must* have a block following it.
*/
#define FOREACH_VAR_TRACE(interp, name, clientData) \
| > > > > | 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 |
Tcl_Size objc, Tcl_Obj *const objv[]);
static char * TraceVarProc(void *clientData, Tcl_Interp *interp,
const char *name1, const char *name2, int flags);
static void TraceCommandProc(void *clientData,
Tcl_Interp *interp, const char *oldName,
const char *newName, int flags);
static Tcl_CmdObjTraceProc2 TraceExecutionProc;
#ifndef TCL_NO_DEPRECATED
static int StringTraceProc(void *clientData,
Tcl_Interp *interp, Tcl_Size level,
const char *command, Tcl_Command commandInfo,
Tcl_Size objc, Tcl_Obj *const objv[]);
static void StringTraceDeleteProc(void *clientData);
#endif /* TCL_NO_DEPRECATED */
static void DisposeTraceResult(int flags, char *result);
static int TraceVarEx(Tcl_Interp *interp, const char *part1,
const char *part2, VarTrace *tracePtr);
/*
* The following structure holds the client data for string-based
* trace procs
*/
#ifndef TCL_NO_DEPRECATED
typedef struct {
void *clientData; /* Client data from Tcl_CreateTrace */
Tcl_CmdTraceProc *proc; /* Trace function from Tcl_CreateTrace */
} StringTraceData;
#endif /* TCL_NO_DEPRECATED */
/*
* Convenience macros for iterating over the list of traces. Note that each of
* these *must* be treated as a command, and *must* have a block following it.
*/
#define FOREACH_VAR_TRACE(interp, name, clientData) \
|
| ︙ | ︙ | |||
185 186 187 188 189 190 191 |
*----------------------------------------------------------------------
*/
int
Tcl_TraceObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 |
*----------------------------------------------------------------------
*/
int
Tcl_TraceObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
/* Main sub commands to 'trace' */
static const char *const traceOptions[] = {
"add", "info", "remove",
NULL
};
|
| ︙ | ︙ | |||
1987 1988 1989 1990 1991 1992 1993 1994 1995 1996 1997 1998 1999 2000 |
*
* When the trace is deleted, the 'delProc' function will be invoked,
* passing it the original client data.
*
*----------------------------------------------------------------------
*/
typedef struct {
Tcl_CmdObjTraceProc *proc;
Tcl_CmdObjTraceDeleteProc *delProc;
void *clientData;
} TraceWrapperInfo;
static int
| > | 1991 1992 1993 1994 1995 1996 1997 1998 1999 2000 2001 2002 2003 2004 2005 |
*
* When the trace is deleted, the 'delProc' function will be invoked,
* passing it the original client data.
*
*----------------------------------------------------------------------
*/
#ifndef TCL_NO_DEPRECATED
typedef struct {
Tcl_CmdObjTraceProc *proc;
Tcl_CmdObjTraceDeleteProc *delProc;
void *clientData;
} TraceWrapperInfo;
static int
|
| ︙ | ︙ | |||
2023 2024 2025 2026 2027 2028 2029 2030 2031 2032 2033 2034 2035 2036 2037 2038 2039 2040 2041 2042 2043 2044 2045 2046 2047 2048 2049 2050 2051 2052 2053 2054 |
clientData = info->clientData;
if (info->delProc) {
info->delProc(clientData);
}
Tcl_Free(info);
}
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 */
Tcl_CmdObjTraceDeleteProc *delProc)
/* Function to call when trace is deleted */
{
TraceWrapperInfo *info = (TraceWrapperInfo *)Tcl_Alloc(sizeof(TraceWrapperInfo));
info->proc = proc;
info->delProc = delProc;
info->clientData = clientData;
return Tcl_CreateObjTrace2(interp, level, flags,
(proc ? TraceWrapperProc : NULL),
info, TraceWrapperDelProc);
}
Tcl_Trace
Tcl_CreateObjTrace2(
Tcl_Interp *interp, /* Tcl interpreter */
Tcl_Size level, /* Maximum nesting level */
int flags, /* Flags, see above */
Tcl_CmdObjTraceProc2 *proc, /* Trace callback */
| > > | 2028 2029 2030 2031 2032 2033 2034 2035 2036 2037 2038 2039 2040 2041 2042 2043 2044 2045 2046 2047 2048 2049 2050 2051 2052 2053 2054 2055 2056 2057 2058 2059 2060 2061 |
clientData = info->clientData;
if (info->delProc) {
info->delProc(clientData);
}
Tcl_Free(info);
}
#undef Tcl_CreateObjTrace
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 */
Tcl_CmdObjTraceDeleteProc *delProc)
/* Function to call when trace is deleted */
{
TraceWrapperInfo *info = (TraceWrapperInfo *)Tcl_Alloc(sizeof(TraceWrapperInfo));
info->proc = proc;
info->delProc = delProc;
info->clientData = clientData;
return Tcl_CreateObjTrace2(interp, level, flags,
(proc ? TraceWrapperProc : NULL),
info, TraceWrapperDelProc);
}
#endif /* TCL_NO_DEPRECATED */
Tcl_Trace
Tcl_CreateObjTrace2(
Tcl_Interp *interp, /* Tcl interpreter */
Tcl_Size level, /* Maximum nesting level */
int flags, /* Flags, see above */
Tcl_CmdObjTraceProc2 *proc, /* Trace callback */
|
| ︙ | ︙ | |||
2131 2132 2133 2134 2135 2136 2137 2138 2139 2140 2141 2142 2143 2144 |
* command and the ClientData value it will receive, and argc and argv
* give the arguments to the command, after any argument parsing and
* substitution. Proc does not return a value.
*
*----------------------------------------------------------------------
*/
Tcl_Trace
Tcl_CreateTrace(
Tcl_Interp *interp, /* Interpreter in which to create trace. */
Tcl_Size level, /* Only call proc for commands at nesting
* level<=argument level (1=>top level). */
Tcl_CmdTraceProc *proc, /* Function to call before executing each
* command. */
| > | 2138 2139 2140 2141 2142 2143 2144 2145 2146 2147 2148 2149 2150 2151 2152 |
* command and the ClientData value it will receive, and argc and argv
* give the arguments to the command, after any argument parsing and
* substitution. Proc does not return a value.
*
*----------------------------------------------------------------------
*/
#ifndef TCL_NO_DEPRECATED
Tcl_Trace
Tcl_CreateTrace(
Tcl_Interp *interp, /* Interpreter in which to create trace. */
Tcl_Size level, /* Only call proc for commands at nesting
* level<=argument level (1=>top level). */
Tcl_CmdTraceProc *proc, /* Function to call before executing each
* command. */
|
| ︙ | ︙ | |||
2226 2227 2228 2229 2230 2231 2232 2233 2234 2235 2236 2237 2238 2239 |
static void
StringTraceDeleteProc(
void *clientData)
{
Tcl_Free(clientData);
}
/*
*----------------------------------------------------------------------
*
* Tcl_DeleteTrace --
*
* Remove a trace.
| > | 2234 2235 2236 2237 2238 2239 2240 2241 2242 2243 2244 2245 2246 2247 2248 |
static void
StringTraceDeleteProc(
void *clientData)
{
Tcl_Free(clientData);
}
#endif /* TCL_NO_DEPRECATED */
/*
*----------------------------------------------------------------------
*
* Tcl_DeleteTrace --
*
* Remove a trace.
|
| ︙ | ︙ |
Changes to generic/tclUtf.c.
| ︙ | ︙ | |||
1189 1190 1191 1192 1193 1194 1195 |
int
Tcl_UniCharAtIndex(
const char *src, /* The UTF-8 string to dereference. */
Tcl_Size index) /* The position of the desired character. */
{
Tcl_UniChar ch = 0;
| < | | | 1189 1190 1191 1192 1193 1194 1195 1196 1197 1198 1199 1200 1201 1202 1203 1204 1205 1206 1207 1208 1209 1210 1211 |
int
Tcl_UniCharAtIndex(
const char *src, /* The UTF-8 string to dereference. */
Tcl_Size index) /* The position of the desired character. */
{
Tcl_UniChar ch = 0;
if (index < 0) {
return -1;
}
while (index--) {
src += TclUtfToUniChar(src, &ch);
}
TclUtfToUniChar(src, &ch);
return ch;
}
/*
*---------------------------------------------------------------------------
*
* Tcl_UtfAtIndex --
*
|
| ︙ | ︙ |
Changes to generic/tclUtil.c.
| ︙ | ︙ | |||
3990 3991 3992 3993 3994 3995 3996 |
}
endValue += encoded - TCL_INDEX_END;
if (endValue >= 0) {
return endValue;
}
return TCL_INDEX_NONE;
}
| < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | 3990 3991 3992 3993 3994 3995 3996 3997 3998 3999 4000 4001 4002 4003 |
}
endValue += encoded - TCL_INDEX_END;
if (endValue >= 0) {
return endValue;
}
return TCL_INDEX_NONE;
}
/*
*----------------------------------------------------------------------
*
* ClearHash --
*
* Remove all the entries in the hash table *tablePtr.
|
| ︙ | ︙ |
Changes to generic/tclVar.c.
| ︙ | ︙ | |||
189 190 191 192 193 194 195 | /* * Forward references to functions defined later in this file: */ static void AppendLocals(Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Obj *patternPtr, int includeLinks, int justConstants); | | | | | | | | | | | | | | | | 189 190 191 192 193 194 195 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 | /* * Forward references to functions defined later in this file: */ static void AppendLocals(Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Obj *patternPtr, int includeLinks, int justConstants); static Tcl_ObjCmdProc2 ArrayAnyMoreCmd; static Tcl_ObjCmdProc2 ArrayDoneSearchCmd; static Tcl_ObjCmdProc2 ArrayNextElementCmd; static Tcl_ObjCmdProc2 ArrayStartSearchCmd; static void ArrayPopulateSearch(Tcl_Interp *interp, Tcl_Obj *arrayNameObj, Var *varPtr, ArraySearch *searchPtr); static void ArrayDoneSearch(Interp *iPtr, Var *varPtr, ArraySearch *searchPtr); static Tcl_ObjCmdProc2 ArrayExistsCmd; static Tcl_ObjCmdProc2 ArrayForObjCmd; static Tcl_NRPostProc ArrayForLoopCallback; static Tcl_ObjCmdProc2 ArrayForNRCmd; static Tcl_ObjCmdProc2 ArrayGetCmd; static Tcl_ObjCmdProc2 ArrayNamesCmd; static Tcl_ObjCmdProc2 ArraySetCmd; static Tcl_ObjCmdProc2 ArraySizeCmd; static Tcl_ObjCmdProc2 ArrayStatsCmd; static Tcl_ObjCmdProc2 ArrayUnsetCmd; static void DeleteSearches(Interp *iPtr, Var *arrayVarPtr); static void DeleteArray(Interp *iPtr, Tcl_Obj *arrayNamePtr, Var *varPtr, int flags, Tcl_Size index); static int LocateArray(Tcl_Interp *interp, Tcl_Obj *name, Var **varPtrPtr, int *isArrayPtr); static int NotArrayError(Tcl_Interp *interp, Tcl_Obj *name); static Tcl_Var ObjFindNamespaceVar(Tcl_Interp *interp, |
| ︙ | ︙ | |||
231 232 233 234 235 236 237 | Interp *iPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, int flags, Tcl_Size index); /* * TIP #508: [array default] */ | | | 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 | Interp *iPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, int flags, Tcl_Size index); /* * TIP #508: [array default] */ static Tcl_ObjCmdProc2 ArrayDefaultCmd; static void DeleteArrayVar(Var *arrayPtr); static void SetArrayDefault(Var *arrayPtr, Tcl_Obj *defaultObj); /* * Functions defined in this file that may be exported in the future for use * by the bytecode compiler and engine or to the public interface. */ |
| ︙ | ︙ | |||
1547 1548 1549 1550 1551 1552 1553 |
*----------------------------------------------------------------------
*/
int
Tcl_SetObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 1547 1548 1549 1550 1551 1552 1553 1554 1555 1556 1557 1558 1559 1560 1561 |
*----------------------------------------------------------------------
*/
int
Tcl_SetObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_Obj *varValueObj;
if (objc == 2) {
varValueObj = Tcl_ObjGetVar2(interp, objv[1], NULL,TCL_LEAVE_ERR_MSG);
if (varValueObj == NULL) {
|
| ︙ | ︙ | |||
2794 2795 2796 2797 2798 2799 2800 |
*----------------------------------------------------------------------
*/
int
Tcl_UnsetObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | | 2794 2795 2796 2797 2798 2799 2800 2801 2802 2803 2804 2805 2806 2807 2808 2809 2810 2811 |
*----------------------------------------------------------------------
*/
int
Tcl_UnsetObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_Size i;
int flags = TCL_LEAVE_ERR_MSG;
const char *name;
if (objc == 1) {
/*
* Do nothing if no arguments supplied, so as to match command
* documentation.
|
| ︙ | ︙ | |||
2862 2863 2864 2865 2866 2867 2868 |
*----------------------------------------------------------------------
*/
int
Tcl_AppendObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | | 2862 2863 2864 2865 2866 2867 2868 2869 2870 2871 2872 2873 2874 2875 2876 2877 2878 2879 2880 2881 2882 |
*----------------------------------------------------------------------
*/
int
Tcl_AppendObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Var *varPtr, *arrayPtr;
Tcl_Obj *varValuePtr = NULL;
/* Initialized to avoid compiler warning. */
Tcl_Size i;
if (objc < 2) {
Tcl_WrongNumArgs(interp, 1, objv, "varName ?value ...?");
return TCL_ERROR;
}
if (objc == 2) {
|
| ︙ | ︙ | |||
2927 2928 2929 2930 2931 2932 2933 |
*----------------------------------------------------------------------
*/
int
Tcl_LappendObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 2927 2928 2929 2930 2931 2932 2933 2934 2935 2936 2937 2938 2939 2940 2941 |
*----------------------------------------------------------------------
*/
int
Tcl_LappendObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_Obj *varValuePtr, *newValuePtr;
Tcl_Size numElems;
Var *varPtr, *arrayPtr;
int result, createdNewObj;
|
| ︙ | ︙ | |||
3133 3134 3135 3136 3137 3138 3139 |
return donerc;
}
static int
ArrayForObjCmd(
void *clientData,
Tcl_Interp *interp, /* Current interpreter. */
| | | | | 3133 3134 3135 3136 3137 3138 3139 3140 3141 3142 3143 3144 3145 3146 3147 3148 3149 3150 3151 3152 3153 3154 3155 3156 3157 |
return donerc;
}
static int
ArrayForObjCmd(
void *clientData,
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
return Tcl_NRCallObjProc2(interp, ArrayForNRCmd, clientData, objc, objv);
}
static int
ArrayForNRCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const *objv)
{
Tcl_Obj *varListObj, *arrayNameObj, *scriptObj;
ArraySearch *searchPtr = NULL;
Var *varPtr;
int isArray;
Tcl_Size numVars;
|
| ︙ | ︙ | |||
3380 3381 3382 3383 3384 3385 3386 |
*----------------------------------------------------------------------
*/
static int
ArrayStartSearchCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | 3380 3381 3382 3383 3384 3385 3386 3387 3388 3389 3390 3391 3392 3393 3394 |
*----------------------------------------------------------------------
*/
static int
ArrayStartSearchCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const objv[])
{
Var *varPtr;
int isArray;
ArraySearch *searchPtr;
if (objc != 2) {
|
| ︙ | ︙ | |||
3475 3476 3477 3478 3479 3480 3481 |
*----------------------------------------------------------------------
*/
static int
ArrayAnyMoreCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | 3475 3476 3477 3478 3479 3480 3481 3482 3483 3484 3485 3486 3487 3488 3489 |
*----------------------------------------------------------------------
*/
static int
ArrayAnyMoreCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const objv[])
{
Interp *iPtr = (Interp *) interp;
Var *varPtr;
Tcl_Obj *varNameObj, *searchObj;
int gotValue, isArray;
ArraySearch *searchPtr;
|
| ︙ | ︙ | |||
3553 3554 3555 3556 3557 3558 3559 |
*----------------------------------------------------------------------
*/
static int
ArrayNextElementCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | 3553 3554 3555 3556 3557 3558 3559 3560 3561 3562 3563 3564 3565 3566 3567 |
*----------------------------------------------------------------------
*/
static int
ArrayNextElementCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const objv[])
{
Var *varPtr;
Tcl_Obj *varNameObj, *searchObj;
ArraySearch *searchPtr;
int isArray;
|
| ︙ | ︙ | |||
3633 3634 3635 3636 3637 3638 3639 |
*----------------------------------------------------------------------
*/
static int
ArrayDoneSearchCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | 3633 3634 3635 3636 3637 3638 3639 3640 3641 3642 3643 3644 3645 3646 3647 |
*----------------------------------------------------------------------
*/
static int
ArrayDoneSearchCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const objv[])
{
Interp *iPtr = (Interp *) interp;
Var *varPtr;
Tcl_Obj *varNameObj, *searchObj;
ArraySearch *searchPtr;
int isArray;
|
| ︙ | ︙ | |||
3693 3694 3695 3696 3697 3698 3699 |
*----------------------------------------------------------------------
*/
static int
ArrayExistsCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | 3693 3694 3695 3696 3697 3698 3699 3700 3701 3702 3703 3704 3705 3706 3707 |
*----------------------------------------------------------------------
*/
static int
ArrayExistsCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const objv[])
{
Interp *iPtr = (Interp *)interp;
int isArray;
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "arrayName");
|
| ︙ | ︙ | |||
3733 3734 3735 3736 3737 3738 3739 |
*----------------------------------------------------------------------
*/
static int
ArrayGetCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | 3733 3734 3735 3736 3737 3738 3739 3740 3741 3742 3743 3744 3745 3746 3747 |
*----------------------------------------------------------------------
*/
static int
ArrayGetCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const objv[])
{
Var *varPtr, *varPtr2;
Tcl_Obj *varNameObj, *nameObj, *valueObj, *nameLstObj, *tmpResObj;
Tcl_Obj **nameObjPtr, *patternObj;
Tcl_HashSearch search;
const char *pattern;
|
| ︙ | ︙ | |||
3893 3894 3895 3896 3897 3898 3899 |
*----------------------------------------------------------------------
*/
static int
ArrayNamesCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | 3893 3894 3895 3896 3897 3898 3899 3900 3901 3902 3903 3904 3905 3906 3907 |
*----------------------------------------------------------------------
*/
static int
ArrayNamesCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const objv[])
{
static const char *const options[] = {
"-exact", "-glob", "-regexp", NULL
};
enum arrayNamesOptionsEnum {OPT_EXACT, OPT_GLOB, OPT_REGEXP} mode = OPT_GLOB;
Var *varPtr, *varPtr2;
|
| ︙ | ︙ | |||
4061 4062 4063 4064 4065 4066 4067 |
*----------------------------------------------------------------------
*/
static int
ArraySetCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | 4061 4062 4063 4064 4065 4066 4067 4068 4069 4070 4071 4072 4073 4074 4075 |
*----------------------------------------------------------------------
*/
static int
ArraySetCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const objv[])
{
Tcl_Obj *arrayNameObj;
Tcl_Obj *arrayElemObj;
Var *varPtr, *arrayPtr;
int result;
|
| ︙ | ︙ | |||
4245 4246 4247 4248 4249 4250 4251 |
*----------------------------------------------------------------------
*/
static int
ArraySizeCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | 4245 4246 4247 4248 4249 4250 4251 4252 4253 4254 4255 4256 4257 4258 4259 |
*----------------------------------------------------------------------
*/
static int
ArraySizeCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const objv[])
{
Var *varPtr;
Tcl_HashSearch search;
Var *varPtr2;
int isArray, size = 0;
|
| ︙ | ︙ | |||
4304 4305 4306 4307 4308 4309 4310 |
*----------------------------------------------------------------------
*/
static int
ArrayStatsCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | 4304 4305 4306 4307 4308 4309 4310 4311 4312 4313 4314 4315 4316 4317 4318 |
*----------------------------------------------------------------------
*/
static int
ArrayStatsCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const objv[])
{
Var *varPtr;
Tcl_Obj *varNameObj;
char *stats;
int isArray;
|
| ︙ | ︙ | |||
4358 4359 4360 4361 4362 4363 4364 |
*----------------------------------------------------------------------
*/
static int
ArrayUnsetCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | 4358 4359 4360 4361 4362 4363 4364 4365 4366 4367 4368 4369 4370 4371 4372 |
*----------------------------------------------------------------------
*/
static int
ArrayUnsetCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const objv[])
{
Var *varPtr, *varPtr2, *protectedVarPtr;
Tcl_Obj *varNameObj, *patternObj, *nameObj;
Tcl_HashSearch search;
const char *pattern;
int unsetFlags = 0; /* Should this be TCL_LEAVE_ERR_MSG? */
|
| ︙ | ︙ | |||
4597 4598 4599 4600 4601 4602 4603 |
Tcl_Interp *interp, /* Interpreter containing variables. Used for
* error messages, too. */
Var *otherPtr, /* Pointer to the variable being linked-to. */
const char *myName, /* Name of variable which will refer to
* otherP1/otherP2. Must be a scalar. */
int myFlags, /* 0, TCL_GLOBAL_ONLY or TCL_NAMESPACE_ONLY:
* indicates scope of myName. */
| | | 4597 4598 4599 4600 4601 4602 4603 4604 4605 4606 4607 4608 4609 4610 4611 |
Tcl_Interp *interp, /* Interpreter containing variables. Used for
* error messages, too. */
Var *otherPtr, /* Pointer to the variable being linked-to. */
const char *myName, /* Name of variable which will refer to
* otherP1/otherP2. Must be a scalar. */
int myFlags, /* 0, TCL_GLOBAL_ONLY or TCL_NAMESPACE_ONLY:
* indicates scope of myName. */
Tcl_Size index) /* If the variable to be linked is an indexed
* scalar, this is its index. Otherwise, -1 */
{
Tcl_Obj *myNamePtr = NULL;
int result;
if (myName) {
myNamePtr = Tcl_NewStringObj(myName, -1);
|
| ︙ | ︙ | |||
4886 4887 4888 4889 4890 4891 4892 |
*----------------------------------------------------------------------
*/
int
Tcl_ConstObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 4886 4887 4888 4889 4890 4891 4892 4893 4894 4895 4896 4897 4898 4899 4900 |
*----------------------------------------------------------------------
*/
int
Tcl_ConstObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Var *varPtr, *arrayPtr;
Tcl_Obj *part1Ptr;
if (objc != 3) {
Tcl_WrongNumArgs(interp, 1, objv, "varName value");
|
| ︙ | ︙ | |||
4961 4962 4963 4964 4965 4966 4967 |
*----------------------------------------------------------------------
*/
int
Tcl_GlobalObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | | 4961 4962 4963 4964 4965 4966 4967 4968 4969 4970 4971 4972 4973 4974 4975 4976 4977 4978 4979 4980 4981 4982 4983 |
*----------------------------------------------------------------------
*/
int
Tcl_GlobalObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Interp *iPtr = (Interp *) interp;
Tcl_Obj *objPtr, *tailPtr;
const char *varName;
const char *tail;
int result;
Tcl_Size i;
/*
* If we are not executing inside a Tcl procedure, just return.
*/
if (!HasLocalVars(iPtr->varFramePtr)) {
return TCL_OK;
|
| ︙ | ︙ | |||
5066 5067 5068 5069 5070 5071 5072 |
*----------------------------------------------------------------------
*/
int
Tcl_VariableObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | | | 5066 5067 5068 5069 5070 5071 5072 5073 5074 5075 5076 5077 5078 5079 5080 5081 5082 5083 5084 5085 5086 5087 5088 |
*----------------------------------------------------------------------
*/
int
Tcl_VariableObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Interp *iPtr = (Interp *) interp;
const char *varName, *tail, *cp;
Var *varPtr, *arrayPtr;
Tcl_Obj *varValuePtr;
Tcl_Size i;
int result;
Tcl_Obj *varNamePtr, *tailPtr;
for (i=1 ; i<objc ; i+=2) {
/*
* Look up each variable in the current namespace context, creating it
* if necessary.
*/
|
| ︙ | ︙ | |||
5200 5201 5202 5203 5204 5205 5206 |
*----------------------------------------------------------------------
*/
int
Tcl_UpvarObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 5200 5201 5202 5203 5204 5205 5206 5207 5208 5209 5210 5211 5212 5213 5214 |
*----------------------------------------------------------------------
*/
int
Tcl_UpvarObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
CallFrame *framePtr;
int result, hasLevel;
Tcl_Obj *levelObj;
if (objc < 3) {
|
| ︙ | ︙ | |||
6016 6017 6018 6019 6020 6021 6022 |
*----------------------------------------------------------------------
*/
int
TclInfoVarsCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 6016 6017 6018 6019 6020 6021 6022 6023 6024 6025 6026 6027 6028 6029 6030 |
*----------------------------------------------------------------------
*/
int
TclInfoVarsCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Interp *iPtr = (Interp *) interp;
const char *varName, *pattern, *simplePattern;
Tcl_HashSearch search;
Var *varPtr;
Namespace *nsPtr;
|
| ︙ | ︙ | |||
6167 6168 6169 6170 6171 6172 6173 |
*----------------------------------------------------------------------
*/
int
TclInfoGlobalsCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 6167 6168 6169 6170 6171 6172 6173 6174 6175 6176 6177 6178 6179 6180 6181 |
*----------------------------------------------------------------------
*/
int
TclInfoGlobalsCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
const char *varName, *pattern;
Namespace *globalNsPtr = (Namespace *) Tcl_GetGlobalNamespace(interp);
Tcl_HashSearch search;
Var *varPtr;
Tcl_Obj *listPtr, *varNamePtr, *patternPtr;
|
| ︙ | ︙ | |||
6260 6261 6262 6263 6264 6265 6266 |
*----------------------------------------------------------------------
*/
int
TclInfoLocalsCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 6260 6261 6262 6263 6264 6265 6266 6267 6268 6269 6270 6271 6272 6273 6274 |
*----------------------------------------------------------------------
*/
int
TclInfoLocalsCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Interp *iPtr = (Interp *) interp;
Tcl_Obj *patternPtr, *listPtr;
if (objc == 1) {
patternPtr = NULL;
|
| ︙ | ︙ | |||
6319 6320 6321 6322 6323 6324 6325 |
*----------------------------------------------------------------------
*/
int
TclInfoConstsCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 6319 6320 6321 6322 6323 6324 6325 6326 6327 6328 6329 6330 6331 6332 6333 |
*----------------------------------------------------------------------
*/
int
TclInfoConstsCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Interp *iPtr = (Interp *) interp;
const char *varName, *pattern, *simplePattern;
Tcl_HashSearch search;
Var *varPtr;
Namespace *nsPtr;
|
| ︙ | ︙ | |||
6718 6719 6720 6721 6722 6723 6724 |
*----------------------------------------------------------------------
*/
int
TclInfoConstantCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 6718 6719 6720 6721 6722 6723 6724 6725 6726 6727 6728 6729 6730 6731 6732 |
*----------------------------------------------------------------------
*/
int
TclInfoConstantCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Var *varPtr, *arrayPtr;
int result;
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "varName");
|
| ︙ | ︙ | |||
6847 6848 6849 6850 6851 6852 6853 |
*----------------------------------------------------------------------
*/
static int
ArrayDefaultCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 6847 6848 6849 6850 6851 6852 6853 6854 6855 6856 6857 6858 6859 6860 6861 |
*----------------------------------------------------------------------
*/
static int
ArrayDefaultCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
static const char *const options[] = {
"get", "set", "exists", "unset", NULL
};
enum arrayDefaultOptionsEnum { OPT_GET, OPT_SET, OPT_EXISTS, OPT_UNSET } option;
Tcl_Obj *arrayNameObj, *defaultValueObj;
|
| ︙ | ︙ |
Changes to generic/tclZipfs.c.
| ︙ | ︙ | |||
474 475 476 477 478 479 480 | int mask); static int ZipChannelWrite(void *instanceData, const char *buf, int toWrite, int *errloc); static int TclZipfsInitEncodingDirs(void); static int TclZipfsMountExe(void); static int TclZipfsMountShlib(void); | | | | | | | | | | | | | | | 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 |
int mask);
static int ZipChannelWrite(void *instanceData,
const char *buf, int toWrite, int *errloc);
static int TclZipfsInitEncodingDirs(void);
static int TclZipfsMountExe(void);
static int TclZipfsMountShlib(void);
static Tcl_ObjCmdProc2 ZipFSMkImgObjCmd;
static Tcl_ObjCmdProc2 ZipFSMkZipObjCmd;
static Tcl_ObjCmdProc2 ZipFSLMkImgObjCmd;
static Tcl_ObjCmdProc2 ZipFSLMkZipObjCmd;
static Tcl_ObjCmdProc2 ZipFSMountObjCmd;
static Tcl_ObjCmdProc2 ZipFSMountBufferObjCmd;
static Tcl_ObjCmdProc2 ZipFSUnmountObjCmd;
static Tcl_ObjCmdProc2 ZipFSMkKeyObjCmd;
static Tcl_ObjCmdProc2 ZipFSExistsObjCmd;
static Tcl_ObjCmdProc2 ZipFSInfoObjCmd;
static Tcl_ObjCmdProc2 ZipFSListObjCmd;
static Tcl_ObjCmdProc2 ZipFSCanonicalObjCmd;
static Tcl_ObjCmdProc2 ZipFSRootObjCmd;
/*
* Define the ZIP filesystem dispatch table.
*/
static const Tcl_Filesystem zipfsFilesystem = {
"zipfs",
|
| ︙ | ︙ | |||
2690 2691 2692 2693 2694 2695 2696 |
*-------------------------------------------------------------------------
*/
static int
ZipFSMountObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 2690 2691 2692 2693 2694 2695 2696 2697 2698 2699 2700 2701 2702 2703 2704 |
*-------------------------------------------------------------------------
*/
static int
ZipFSMountObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
const char *mountPoint = NULL, *zipFile = NULL, *password = NULL;
int result;
if (objc > 4) {
Tcl_WrongNumArgs(interp, 1, objv, "?zipfile? ?mountpoint? ?password?");
|
| ︙ | ︙ | |||
2741 2742 2743 2744 2745 2746 2747 |
*-------------------------------------------------------------------------
*/
static int
ZipFSMountBufferObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 2741 2742 2743 2744 2745 2746 2747 2748 2749 2750 2751 2752 2753 2754 2755 |
*-------------------------------------------------------------------------
*/
static int
ZipFSMountBufferObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
const char *mountPoint = NULL; /* Mount point path. */
unsigned char *data = NULL;
Tcl_Size length;
if (objc != 3) {
|
| ︙ | ︙ | |||
2780 2781 2782 2783 2784 2785 2786 |
*-------------------------------------------------------------------------
*/
static int
ZipFSRootObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 2780 2781 2782 2783 2784 2785 2786 2787 2788 2789 2790 2791 2792 2793 2794 |
*-------------------------------------------------------------------------
*/
static int
ZipFSRootObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc,
Tcl_Obj *const *objv)
{
if (objc != 1) {
Tcl_WrongNumArgs(interp, 1, objv, "");
return TCL_ERROR;
}
Tcl_SetObjResult(interp, Tcl_NewStringObj(ZIPFS_VOLUME, -1));
|
| ︙ | ︙ | |||
2811 2812 2813 2814 2815 2816 2817 |
*-------------------------------------------------------------------------
*/
static int
ZipFSUnmountObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 2811 2812 2813 2814 2815 2816 2817 2818 2819 2820 2821 2822 2823 2824 2825 |
*-------------------------------------------------------------------------
*/
static int
ZipFSUnmountObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "mountpoint");
return TCL_ERROR;
}
return TclZipfs_Unmount(interp, TclGetString(objv[1]));
|
| ︙ | ︙ | |||
2842 2843 2844 2845 2846 2847 2848 |
*-------------------------------------------------------------------------
*/
static int
ZipFSMkKeyObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 2842 2843 2844 2845 2846 2847 2848 2849 2850 2851 2852 2853 2854 2855 2856 |
*-------------------------------------------------------------------------
*/
static int
ZipFSMkKeyObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_Size len, i = 0;
const char *pw;
Tcl_Obj *passObj;
unsigned char *passBuf;
|
| ︙ | ︙ | |||
3941 3942 3943 3944 3945 3946 3947 |
*-------------------------------------------------------------------------
*/
static int
ZipFSMkZipObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 3941 3942 3943 3944 3945 3946 3947 3948 3949 3950 3951 3952 3953 3954 3955 |
*-------------------------------------------------------------------------
*/
static int
ZipFSMkZipObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_Obj *stripPrefix, *password;
if (objc < 3 || objc > 5) {
Tcl_WrongNumArgs(interp, 1, objv, "outfile indir ?strip? ?password?");
return TCL_ERROR;
|
| ︙ | ︙ | |||
3966 3967 3968 3969 3970 3971 3972 |
stripPrefix, password);
}
static int
ZipFSLMkZipObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 3966 3967 3968 3969 3970 3971 3972 3973 3974 3975 3976 3977 3978 3979 3980 |
stripPrefix, password);
}
static int
ZipFSLMkZipObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_Obj *password;
if (objc < 3 || objc > 4) {
Tcl_WrongNumArgs(interp, 1, objv, "outfile inlist ?password?");
return TCL_ERROR;
|
| ︙ | ︙ | |||
4007 4008 4009 4010 4011 4012 4013 |
*-------------------------------------------------------------------------
*/
static int
ZipFSMkImgObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 4007 4008 4009 4010 4011 4012 4013 4014 4015 4016 4017 4018 4019 4020 4021 |
*-------------------------------------------------------------------------
*/
static int
ZipFSMkImgObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_Obj *originFile, *stripPrefix, *password;
if (objc < 3 || objc > 6) {
Tcl_WrongNumArgs(interp, 1, objv,
"outfile indir ?strip? ?password? ?infile?");
|
| ︙ | ︙ | |||
4034 4035 4036 4037 4038 4039 4040 |
originFile, stripPrefix, password);
}
static int
ZipFSLMkImgObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 4034 4035 4036 4037 4038 4039 4040 4041 4042 4043 4044 4045 4046 4047 4048 |
originFile, stripPrefix, password);
}
static int
ZipFSLMkImgObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_Obj *originFile, *password;
if (objc < 3 || objc > 5) {
Tcl_WrongNumArgs(interp, 1, objv, "outfile inlist ?password? ?infile?");
return TCL_ERROR;
|
| ︙ | ︙ | |||
4076 4077 4078 4079 4080 4081 4082 |
*-------------------------------------------------------------------------
*/
static int
ZipFSCanonicalObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 4076 4077 4078 4079 4080 4081 4082 4083 4084 4085 4086 4087 4088 4089 4090 |
*-------------------------------------------------------------------------
*/
static int
ZipFSCanonicalObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
const char *mntPoint = NULL;
Tcl_DString dsPath, dsMount;
if (objc < 2 || objc > 3) {
Tcl_WrongNumArgs(interp, 1, objv, "?mountpoint? filename");
|
| ︙ | ︙ | |||
4126 4127 4128 4129 4130 4131 4132 |
*-------------------------------------------------------------------------
*/
static int
ZipFSExistsObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 4126 4127 4128 4129 4130 4131 4132 4133 4134 4135 4136 4137 4138 4139 4140 |
*-------------------------------------------------------------------------
*/
static int
ZipFSExistsObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
char *filename;
int exists;
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "filename");
|
| ︙ | ︙ | |||
4175 4176 4177 4178 4179 4180 4181 |
*-------------------------------------------------------------------------
*/
static int
ZipFSInfoObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 4175 4176 4177 4178 4179 4180 4181 4182 4183 4184 4185 4186 4187 4188 4189 |
*-------------------------------------------------------------------------
*/
static int
ZipFSInfoObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
char *filename;
ZipEntry *z;
int ret;
if (objc != 2) {
|
| ︙ | ︙ | |||
4235 4236 4237 4238 4239 4240 4241 |
*-------------------------------------------------------------------------
*/
static int
ZipFSListObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 4235 4236 4237 4238 4239 4240 4241 4242 4243 4244 4245 4246 4247 4248 4249 |
*-------------------------------------------------------------------------
*/
static int
ZipFSListObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
char *pattern = NULL;
Tcl_RegExp regexp = NULL;
Tcl_HashEntry *hPtr;
Tcl_HashSearch search;
Tcl_Obj *result = Tcl_GetObjResult(interp);
|
| ︙ | ︙ | |||
4556 4557 4558 4559 4560 4561 4562 |
*-------------------------------------------------------------------------
*/
static int
ZipFSTclLibraryObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 4556 4557 4558 4559 4560 4561 4562 4563 4564 4565 4566 4567 4568 4569 4570 |
*-------------------------------------------------------------------------
*/
static int
ZipFSTclLibraryObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
TCL_UNUSED(Tcl_Size) /*objc*/,
TCL_UNUSED(Tcl_Obj *const *)) /*objv*/
{
if (!Tcl_IsSafe(interp)) {
Tcl_Obj *pResult = TclZipfs_TclLibrary();
if (!pResult) {
TclNewObj(pResult);
|
| ︙ | ︙ | |||
6474 6475 6476 6477 6478 6479 6480 |
Tcl_EvalEx(interp, findproc, TCL_INDEX_NONE, TCL_EVAL_GLOBAL);
if (!Tcl_IsSafe(interp)) {
Tcl_LinkVar(interp, "::tcl::zipfs::wrmax", (char *) &ZipFS.wrmax,
TCL_LINK_INT);
Tcl_LinkVar(interp, "::tcl::zipfs::fallbackEntryEncoding",
(char *) &ZipFS.fallbackEntryEncoding, TCL_LINK_STRING);
}
| | | 6474 6475 6476 6477 6478 6479 6480 6481 6482 6483 6484 6485 6486 6487 6488 |
Tcl_EvalEx(interp, findproc, TCL_INDEX_NONE, TCL_EVAL_GLOBAL);
if (!Tcl_IsSafe(interp)) {
Tcl_LinkVar(interp, "::tcl::zipfs::wrmax", (char *) &ZipFS.wrmax,
TCL_LINK_INT);
Tcl_LinkVar(interp, "::tcl::zipfs::fallbackEntryEncoding",
(char *) &ZipFS.fallbackEntryEncoding, TCL_LINK_STRING);
}
Tcl_CreateObjCommand2(interp, "::tcl::zipfs::tcl_library_init",
ZipFSTclLibraryObjCmd, NULL, NULL);
}
return TCL_OK;
}
/*
*------------------------------------------------------------------------
|
| ︙ | ︙ |
Changes to generic/tclZlib.c.
| ︙ | ︙ | |||
169 170 171 172 173 174 175 | static Tcl_DriverGetHandleProc ZlibTransformGetHandle; static Tcl_DriverGetOptionProc ZlibTransformGetOption; static Tcl_DriverHandlerProc ZlibTransformEventHandler; static Tcl_DriverInputProc ZlibTransformInput; static Tcl_DriverOutputProc ZlibTransformOutput; static Tcl_DriverSetOptionProc ZlibTransformSetOption; static Tcl_DriverWatchProc ZlibTransformWatch; | | | | | | | | | | | | | | | | 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 | static Tcl_DriverGetHandleProc ZlibTransformGetHandle; static Tcl_DriverGetOptionProc ZlibTransformGetOption; static Tcl_DriverHandlerProc ZlibTransformEventHandler; static Tcl_DriverInputProc ZlibTransformInput; static Tcl_DriverOutputProc ZlibTransformOutput; static Tcl_DriverSetOptionProc ZlibTransformSetOption; static Tcl_DriverWatchProc ZlibTransformWatch; static Tcl_ObjCmdProc2 ZlibAdler32Cmd; static Tcl_ObjCmdProc2 ZlibCompressCmd; static Tcl_ObjCmdProc2 ZlibCRC32Cmd; static Tcl_ObjCmdProc2 ZlibDecompressCmd; static Tcl_ObjCmdProc2 ZlibDeflateCmd; static Tcl_ObjCmdProc2 ZlibGunzipCmd; static Tcl_ObjCmdProc2 ZlibGzipCmd; static Tcl_ObjCmdProc2 ZlibInflateCmd; static Tcl_ObjCmdProc2 ZlibPushCmd; static Tcl_ObjCmdProc2 ZlibStreamCmd; static Tcl_ObjCmdProc2 ZlibStreamImplCmd; static Tcl_ObjCmdProc2 ZlibStreamAddCmd; static Tcl_ObjCmdProc2 ZlibStreamHeaderCmd; static Tcl_ObjCmdProc2 ZlibStreamPutCmd; static void ConvertError(Tcl_Interp *interp, int code, uLong adler); static Tcl_Obj * ConvertErrorToList(int code, uLong adler); static inline int Deflate(z_streamp strm, void *bufferPtr, size_t bufferSize, int flush, size_t *writtenPtr); static void ExtractHeader(gz_header *headerPtr, Tcl_Obj *dictObj); |
| ︙ | ︙ | |||
858 859 860 861 862 863 864 | } Tcl_ResetResult(interp); /* * Create the command. */ | | | 858 859 860 861 862 863 864 865 866 867 868 869 870 871 872 |
}
Tcl_ResetResult(interp);
/*
* Create the command.
*/
zshPtr->cmd = Tcl_CreateObjCommand2(interp, Tcl_DStringValue(&cmdname),
ZlibStreamImplCmd, zshPtr, ZlibStreamCmdDelete);
Tcl_DStringFree(&cmdname);
if (zshPtr->cmd == NULL) {
goto error;
}
} else {
zshPtr->cmd = NULL;
|
| ︙ | ︙ | |||
2062 2063 2064 2065 2066 2067 2068 |
*
*----------------------------------------------------------------------
*/
static int
ZlibAdler32Cmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | 2062 2063 2064 2065 2066 2067 2068 2069 2070 2071 2072 2073 2074 2075 2076 |
*
*----------------------------------------------------------------------
*/
static int
ZlibAdler32Cmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const objv[])
{
Tcl_Size dlen = 0;
const unsigned char *data;
unsigned int start;
if (objc < 1 || objc > 3) {
|
| ︙ | ︙ | |||
2100 2101 2102 2103 2104 2105 2106 |
*
*----------------------------------------------------------------------
*/
static int
ZlibCRC32Cmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | 2100 2101 2102 2103 2104 2105 2106 2107 2108 2109 2110 2111 2112 2113 2114 |
*
*----------------------------------------------------------------------
*/
static int
ZlibCRC32Cmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const objv[])
{
Tcl_Size dlen = 0;
const unsigned char *data;
unsigned int start;
if (objc < 1 || objc > 3) {
|
| ︙ | ︙ | |||
2138 2139 2140 2141 2142 2143 2144 |
*
*----------------------------------------------------------------------
*/
static int
ZlibDeflateCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | 2138 2139 2140 2141 2142 2143 2144 2145 2146 2147 2148 2149 2150 2151 2152 |
*
*----------------------------------------------------------------------
*/
static int
ZlibDeflateCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const objv[])
{
int level;
if (objc < 2 || objc > 3) {
Tcl_WrongNumArgs(interp, 1, objv, "data ?level?");
return TCL_ERROR;
|
| ︙ | ︙ | |||
2166 2167 2168 2169 2170 2171 2172 |
*
*----------------------------------------------------------------------
*/
static int
ZlibCompressCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | 2166 2167 2168 2169 2170 2171 2172 2173 2174 2175 2176 2177 2178 2179 2180 |
*
*----------------------------------------------------------------------
*/
static int
ZlibCompressCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const objv[])
{
int level;
if (objc < 2 || objc > 3) {
Tcl_WrongNumArgs(interp, 1, objv, "data ?level?");
return TCL_ERROR;
|
| ︙ | ︙ | |||
2194 2195 2196 2197 2198 2199 2200 |
*
*----------------------------------------------------------------------
*/
static int
ZlibGzipCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | 2194 2195 2196 2197 2198 2199 2200 2201 2202 2203 2204 2205 2206 2207 2208 |
*
*----------------------------------------------------------------------
*/
static int
ZlibGzipCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const objv[])
{
static const char *const gzipopts[] = {
"-header", "-level", NULL
};
Tcl_Obj *headerDictObj = NULL;
int level = Z_DEFAULT_COMPRESSION, i, option;
|
| ︙ | ︙ | |||
2257 2258 2259 2260 2261 2262 2263 |
*
*----------------------------------------------------------------------
*/
static int
ZlibInflateCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | 2257 2258 2259 2260 2261 2262 2263 2264 2265 2266 2267 2268 2269 2270 2271 |
*
*----------------------------------------------------------------------
*/
static int
ZlibInflateCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const objv[])
{
size_t buffersize = 0;
if (objc < 2 || objc > 3) {
Tcl_WrongNumArgs(interp, 1, objv, "data ?bufferSize?");
return TCL_ERROR;
}
|
| ︙ | ︙ | |||
2284 2285 2286 2287 2288 2289 2290 |
*
*----------------------------------------------------------------------
*/
static int
ZlibDecompressCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | 2284 2285 2286 2287 2288 2289 2290 2291 2292 2293 2294 2295 2296 2297 2298 |
*
*----------------------------------------------------------------------
*/
static int
ZlibDecompressCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const objv[])
{
size_t buffersize = 0;
if (objc < 2 || objc > 3) {
Tcl_WrongNumArgs(interp, 1, objv, "data ?bufferSize?");
return TCL_ERROR;
}
|
| ︙ | ︙ | |||
2311 2312 2313 2314 2315 2316 2317 |
*
*----------------------------------------------------------------------
*/
static int
ZlibGunzipCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | 2311 2312 2313 2314 2315 2316 2317 2318 2319 2320 2321 2322 2323 2324 2325 |
*
*----------------------------------------------------------------------
*/
static int
ZlibGunzipCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const objv[])
{
static const char *const gunzipopts[] = {
"-buffersize", "-headerVar", NULL
};
Tcl_Obj *headerVarObj = NULL, *headerDictObj = NULL;
size_t buffersize = 0;
|
| ︙ | ︙ | |||
2374 2375 2376 2377 2378 2379 2380 |
*
*----------------------------------------------------------------------
*/
static int
ZlibStreamCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | 2374 2375 2376 2377 2378 2379 2380 2381 2382 2383 2384 2385 2386 2387 2388 |
*
*----------------------------------------------------------------------
*/
static int
ZlibStreamCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const objv[])
{
static const char *const stream_formats[] = {
"compress", "decompress", "deflate", "gunzip", "gzip", "inflate",
NULL
};
enum zlibFormats {
|
| ︙ | ︙ | |||
2528 2529 2530 2531 2532 2533 2534 |
*
*----------------------------------------------------------------------
*/
static int
ZlibPushCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | 2528 2529 2530 2531 2532 2533 2534 2535 2536 2537 2538 2539 2540 2541 2542 |
*
*----------------------------------------------------------------------
*/
static int
ZlibPushCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const objv[])
{
static const char *const stream_formats[] = {
"compress", "decompress", "deflate", "gunzip", "gzip", "inflate",
NULL
};
enum zlibFormats {
|
| ︙ | ︙ | |||
2704 2705 2706 2707 2708 2709 2710 |
*
*----------------------------------------------------------------------
*/
static int
ZlibStreamImplCmd(
void *clientData,
Tcl_Interp *interp,
| | | 2704 2705 2706 2707 2708 2709 2710 2711 2712 2713 2714 2715 2716 2717 2718 |
*
*----------------------------------------------------------------------
*/
static int
ZlibStreamImplCmd(
void *clientData,
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const objv[])
{
Tcl_ZlibStream zstream = (Tcl_ZlibStream) clientData;
int count, code;
Tcl_Obj *obj;
static const char *const cmds[] = {
"add", "checksum", "close", "eof", "finalize", "flush",
|
| ︙ | ︙ | |||
2830 2831 2832 2833 2834 2835 2836 |
}
}
static int
ZlibStreamAddCmd(
void *clientData,
Tcl_Interp *interp,
| | | 2830 2831 2832 2833 2834 2835 2836 2837 2838 2839 2840 2841 2842 2843 2844 |
}
}
static int
ZlibStreamAddCmd(
void *clientData,
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const objv[])
{
Tcl_ZlibStream zstream = (Tcl_ZlibStream) clientData;
int code, buffersize = -1, flush = -1, i;
Tcl_Obj *obj, *compDictObj = NULL;
static const char *const add_options[] = {
"-buffer", "-dictionary", "-finalize", "-flush", "-fullflush", NULL
|
| ︙ | ︙ | |||
2959 2960 2961 2962 2963 2964 2965 |
return code;
}
static int
ZlibStreamPutCmd(
void *clientData,
Tcl_Interp *interp,
| | | 2959 2960 2961 2962 2963 2964 2965 2966 2967 2968 2969 2970 2971 2972 2973 |
return code;
}
static int
ZlibStreamPutCmd(
void *clientData,
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const objv[])
{
Tcl_ZlibStream zstream = (Tcl_ZlibStream) clientData;
int flush = -1, i;
Tcl_Obj *compDictObj = NULL;
static const char *const put_options[] = {
"-dictionary", "-finalize", "-flush", "-fullflush", NULL
|
| ︙ | ︙ | |||
3052 3053 3054 3055 3056 3057 3058 |
return Tcl_ZlibStreamPut(zstream, objv[objc - 1], flush);
}
static int
ZlibStreamHeaderCmd(
void *clientData,
Tcl_Interp *interp,
| | | 3052 3053 3054 3055 3056 3057 3058 3059 3060 3061 3062 3063 3064 3065 3066 |
return Tcl_ZlibStreamPut(zstream, objv[objc - 1], flush);
}
static int
ZlibStreamHeaderCmd(
void *clientData,
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const objv[])
{
ZlibStreamHandle *zshPtr = (ZlibStreamHandle *) clientData;
Tcl_Obj *resultObj;
if (objc != 2) {
Tcl_WrongNumArgs(interp, 2, objv, NULL);
|
| ︙ | ︙ |
Changes to tests/cmdInfo.test.
| ︙ | ︙ | |||
23 24 25 26 27 28 29 |
testConstraint testcmdinfo [llength [info commands testcmdinfo]]
testConstraint testcmdtoken [llength [info commands testcmdtoken]]
test cmdinfo-1.1 {command procedure and clientData} {testcmdinfo} {
testcmdinfo create x1
testcmdinfo get x1
| | | 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 |
testConstraint testcmdinfo [llength [info commands testcmdinfo]]
testConstraint testcmdtoken [llength [info commands testcmdtoken]]
test cmdinfo-1.1 {command procedure and clientData} {testcmdinfo} {
testcmdinfo create x1
testcmdinfo get x1
} {CmdProc1 original CmdDelProc1 original :: nativeObjectProc2}
test cmdinfo-1.2 {command procedure and clientData} {testcmdinfo} {
testcmdinfo create x1
x1
} {CmdProc1 original}
test cmdinfo-1.3 {command procedure and clientData} {testcmdinfo} {
testcmdinfo create x1
testcmdinfo modify x1
|
| ︙ | ︙ |
Changes to tests/icuUcmTests.tcl.
1 2 3 4 | # This file is automatically generated by ucm2tests.tcl. # Edits will be overwritten on next generation. # | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 |
# This file is automatically generated by ucm2tests.tcl.
# Edits will be overwritten on next generation.
#
# Generates tests comparing Tcl encodings to ICU.
# The generated file is NOT standalone. It should be sourced into a test script.
proc ucmConvertfromMismatches {enc map} {
set mismatches {}
foreach {unihex hex} $map {
set unihex [string range 00000000$unihex end-7 end]; # Make 8 digits
set unich [subst "\\U$unihex"]
if {[encoding convertfrom -profile strict $enc [binary decode hex $hex]] ne $unich} {
|
| ︙ | ︙ |
Changes to tools/tsdPerf.c.
1 2 3 4 5 6 7 8 9 10 11 12 |
#include <tcl.h>
extern DLLEXPORT Tcl_LibraryInitProc Tsdperf_Init;
static Tcl_ThreadDataKey key;
typedef struct {
Tcl_WideInt value;
} TsdPerf;
static int
| | | | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 |
#include <tcl.h>
extern DLLEXPORT Tcl_LibraryInitProc Tsdperf_Init;
static Tcl_ThreadDataKey key;
typedef struct {
Tcl_WideInt value;
} TsdPerf;
static int
tsdPerfSetObjCmd(void *cdata, Tcl_Interp *interp, Tcl_Size objc, Tcl_Obj *const *objv) {
TsdPerf *perf = Tcl_GetThreadData(&key, sizeof(TsdPerf));
Tcl_WideInt i;
if (2 != objc) {
Tcl_WrongNumArgs(interp, 1, objv, "value");
return TCL_ERROR;
}
if (TCL_OK != Tcl_GetWideIntFromObj(interp, objv[1], &i)) {
return TCL_ERROR;
}
perf->value = i;
return TCL_OK;
}
static int
tsdPerfGetObjCmd(void *cdata, Tcl_Interp *interp, Tcl_Size objc, Tcl_Obj *const *objv) {
TsdPerf *perf = Tcl_GetThreadData(&key, sizeof(TsdPerf));
Tcl_SetObjResult(interp, Tcl_NewWideIntObj(perf->value));
return TCL_OK;
}
int
Tsdperf_Init(Tcl_Interp *interp) {
if (Tcl_InitStubs(interp, "9.0-", 0) == NULL) {
return TCL_ERROR;
}
Tcl_CreateObjCommand2(interp, "tsdPerfSet", tsdPerfSetObjCmd, NULL, NULL);
Tcl_CreateObjCommand2(interp, "tsdPerfGet", tsdPerfGetObjCmd, NULL, NULL);
return TCL_OK;
}
/*
* Local Variables:
* mode: c
* c-basic-offset: 4
* fill-column: 78
* End:
*/
|
Changes to unix/dltest/pkga.c.
| ︙ | ︙ | |||
31 32 33 34 35 36 37 |
*----------------------------------------------------------------------
*/
static int
Pkga_EqObjCmd(
void *dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
| | | 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 |
*----------------------------------------------------------------------
*/
static int
Pkga_EqObjCmd(
void *dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
int result;
const char *str1, *str2;
Tcl_Size len1, len2;
(void)dummy;
|
| ︙ | ︙ | |||
78 79 80 81 82 83 84 |
*----------------------------------------------------------------------
*/
static int
Pkga_QuoteObjCmd(
void *dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
| | | 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 |
*----------------------------------------------------------------------
*/
static int
Pkga_QuoteObjCmd(
void *dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument strings. */
{
(void)dummy;
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "value");
return TCL_ERROR;
|
| ︙ | ︙ | |||
122 123 124 125 126 127 128 |
if (Tcl_InitStubs(interp, "8.5-", 0) == NULL) {
return TCL_ERROR;
}
code = Tcl_PkgProvide(interp, "pkga", "1.0");
if (code != TCL_OK) {
return code;
}
| | | | 122 123 124 125 126 127 128 129 130 131 132 133 |
if (Tcl_InitStubs(interp, "8.5-", 0) == NULL) {
return TCL_ERROR;
}
code = Tcl_PkgProvide(interp, "pkga", "1.0");
if (code != TCL_OK) {
return code;
}
Tcl_CreateObjCommand2(interp, "pkga_eq", Pkga_EqObjCmd, NULL, NULL);
Tcl_CreateObjCommand2(interp, "pkga_quote", Pkga_QuoteObjCmd, NULL,
NULL);
return TCL_OK;
}
|
Changes to unix/dltest/pkgb.c.
| ︙ | ︙ | |||
34 35 36 37 38 39 40 |
*----------------------------------------------------------------------
*/
static int
Pkgb_SubObjCmd(
void *dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
| | | 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 |
*----------------------------------------------------------------------
*/
static int
Pkgb_SubObjCmd(
void *dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
int first, second;
(void)dummy;
if (objc != 3) {
Tcl_WrongNumArgs(interp, 1, objv, "num num");
|
| ︙ | ︙ | |||
76 77 78 79 80 81 82 |
*----------------------------------------------------------------------
*/
static int
Pkgb_UnsafeObjCmd(
void *dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
| | | | 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 |
*----------------------------------------------------------------------
*/
static int
Pkgb_UnsafeObjCmd(
void *dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
(void)dummy;
(void)objc;
(void)objv;
return Tcl_EvalEx(interp, "list unsafe command invoked", TCL_INDEX_NONE, TCL_EVAL_GLOBAL);
}
static int
Pkgb_DemoObjCmd(
void *dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_WideInt numChars;
int result;
(void)dummy;
if (objc != 4) {
|
| ︙ | ︙ | |||
140 141 142 143 144 145 146 |
if (Tcl_InitStubs(interp, "8.5-", 0) == NULL) {
return TCL_ERROR;
}
code = Tcl_PkgProvide(interp, "pkgb", "2.3");
if (code != TCL_OK) {
return code;
}
| | | | | 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 |
if (Tcl_InitStubs(interp, "8.5-", 0) == NULL) {
return TCL_ERROR;
}
code = Tcl_PkgProvide(interp, "pkgb", "2.3");
if (code != TCL_OK) {
return code;
}
Tcl_CreateObjCommand2(interp, "pkgb_sub", Pkgb_SubObjCmd, NULL, NULL);
Tcl_CreateObjCommand2(interp, "pkgb_unsafe", Pkgb_UnsafeObjCmd, NULL, NULL);
Tcl_CreateObjCommand2(interp, "pkgb_demo", Pkgb_DemoObjCmd, NULL, NULL);
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
* Pkgb_SafeInit --
|
| ︙ | ︙ | |||
177 178 179 180 181 182 183 |
if (Tcl_InitStubs(interp, "8.5-", 0) == NULL) {
return TCL_ERROR;
}
code = Tcl_PkgProvide(interp, "pkgb", "2.3");
if (code != TCL_OK) {
return code;
}
| | | 177 178 179 180 181 182 183 184 185 186 |
if (Tcl_InitStubs(interp, "8.5-", 0) == NULL) {
return TCL_ERROR;
}
code = Tcl_PkgProvide(interp, "pkgb", "2.3");
if (code != TCL_OK) {
return code;
}
Tcl_CreateObjCommand2(interp, "pkgb_sub", Pkgb_SubObjCmd, NULL, NULL);
return TCL_OK;
}
|
Changes to unix/dltest/pkgc.c.
| ︙ | ︙ | |||
31 32 33 34 35 36 37 |
*----------------------------------------------------------------------
*/
static int
Pkgc_SubObjCmd(
void *dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
| | | 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 |
*----------------------------------------------------------------------
*/
static int
Pkgc_SubObjCmd(
void *dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
int first, second;
(void)dummy;
if (objc != 3) {
Tcl_WrongNumArgs(interp, 1, objv, "num num");
|
| ︙ | ︙ | |||
70 71 72 73 74 75 76 |
*----------------------------------------------------------------------
*/
static int
Pkgc_UnsafeObjCmd(
void *dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
| | | 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 |
*----------------------------------------------------------------------
*/
static int
Pkgc_UnsafeObjCmd(
void *dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
(void)dummy;
(void)objc;
(void)objv;
Tcl_SetObjResult(interp, Tcl_NewStringObj("unsafe command invoked", TCL_INDEX_NONE));
|
| ︙ | ︙ | |||
112 113 114 115 116 117 118 |
if (Tcl_InitStubs(interp, "8.5-", 0) == NULL) {
return TCL_ERROR;
}
code = Tcl_PkgProvide(interp, "pkgc", "1.7.2");
if (code != TCL_OK) {
return code;
}
| | | | 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 |
if (Tcl_InitStubs(interp, "8.5-", 0) == NULL) {
return TCL_ERROR;
}
code = Tcl_PkgProvide(interp, "pkgc", "1.7.2");
if (code != TCL_OK) {
return code;
}
Tcl_CreateObjCommand2(interp, "pkgc_sub", Pkgc_SubObjCmd, NULL, NULL);
Tcl_CreateObjCommand2(interp, "pkgc_unsafe", Pkgc_UnsafeObjCmd, NULL,
NULL);
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
|
| ︙ | ︙ | |||
149 150 151 152 153 154 155 |
if (Tcl_InitStubs(interp, "8.5-", 0) == NULL) {
return TCL_ERROR;
}
code = Tcl_PkgProvide(interp, "pkgc", "1.7.2");
if (code != TCL_OK) {
return code;
}
| | | 149 150 151 152 153 154 155 156 157 158 |
if (Tcl_InitStubs(interp, "8.5-", 0) == NULL) {
return TCL_ERROR;
}
code = Tcl_PkgProvide(interp, "pkgc", "1.7.2");
if (code != TCL_OK) {
return code;
}
Tcl_CreateObjCommand2(interp, "pkgc_sub", Pkgc_SubObjCmd, NULL, NULL);
return TCL_OK;
}
|
Changes to unix/dltest/pkgd.c.
| ︙ | ︙ | |||
31 32 33 34 35 36 37 |
*----------------------------------------------------------------------
*/
static int
Pkgd_SubObjCmd(
void *dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
| | | 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 |
*----------------------------------------------------------------------
*/
static int
Pkgd_SubObjCmd(
void *dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
int first, second;
(void)dummy;
if (objc != 3) {
Tcl_WrongNumArgs(interp, 1, objv, "num num");
|
| ︙ | ︙ | |||
70 71 72 73 74 75 76 |
*----------------------------------------------------------------------
*/
static int
Pkgd_UnsafeObjCmd(
void *dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
| | | 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 |
*----------------------------------------------------------------------
*/
static int
Pkgd_UnsafeObjCmd(
void *dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
(void)dummy;
(void)objc;
(void)objv;
Tcl_SetObjResult(interp, Tcl_NewStringObj("unsafe command invoked", TCL_INDEX_NONE));
|
| ︙ | ︙ | |||
112 113 114 115 116 117 118 |
if (Tcl_InitStubs(interp, "8.5-", 0) == NULL) {
return TCL_ERROR;
}
code = Tcl_PkgProvide(interp, "pkgd", "7.3");
if (code != TCL_OK) {
return code;
}
| | | | 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 |
if (Tcl_InitStubs(interp, "8.5-", 0) == NULL) {
return TCL_ERROR;
}
code = Tcl_PkgProvide(interp, "pkgd", "7.3");
if (code != TCL_OK) {
return code;
}
Tcl_CreateObjCommand2(interp, "pkgd_sub", Pkgd_SubObjCmd, NULL, NULL);
Tcl_CreateObjCommand2(interp, "pkgd_unsafe", Pkgd_UnsafeObjCmd, NULL,
NULL);
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
|
| ︙ | ︙ | |||
149 150 151 152 153 154 155 |
if (Tcl_InitStubs(interp, "8.5-", 0) == NULL) {
return TCL_ERROR;
}
code = Tcl_PkgProvide(interp, "pkgd", "7.3");
if (code != TCL_OK) {
return code;
}
| | | 149 150 151 152 153 154 155 156 157 158 |
if (Tcl_InitStubs(interp, "8.5-", 0) == NULL) {
return TCL_ERROR;
}
code = Tcl_PkgProvide(interp, "pkgd", "7.3");
if (code != TCL_OK) {
return code;
}
Tcl_CreateObjCommand2(interp, "pkgd_sub", Pkgd_SubObjCmd, NULL, NULL);
return TCL_OK;
}
|
Changes to unix/dltest/pkgooa.c.
| ︙ | ︙ | |||
31 32 33 34 35 36 37 |
*----------------------------------------------------------------------
*/
static int
Pkgooa_StubsOKObjCmd(
void *dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
| | | 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 |
*----------------------------------------------------------------------
*/
static int
Pkgooa_StubsOKObjCmd(
void *dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
(void)dummy;
if (objc != 1) {
Tcl_WrongNumArgs(interp, 1, objv, "");
return TCL_ERROR;
|
| ︙ | ︙ | |||
139 140 141 142 143 144 145 |
tclOOStubsPtr = &stubsCopy;
code = Tcl_PkgProvide(interp, "pkgooa", "1.0");
if (code != TCL_OK) {
return code;
}
| | | 139 140 141 142 143 144 145 146 147 148 |
tclOOStubsPtr = &stubsCopy;
code = Tcl_PkgProvide(interp, "pkgooa", "1.0");
if (code != TCL_OK) {
return code;
}
Tcl_CreateObjCommand2(interp, "pkgooa_stubsok", Pkgooa_StubsOKObjCmd, NULL, NULL);
return TCL_OK;
}
|
Changes to unix/dltest/pkgua.c.
| ︙ | ︙ | |||
118 119 120 121 122 123 124 |
*----------------------------------------------------------------------
*/
static int
PkguaEqObjCmd(
void *dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
| | | 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 |
*----------------------------------------------------------------------
*/
static int
PkguaEqObjCmd(
void *dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
int result;
const char *str1, *str2;
Tcl_Size len1, len2;
(void)dummy;
|
| ︙ | ︙ | |||
165 166 167 168 169 170 171 |
*----------------------------------------------------------------------
*/
static int
PkguaQuoteObjCmd(
void *dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
| | | 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 |
*----------------------------------------------------------------------
*/
static int
PkguaQuoteObjCmd(
void *dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument strings. */
{
(void)dummy;
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "value");
return TCL_ERROR;
|
| ︙ | ︙ | |||
223 224 225 226 227 228 229 |
return code;
}
Tcl_SetVar2(interp, "::pkgua_loaded", NULL, ".", TCL_APPEND_VALUE);
cmdTokens = PkguaInterpToTokens(interp);
cmdTokens[0] =
| | | | 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 |
return code;
}
Tcl_SetVar2(interp, "::pkgua_loaded", NULL, ".", TCL_APPEND_VALUE);
cmdTokens = PkguaInterpToTokens(interp);
cmdTokens[0] =
Tcl_CreateObjCommand2(interp, "pkgua_eq", PkguaEqObjCmd, &cmdTokens[0],
CommandDeleted);
cmdTokens[1] =
Tcl_CreateObjCommand2(interp, "pkgua_quote", PkguaQuoteObjCmd,
&cmdTokens[1], CommandDeleted);
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
|
| ︙ | ︙ |
Changes to unix/dltest/pkgπ.c.
| ︙ | ︙ | |||
31 32 33 34 35 36 37 |
*----------------------------------------------------------------------
*/
static int
Pkg\u03C0_\u03A0ObjCmd(
void *dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
| | | 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 |
*----------------------------------------------------------------------
*/
static int
Pkg\u03C0_\u03A0ObjCmd(
void *dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
(void)dummy;
if (objc != 1) {
Tcl_WrongNumArgs(interp, 1, objv, "");
return TCL_ERROR;
|
| ︙ | ︙ | |||
76 77 78 79 80 81 82 |
if (Tcl_InitStubs(interp, "9.0", 0) == NULL) {
return TCL_ERROR;
}
code = Tcl_PkgProvide(interp, "pkgπ", "1.0");
if (code != TCL_OK) {
return code;
}
| | | 76 77 78 79 80 81 82 83 84 85 |
if (Tcl_InitStubs(interp, "9.0", 0) == NULL) {
return TCL_ERROR;
}
code = Tcl_PkgProvide(interp, "pkgπ", "1.0");
if (code != TCL_OK) {
return code;
}
Tcl_CreateObjCommand2(interp, "Ï€", Pkg\u03C0_\u03A0ObjCmd, NULL, NULL);
return TCL_OK;
}
|
Changes to unix/tclUnixPipe.c.
| ︙ | ︙ | |||
1370 1371 1372 1373 1374 1375 1376 |
*----------------------------------------------------------------------
*/
int
Tcl_PidObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 1370 1371 1372 1373 1374 1375 1376 1377 1378 1379 1380 1381 1382 1383 1384 |
*----------------------------------------------------------------------
*/
int
Tcl_PidObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const *objv) /* Argument strings. */
{
Tcl_Channel chan;
PipeState *pipePtr;
size_t i;
Tcl_Obj *resultPtr;
|
| ︙ | ︙ |
Changes to unix/tclUnixTest.c.
| ︙ | ︙ | |||
60 61 62 63 64 65 66 | static const char *gotsig = "0"; /* * Forward declarations of functions defined later in this file: */ | | | | | | | | | 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 | static const char *gotsig = "0"; /* * Forward declarations of functions defined later in this file: */ static Tcl_ObjCmdProc2 TestalarmCmd; static Tcl_ObjCmdProc2 TestchmodCmd; static Tcl_ObjCmdProc2 TestfilehandlerCmd; static Tcl_ObjCmdProc2 TestfilewaitCmd; static Tcl_ObjCmdProc2 TestfindexecutableCmd; static Tcl_ObjCmdProc2 TestforkCmd; static Tcl_ObjCmdProc2 TestgotsigCmd; static Tcl_FileProc TestFileHandlerProc; static void AlarmHandler(int signum); /* *---------------------------------------------------------------------- * * TclplatformtestInit -- |
| ︙ | ︙ | |||
91 92 93 94 95 96 97 |
*----------------------------------------------------------------------
*/
int
TclplatformtestInit(
Tcl_Interp *interp) /* Interpreter to add commands to. */
{
| | | | | | | | | 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 |
*----------------------------------------------------------------------
*/
int
TclplatformtestInit(
Tcl_Interp *interp) /* Interpreter to add commands to. */
{
Tcl_CreateObjCommand2(interp, "testchmod", TestchmodCmd,
NULL, NULL);
Tcl_CreateObjCommand2(interp, "testfilehandler", TestfilehandlerCmd,
NULL, NULL);
Tcl_CreateObjCommand2(interp, "testfilewait", TestfilewaitCmd,
NULL, NULL);
Tcl_CreateObjCommand2(interp, "testfindexecutable", TestfindexecutableCmd,
NULL, NULL);
Tcl_CreateObjCommand2(interp, "testfork", TestforkCmd,
NULL, NULL);
Tcl_CreateObjCommand2(interp, "testalarm", TestalarmCmd,
NULL, NULL);
Tcl_CreateObjCommand2(interp, "testgotsig", TestgotsigCmd,
NULL, NULL);
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
|
| ︙ | ︙ | |||
129 130 131 132 133 134 135 |
*----------------------------------------------------------------------
*/
static int
TestfilehandlerCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 |
*----------------------------------------------------------------------
*/
static int
TestfilehandlerCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const *objv) /* Argument strings. */
{
Pipe *pipePtr;
int i, mask, timeout;
static int initialized = 0;
char buffer[4000];
TclFile file;
|
| ︙ | ︙ | |||
343 344 345 346 347 348 349 |
*----------------------------------------------------------------------
*/
static int
TestfilewaitCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 |
*----------------------------------------------------------------------
*/
static int
TestfilewaitCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const *objv) /* Argument strings. */
{
int mask, result, timeout;
Tcl_Channel channel;
int fd;
void *data;
|
| ︙ | ︙ | |||
411 412 413 414 415 416 417 |
*----------------------------------------------------------------------
*/
static int
TestfindexecutableCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 |
*----------------------------------------------------------------------
*/
static int
TestfindexecutableCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const *objv) /* Argument strings. */
{
Tcl_Obj *saveName;
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "argv0");
return TCL_ERROR;
|
| ︙ | ︙ | |||
453 454 455 456 457 458 459 |
*----------------------------------------------------------------------
*/
static int
TestforkCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 |
*----------------------------------------------------------------------
*/
static int
TestforkCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const *objv) /* Argument strings. */
{
pid_t pid;
if (objc != 1) {
Tcl_WrongNumArgs(interp, 1, objv, "");
return TCL_ERROR;
|
| ︙ | ︙ | |||
499 500 501 502 503 504 505 |
*----------------------------------------------------------------------
*/
static int
TestalarmCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 |
*----------------------------------------------------------------------
*/
static int
TestalarmCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const *objv) /* Argument strings. */
{
#ifdef SA_RESTART
unsigned int sec = 1;
struct sigaction action;
if (objc > 1) {
|
| ︙ | ︙ | |||
577 578 579 580 581 582 583 |
*----------------------------------------------------------------------
*/
static int
TestgotsigCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 |
*----------------------------------------------------------------------
*/
static int
TestgotsigCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
TCL_UNUSED(Tcl_Size) /*objc*/,
TCL_UNUSED(Tcl_Obj *const *))
{
Tcl_AppendResult(interp, gotsig, (char *)NULL);
gotsig = "0";
return TCL_OK;
}
|
| ︙ | ︙ | |||
608 609 610 611 612 613 614 |
*---------------------------------------------------------------------------
*/
static int
TestchmodCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 |
*---------------------------------------------------------------------------
*/
static int
TestchmodCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const *objv) /* Argument strings. */
{
Tcl_Size i;
int mode;
Tcl_DString ds;
if (objc < 2) {
|
| ︙ | ︙ |
Changes to unix/tclXtTest.c.
| ︙ | ︙ | |||
11 12 13 14 15 16 17 | #ifndef USE_TCL_STUBS # define USE_TCL_STUBS #endif #include <X11/Intrinsic.h> #include "tcl.h" | | | 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 | #ifndef USE_TCL_STUBS # define USE_TCL_STUBS #endif #include <X11/Intrinsic.h> #include "tcl.h" static Tcl_ObjCmdProc2 TesteventloopCmd; /* * Functions defined in tclXtNotify.c for use by users of the Xt Notifier: */ extern void InitNotifier(void); extern XtAppContext TclSetAppContext(XtAppContext ctx); |
| ︙ | ︙ | |||
48 49 50 51 52 53 54 |
Tcl_Interp *interp) /* Interpreter for application. */
{
if (Tcl_InitStubs(interp, "8.5-", 0) == NULL) {
return TCL_ERROR;
}
XtToolkitInitialize();
InitNotifier();
| | | 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 |
Tcl_Interp *interp) /* Interpreter for application. */
{
if (Tcl_InitStubs(interp, "8.5-", 0) == NULL) {
return TCL_ERROR;
}
XtToolkitInitialize();
InitNotifier();
Tcl_CreateObjCommand2(interp, "testeventloop", TesteventloopCmd,
NULL, NULL);
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
|
| ︙ | ︙ | |||
75 76 77 78 79 80 81 |
*----------------------------------------------------------------------
*/
static int
TesteventloopCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 |
*----------------------------------------------------------------------
*/
static int
TesteventloopCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
static int *framePtr = NULL;/* Pointer to integer on stack frame of
* innermost invocation of the "wait"
* subcommand. */
if (objc < 2) {
|
| ︙ | ︙ |
Changes to win/tclWinPipe.c.
| ︙ | ︙ | |||
2761 2762 2763 2764 2765 2766 2767 |
*----------------------------------------------------------------------
*/
int
Tcl_PidObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 2761 2762 2763 2764 2765 2766 2767 2768 2769 2770 2771 2772 2773 2774 2775 |
*----------------------------------------------------------------------
*/
int
Tcl_PidObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const *objv) /* Argument strings. */
{
Tcl_Channel chan;
const Tcl_ChannelType *chanTypePtr;
PipeInfo *pipePtr;
size_t i;
Tcl_Obj *resultPtr;
|
| ︙ | ︙ |
Changes to win/tclWinTest.c.
| ︙ | ︙ | |||
34 35 36 37 38 39 40 | #define INHERITED_ACE (0x10) #endif /* * Forward declarations of functions defined later in this file: */ | | | | | | | | 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 | #define INHERITED_ACE (0x10) #endif /* * Forward declarations of functions defined later in this file: */ static Tcl_ObjCmdProc2 TesteventloopCmd; static Tcl_ObjCmdProc2 TestvolumetypeCmd; static Tcl_ObjCmdProc2 TestwinclockCmd; static Tcl_ObjCmdProc2 TestwinsleepCmd; static Tcl_ObjCmdProc2 TestExceptionCmd; static int TestplatformChmod(const char *nativePath, int pmode); static Tcl_ObjCmdProc2 TestchmodCmd; /* *---------------------------------------------------------------------- * * TclplatformtestInit -- * * Defines commands that test platform specific functionality for Windows |
| ︙ | ︙ | |||
67 68 69 70 71 72 73 |
TclplatformtestInit(
Tcl_Interp *interp) /* Interpreter to add commands to. */
{
/*
* Add commands for platform specific tests for Windows here.
*/
| | | | | | | | 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 |
TclplatformtestInit(
Tcl_Interp *interp) /* Interpreter to add commands to. */
{
/*
* Add commands for platform specific tests for Windows here.
*/
Tcl_CreateObjCommand2(interp, "testchmod", TestchmodCmd, NULL, NULL);
Tcl_CreateObjCommand2(interp, "testeventloop", TesteventloopCmd, NULL, NULL);
Tcl_CreateObjCommand2(interp, "testvolumetype", TestvolumetypeCmd,
NULL, NULL);
Tcl_CreateObjCommand2(interp, "testwinclock", TestwinclockCmd, NULL, NULL);
Tcl_CreateObjCommand2(interp, "testwinsleep", TestwinsleepCmd, NULL, NULL);
Tcl_CreateObjCommand2(interp, "testexcept", TestExceptionCmd, NULL, NULL);
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
* TesteventloopCmd --
|
| ︙ | ︙ | |||
99 100 101 102 103 104 105 |
*----------------------------------------------------------------------
*/
static int
TesteventloopCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 |
*----------------------------------------------------------------------
*/
static int
TesteventloopCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
static int *framePtr = NULL;/* Pointer to integer on stack frame of
* innermost invocation of the "wait"
* subcommand. */
if (objc != 2) {
|
| ︙ | ︙ | |||
175 176 177 178 179 180 181 |
*----------------------------------------------------------------------
*/
static int
TestvolumetypeCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 |
*----------------------------------------------------------------------
*/
static int
TestvolumetypeCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
#define VOL_BUF_SIZE 32
int found;
char volType[VOL_BUF_SIZE];
const char *path;
|
| ︙ | ︙ | |||
241 242 243 244 245 246 247 |
*----------------------------------------------------------------------
*/
static int
TestwinclockCmd(
TCL_UNUSED(void *),
Tcl_Interp* interp, /* Tcl interpreter */
| | | 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 |
*----------------------------------------------------------------------
*/
static int
TestwinclockCmd(
TCL_UNUSED(void *),
Tcl_Interp* interp, /* Tcl interpreter */
Tcl_Size objc, /* Argument count */
Tcl_Obj *const objv[]) /* Argument vector */
{
static const FILETIME posixEpoch = { 0xD53E8000, 0x019DB1DE };
/* The Posix epoch, expressed as a Windows
* FILETIME */
Tcl_Time tclTime; /* Tcl clock */
FILETIME sysTime; /* System clock */
|
| ︙ | ︙ | |||
290 291 292 293 294 295 296 |
return TCL_OK;
}
static int
TestwinsleepCmd(
TCL_UNUSED(void *),
Tcl_Interp* interp, /* Tcl interpreter */
| | | 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 |
return TCL_OK;
}
static int
TestwinsleepCmd(
TCL_UNUSED(void *),
Tcl_Interp* interp, /* Tcl interpreter */
Tcl_Size objc, /* Parameter count */
Tcl_Obj *const * objv) /* Parameter vector */
{
int ms;
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "ms");
return TCL_ERROR;
|
| ︙ | ︙ | |||
333 334 335 336 337 338 339 |
*----------------------------------------------------------------------
*/
static int
TestExceptionCmd(
TCL_UNUSED(void *),
Tcl_Interp* interp, /* Tcl interpreter */
| | | 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 |
*----------------------------------------------------------------------
*/
static int
TestExceptionCmd(
TCL_UNUSED(void *),
Tcl_Interp* interp, /* Tcl interpreter */
Tcl_Size objc, /* Argument count */
Tcl_Obj *const objv[]) /* Argument vector */
{
static const char *const cmds[] = {
"access_violation", "datatype_misalignment", "array_bounds",
"float_denormal", "float_divbyzero", "float_inexact",
"float_invalidop", "float_overflow", "float_stack", "float_underflow",
"int_divbyzero", "int_overflow", "private_instruction", "inpageerror",
|
| ︙ | ︙ | |||
634 635 636 637 638 639 640 |
*---------------------------------------------------------------------------
*/
static int
TestchmodCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 |
*---------------------------------------------------------------------------
*/
static int
TestchmodCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Parameter count */
Tcl_Obj *const * objv) /* Parameter vector */
{
Tcl_Size i;
int mode;
if (objc < 2) {
Tcl_WrongNumArgs(interp, 1, objv, "mode file ?file ...?");
|
| ︙ | ︙ |