From d6b88eb7975e3dc13b386679c53bb4a6f7f7f616 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 9 Sep 2022 12:42:04 +0000 Subject: Change 'skip' argument from int to size_t. Should have been part of TIP #630 (TclOO commands > 2^31 (for 8.7)) --- doc/Class.3 | 2 +- doc/Method.3 | 2 +- generic/tclOO.c | 25 +++++++++++-------------- generic/tclOO.decls | 4 ++-- generic/tclOODecls.h | 8 ++++---- generic/tclOOInt.h | 4 ++-- 6 files changed, 21 insertions(+), 24 deletions(-) diff --git a/doc/Class.3 b/doc/Class.3 index 0d50e95..c029595 100644 --- a/doc/Class.3 +++ b/doc/Class.3 @@ -85,7 +85,7 @@ already exist. The number of elements in the \fIobjv\fR array. .AP "Tcl_Obj *const" *objv in The arguments to the command to create the instance of the class. -.AP int skip in +.AP size_t skip in The number of arguments at the start of the argument array, \fIobjv\fR, that are not arguments to any constructors. This allows the generation of correct error messages even when complicated calling patterns are used (e.g., via the diff --git a/doc/Method.3 b/doc/Method.3 index 9096734..c3a6b64 100644 --- a/doc/Method.3 +++ b/doc/Method.3 @@ -99,7 +99,7 @@ retain a reference to a context. The number of arguments to pass to the method implementation. .AP "Tcl_Obj *const" *objv in An array of arguments to pass to the method implementation. -.AP int skip in +.AP size_t skip in The number of arguments passed to the method implementation that do not represent "real" arguments. .BE diff --git a/generic/tclOO.c b/generic/tclOO.c index 5385f08..0d9c7da 100644 --- a/generic/tclOO.c +++ b/generic/tclOO.c @@ -1667,16 +1667,15 @@ Tcl_NewObjectInstance( const char *nsNameStr, /* Name of namespace to create inside object, * or NULL to ask the code to pick its own * unique name. */ - size_t objc1, /* Number of arguments. Negative value means + size_t objc, /* Number of arguments. Negative value means * do not call constructor. */ Tcl_Obj *const *objv, /* Argument list. */ - int skip) /* Number of arguments to _not_ pass to the + size_t skip) /* Number of arguments to _not_ pass to the * constructor. */ { Class *classPtr = (Class *) cls; Object *oPtr; ClientData clientData[4]; - int objc = objc1; oPtr = TclNewObjectInstanceCommon(interp, classPtr, nameStr, nsNameStr); if (oPtr == NULL) { @@ -1688,7 +1687,7 @@ Tcl_NewObjectInstance( * used for object cloning only. */ - if (objc >= 0) { + if (objc != TCL_INDEX_NONE) { CallContext *contextPtr = TclOOGetCallContext(oPtr, NULL, CONSTRUCTOR, NULL, NULL, NULL); @@ -1736,10 +1735,10 @@ TclNRNewObjectInstance( const char *nsNameStr, /* Name of namespace to create inside object, * or NULL to ask the code to pick its own * unique name. */ - int objc, /* Number of arguments. Negative value means + size_t objc, /* Number of arguments. Negative value means * do not call constructor. */ Tcl_Obj *const *objv, /* Argument list. */ - int skip, /* Number of arguments to _not_ pass to the + size_t skip, /* Number of arguments to _not_ pass to the * constructor. */ Tcl_Object *objectPtr) /* Place to write the object reference upon * successful allocation. */ @@ -1755,11 +1754,11 @@ TclNRNewObjectInstance( } /* - * Run constructors, except when objc < 0 (a special flag case used for + * Run constructors, except when objc == TCL_INDEX_NONE (a special flag case used for * object cloning only). If there aren't any constructors, we do nothing. */ - if (objc < 0) { + if (objc == TCL_INDEX_NONE) { *objectPtr = (Tcl_Object) oPtr; return TCL_OK; } @@ -2628,7 +2627,7 @@ int TclOOObjectCmdCore( Object *oPtr, /* The object being invoked. */ Tcl_Interp *interp, /* The interpreter containing the object. */ - size_t objc1, /* How many arguments are being passed in. */ + size_t objc, /* How many arguments are being passed in. */ Tcl_Obj *const *objv, /* The array of arguments. */ int flags, /* Whether this is an invocation through the * public or the private command interface. */ @@ -2643,14 +2642,13 @@ TclOOObjectCmdCore( Object *callerObjPtr = NULL; Class *callerClsPtr = NULL; int result; - int objc = objc1; /* * If we've no method name, throw this directly into the unknown * processing. */ - if (objc < 2) { + if (objc + 1 < 3) { flags |= FORCE_UNKNOWN; methodNamePtr = NULL; goto noMapping; @@ -2801,15 +2799,14 @@ int Tcl_ObjectContextInvokeNext( Tcl_Interp *interp, Tcl_ObjectContext context, - size_t objc1, + size_t objc, Tcl_Obj *const *objv, - int skip) + size_t skip) { CallContext *contextPtr = (CallContext *) context; size_t savedIndex = contextPtr->index; size_t savedSkip = contextPtr->skip; int result; - int objc = objc1; if (contextPtr->index + 1 >= contextPtr->callPtr->numChain) { /* diff --git a/generic/tclOO.decls b/generic/tclOO.decls index d9adb4d..3783adf 100644 --- a/generic/tclOO.decls +++ b/generic/tclOO.decls @@ -69,7 +69,7 @@ declare 12 { declare 13 { Tcl_Object Tcl_NewObjectInstance(Tcl_Interp *interp, Tcl_Class cls, const char *nameStr, const char *nsNameStr, size_t objc, - Tcl_Obj *const *objv, int skip) + Tcl_Obj *const *objv, size_t skip) } declare 14 { int Tcl_ObjectDeleted(Tcl_Object object) @@ -105,7 +105,7 @@ declare 22 { declare 23 { int Tcl_ObjectContextInvokeNext(Tcl_Interp *interp, Tcl_ObjectContext context, size_t objc, Tcl_Obj *const *objv, - int skip) + size_t skip) } declare 24 { Tcl_ObjectMapMethodNameProc *Tcl_ObjectGetMethodNameMapper( diff --git a/generic/tclOODecls.h b/generic/tclOODecls.h index 7cfa039..0c141fe 100644 --- a/generic/tclOODecls.h +++ b/generic/tclOODecls.h @@ -70,7 +70,7 @@ TCLAPI Tcl_Method Tcl_NewMethod(Tcl_Interp *interp, Tcl_Class cls, TCLAPI Tcl_Object Tcl_NewObjectInstance(Tcl_Interp *interp, Tcl_Class cls, const char *nameStr, const char *nsNameStr, size_t objc, - Tcl_Obj *const *objv, int skip); + Tcl_Obj *const *objv, size_t skip); /* 14 */ TCLAPI int Tcl_ObjectDeleted(Tcl_Object object); /* 15 */ @@ -100,7 +100,7 @@ TCLAPI void Tcl_ObjectSetMetadata(Tcl_Object object, /* 23 */ TCLAPI int Tcl_ObjectContextInvokeNext(Tcl_Interp *interp, Tcl_ObjectContext context, size_t objc, - Tcl_Obj *const *objv, int skip); + Tcl_Obj *const *objv, size_t skip); /* 24 */ TCLAPI Tcl_ObjectMapMethodNameProc * Tcl_ObjectGetMethodNameMapper( Tcl_Object object); @@ -159,7 +159,7 @@ typedef struct TclOOStubs { Tcl_Obj * (*tcl_MethodName) (Tcl_Method method); /* 10 */ Tcl_Method (*tcl_NewInstanceMethod) (Tcl_Interp *interp, Tcl_Object object, Tcl_Obj *nameObj, int flags, const Tcl_MethodType *typePtr, void *clientData); /* 11 */ Tcl_Method (*tcl_NewMethod) (Tcl_Interp *interp, Tcl_Class cls, Tcl_Obj *nameObj, int flags, const Tcl_MethodType *typePtr, void *clientData); /* 12 */ - Tcl_Object (*tcl_NewObjectInstance) (Tcl_Interp *interp, Tcl_Class cls, const char *nameStr, const char *nsNameStr, size_t objc, Tcl_Obj *const *objv, int skip); /* 13 */ + Tcl_Object (*tcl_NewObjectInstance) (Tcl_Interp *interp, Tcl_Class cls, const char *nameStr, const char *nsNameStr, size_t objc, Tcl_Obj *const *objv, size_t skip); /* 13 */ int (*tcl_ObjectDeleted) (Tcl_Object object); /* 14 */ int (*tcl_ObjectContextIsFiltering) (Tcl_ObjectContext context); /* 15 */ Tcl_Method (*tcl_ObjectContextMethod) (Tcl_ObjectContext context); /* 16 */ @@ -169,7 +169,7 @@ typedef struct TclOOStubs { void (*tcl_ClassSetMetadata) (Tcl_Class clazz, const Tcl_ObjectMetadataType *typePtr, void *metadata); /* 20 */ void * (*tcl_ObjectGetMetadata) (Tcl_Object object, const Tcl_ObjectMetadataType *typePtr); /* 21 */ void (*tcl_ObjectSetMetadata) (Tcl_Object object, const Tcl_ObjectMetadataType *typePtr, void *metadata); /* 22 */ - int (*tcl_ObjectContextInvokeNext) (Tcl_Interp *interp, Tcl_ObjectContext context, size_t objc, Tcl_Obj *const *objv, int skip); /* 23 */ + int (*tcl_ObjectContextInvokeNext) (Tcl_Interp *interp, Tcl_ObjectContext context, size_t objc, Tcl_Obj *const *objv, size_t skip); /* 23 */ Tcl_ObjectMapMethodNameProc * (*tcl_ObjectGetMethodNameMapper) (Tcl_Object object); /* 24 */ void (*tcl_ObjectSetMethodNameMapper) (Tcl_Object object, Tcl_ObjectMapMethodNameProc *mapMethodNameProc); /* 25 */ void (*tcl_ClassSetConstructor) (Tcl_Interp *interp, Tcl_Class clazz, Tcl_Method method); /* 26 */ diff --git a/generic/tclOOInt.h b/generic/tclOOInt.h index 2ef4752..b7fb34d 100644 --- a/generic/tclOOInt.h +++ b/generic/tclOOInt.h @@ -505,8 +505,8 @@ MODULE_SCOPE Tcl_Method TclNewMethod(Tcl_Interp *interp, Tcl_Class cls, void *clientData); MODULE_SCOPE int TclNRNewObjectInstance(Tcl_Interp *interp, Tcl_Class cls, const char *nameStr, - const char *nsNameStr, int objc, - Tcl_Obj *const *objv, int skip, + const char *nsNameStr, size_t objc, + Tcl_Obj *const *objv, size_t skip, Tcl_Object *objectPtr); MODULE_SCOPE Object * TclNewObjectInstanceCommon(Tcl_Interp *interp, Class *classPtr, -- cgit v0.12