From 1c2359595d2d7376f8a7c36c81a0736dcf5390a3 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 25 Sep 2023 08:51:37 +0000 Subject: Move CHANNEL_*BUFFERED (internal) flags to higher bits: prevent any possibility for conflicts with public flags TCL_ENCODING_STOPONERROR|TCL_ENCODING_NO_TERMINATE|TCL_ENCODING_CHAR_LIMIT --- generic/tclIO.h | 14 ++++++++------ 1 file changed, 8 insertions(+), 6 deletions(-) diff --git a/generic/tclIO.h b/generic/tclIO.h index 729db5d..08fff44 100644 --- a/generic/tclIO.h +++ b/generic/tclIO.h @@ -158,8 +158,10 @@ typedef struct ChannelState { * of line sequences in output? */ int inEofChar; /* If nonzero, use this as a signal of EOF on * input. */ +#if TCL_MAJOR_VERSION < 9 int outEofChar; /* If nonzero, append this to the channel when - * it is closed if it is open for writing. */ + * it is closed if it is open for writing. For Tcl 8.x only */ +#endif int unreportedError; /* Non-zero if an error report was deferred * because it happened in the background. The * value is the POSIX error code. */ @@ -230,12 +232,8 @@ typedef struct ChannelState { * the channel can also have TCL_READABLE (1<<1) and TCL_WRITABLE (1<<2) set. */ -#define CHANNEL_NONBLOCKING (1<<3) /* Channel is currently in nonblocking +#define CHANNEL_NONBLOCKING (1<<6) /* Channel is currently in nonblocking * mode. */ -#define CHANNEL_LINEBUFFERED (1<<4) /* Output to the channel must be - * flushed after every newline. */ -#define CHANNEL_UNBUFFERED (1<<5) /* Output to the channel must always - * be flushed immediately. */ #define BG_FLUSH_SCHEDULED (1<<7) /* A background flush of the queued * output buffers has been * scheduled. */ @@ -278,6 +276,10 @@ typedef struct ChannelState { * encountered an encoding error */ #define CHANNEL_RAW_MODE (1<<16) /* When set, notes that the Raw API is * being used. */ +#define CHANNEL_LINEBUFFERED (1<<17) /* Output to the channel must be + * flushed after every newline. */ +#define CHANNEL_UNBUFFERED (1<<18) /* Output to the channel must always + * be flushed immediately. */ #define CHANNEL_INCLOSE (1<<19) /* Channel is currently being closed. * Its structures are still live and * usable, but it may not be closed -- cgit v0.12 From 434036ad668001c000f0edd307a0855f1bf513f9 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 25 Sep 2023 13:51:50 +0000 Subject: some more int -> Tcl_Size --- generic/tclOO.c | 127 ++++++++++++++++++++++++++++------------------------- generic/tclOOInt.h | 46 +++++++++---------- 2 files changed, 89 insertions(+), 84 deletions(-) diff --git a/generic/tclOO.c b/generic/tclOO.c index 8c722dc..9fc5942 100644 --- a/generic/tclOO.c +++ b/generic/tclOO.c @@ -67,9 +67,9 @@ static int CloneClassMethod(Tcl_Interp *interp, Class *clsPtr, Method **newMPtrPtr); static int CloneObjectMethod(Tcl_Interp *interp, Object *oPtr, Method *mPtr, Tcl_Obj *namePtr); -static void DeletedDefineNamespace(ClientData clientData); -static void DeletedObjdefNamespace(ClientData clientData); -static void DeletedHelpersNamespace(ClientData clientData); +static void DeletedDefineNamespace(void *clientData); +static void DeletedObjdefNamespace(void *clientData); +static void DeletedHelpersNamespace(void *clientData); static Tcl_NRPostProc FinalizeAlloc; static Tcl_NRPostProc FinalizeNext; static Tcl_NRPostProc FinalizeObjectCall; @@ -78,23 +78,23 @@ static void InitClassSystemRoots(Tcl_Interp *interp, Foundation *fPtr); static int InitFoundation(Tcl_Interp *interp); static Tcl_InterpDeleteProc KillFoundation; -static void MyDeleted(ClientData clientData); -static void ObjectNamespaceDeleted(ClientData clientData); +static void MyDeleted(void *clientData); +static void ObjectNamespaceDeleted(void *clientData); static Tcl_CommandTraceProc ObjectRenamedTrace; static inline void RemoveClass(Class **list, int num, int idx); static inline void RemoveObject(Object **list, int num, int idx); static inline void SquelchCachedName(Object *oPtr); -static int PublicNRObjectCmd(ClientData clientData, +static int PublicNRObjectCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv); -static int PrivateNRObjectCmd(ClientData clientData, +static int PrivateNRObjectCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv); -static int MyClassNRObjCmd(ClientData clientData, +static int MyClassNRObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv); -static void MyClassDeleted(ClientData clientData); +static void MyClassDeleted(void *clientData); /* * Methods in the oo::object and oo::class classes. First, we define a helper @@ -204,7 +204,7 @@ RemoveClass( int num, int idx) { - for (; idx < num - 1; idx++) { + for (; idx + 1 < num; idx++) { list[idx] = list[idx + 1]; } list[idx] = NULL; @@ -216,7 +216,7 @@ RemoveObject( int num, int idx) { - for (; idx < num - 1; idx++) { + for (; idx + 1 < num; idx++) { list[idx] = list[idx + 1]; } list[idx] = NULL; @@ -256,7 +256,7 @@ TclOOInit( * to be fully provided. */ - if (Tcl_EvalEx(interp, initScript, -1, 0) != TCL_OK) { + if (Tcl_EvalEx(interp, initScript, TCL_INDEX_NONE, 0) != TCL_OK) { return TCL_ERROR; } @@ -430,7 +430,7 @@ InitFoundation( * Evaluate the remaining definitions, which are a compiled-in Tcl script. */ - return Tcl_EvalEx(interp, tclOOSetupScript, -1, 0); + return Tcl_EvalEx(interp, tclOOSetupScript, TCL_INDEX_NONE, 0); } /* @@ -536,7 +536,7 @@ InitClassSystemRoots( static void DeletedDefineNamespace( - ClientData clientData) + void *clientData) { Foundation *fPtr = (Foundation *)clientData; @@ -545,7 +545,7 @@ DeletedDefineNamespace( static void DeletedObjdefNamespace( - ClientData clientData) + void *clientData) { Foundation *fPtr = (Foundation *)clientData; @@ -554,7 +554,7 @@ DeletedObjdefNamespace( static void DeletedHelpersNamespace( - ClientData clientData) + void *clientData) { Foundation *fPtr = (Foundation *)clientData; @@ -790,7 +790,7 @@ SquelchCachedName( static void MyDeleted( - ClientData clientData) /* Reference to the object whose [my] has been + void *clientData) /* Reference to the object whose [my] has been * squelched. */ { Object *oPtr = (Object *)clientData; @@ -800,7 +800,7 @@ MyDeleted( static void MyClassDeleted( - ClientData clientData) + void *clientData) { Object *oPtr = (Object *)clientData; oPtr->myclassCommand = NULL; @@ -821,7 +821,7 @@ MyClassDeleted( static void ObjectRenamedTrace( - ClientData clientData, /* The object being deleted. */ + void *clientData, /* The object being deleted. */ TCL_UNUSED(Tcl_Interp *), TCL_UNUSED(const char *) /*oldName*/, TCL_UNUSED(const char *) /*newName*/, @@ -961,7 +961,7 @@ TclOOReleaseClassContents( Object *oPtr) /* The object representing the class. */ { FOREACH_HASH_DECLS; - int i; + Tcl_Size i; Class *clsPtr = oPtr->classPtr, *tmpClsPtr; Method *mPtr; Foundation *fPtr = oPtr->fPtr; @@ -1062,7 +1062,7 @@ TclOOReleaseClassContents( if (clsPtr->metadataPtr != NULL) { Tcl_ObjectMetadataType *metadataTypePtr; - ClientData value; + void *value; FOREACH_HASH(metadataTypePtr, value, clsPtr->metadataPtr) { metadataTypePtr->deleteProc(value); @@ -1134,7 +1134,7 @@ TclOOReleaseClassContents( static void ObjectNamespaceDeleted( - ClientData clientData) /* Pointer to the class whose namespace is + void *clientData) /* Pointer to the class whose namespace is * being deleted. */ { Object *oPtr = (Object *)clientData; @@ -1145,7 +1145,7 @@ ObjectNamespaceDeleted( Tcl_Obj *filterObj, *variableObj, *propertyObj; PrivateVariableMapping *privateVariable; Tcl_Interp *interp = oPtr->fPtr->interp; - int i; + Tcl_Size i; if (Destructing(oPtr)) { /* @@ -1285,7 +1285,7 @@ ObjectNamespaceDeleted( if (oPtr->metadataPtr != NULL) { Tcl_ObjectMetadataType *metadataTypePtr; - ClientData value; + void *value; FOREACH_HASH(metadataTypePtr, value, oPtr->metadataPtr) { metadataTypePtr->deleteProc(value); @@ -1409,7 +1409,8 @@ TclOORemoveFromInstances( Class *clsPtr) /* The class (possibly) containing the * reference to the instance. */ { - int i, res = 0; + Tcl_Size i; + int res = 0; Object *instPtr; FOREACH(instPtr, clsPtr->instances) { @@ -1471,7 +1472,8 @@ TclOORemoveFromMixins( Object *oPtr) /* The object (possibly) containing the * reference to the mixin. */ { - int i, res = 0; + Tcl_Size i; + int res = 0; Class *mixPtr; FOREACH(mixPtr, oPtr->mixins) { @@ -1506,7 +1508,8 @@ TclOORemoveFromSubclasses( Class *superPtr) /* The superclass to possibly remove the * subclass reference from. */ { - int i, res = 0; + Tcl_Size i; + int res = 0; Class *subclsPtr; FOREACH(subclsPtr, superPtr->subclasses) { @@ -1570,7 +1573,8 @@ TclOORemoveFromMixinSubs( Class *superPtr) /* The superclass to possibly remove the * subclass reference from. */ { - int i, res = 0; + Tcl_Size i; + int res = 0; Class *subclsPtr; FOREACH(subclsPtr, superPtr->mixinSubs) { @@ -1710,15 +1714,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. */ - int objc, /* Number of arguments. Negative value means + Tcl_Size 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 + Tcl_Size skip) /* Number of arguments to _not_ pass to the * constructor. */ { Class *classPtr = (Class *) cls; Object *oPtr; - ClientData clientData[4]; + void *clientData[4]; oPtr = TclNewObjectInstanceCommon(interp, classPtr, nameStr, nsNameStr); if (oPtr == NULL) { @@ -1778,10 +1782,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 + Tcl_Size 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 + Tcl_Size skip, /* Number of arguments to _not_ pass to the * constructor. */ Tcl_Object *objectPtr) /* Place to write the object reference upon * successful allocation. */ @@ -1897,7 +1901,7 @@ TclNewObjectInstanceCommon( static int FinalizeAlloc( - ClientData data[], + void *data[], Tcl_Interp *interp, int result) { @@ -1975,7 +1979,8 @@ Tcl_CopyObjectInstance( CallContext *contextPtr; Tcl_Obj *keyPtr, *filterObj, *variableObj, *args[3]; PrivateVariableMapping *privateVariable; - int i, result; + Tcl_Size i; + int result; /* * Sanity check. @@ -1993,7 +1998,7 @@ Tcl_CopyObjectInstance( */ o2Ptr = (Object *) Tcl_NewObjectInstance(interp, - (Tcl_Class) oPtr->selfCls, targetName, targetNamespaceName, -1, + (Tcl_Class) oPtr->selfCls, targetName, targetNamespaceName, TCL_INDEX_NONE, NULL, -1); if (o2Ptr == NULL) { return NULL; @@ -2079,7 +2084,7 @@ Tcl_CopyObjectInstance( if (oPtr->metadataPtr != NULL) { Tcl_ObjectMetadataType *metadataTypePtr; - ClientData value, duplicate; + void *value, *duplicate; FOREACH_HASH(metadataTypePtr, value, oPtr->metadataPtr) { if (metadataTypePtr->cloneProc == NULL) { @@ -2124,7 +2129,7 @@ Tcl_CopyObjectInstance( TclOODecrRefCount(superPtr->thisPtr); } if (cls2Ptr->superclasses.num) { - cls2Ptr->superclasses.list = (Class **) ckrealloc(cls2Ptr->superclasses.list, + cls2Ptr->superclasses.list = (Class **)ckrealloc(cls2Ptr->superclasses.list, sizeof(Class *) * clsPtr->superclasses.num); } else { cls2Ptr->superclasses.list = @@ -2224,7 +2229,7 @@ Tcl_CopyObjectInstance( if (clsPtr->metadataPtr != NULL) { Tcl_ObjectMetadataType *metadataTypePtr; - ClientData value, duplicate; + void *value, *duplicate; FOREACH_HASH(metadataTypePtr, value, clsPtr->metadataPtr) { if (metadataTypePtr->cloneProc == NULL) { @@ -2296,7 +2301,7 @@ CloneObjectMethod( Tcl_NewInstanceMethod(interp, (Tcl_Object) oPtr, namePtr, mPtr->flags & PUBLIC_METHOD, NULL, NULL); } else if (mPtr->typePtr->cloneProc) { - ClientData newClientData; + void *newClientData; if (mPtr->typePtr->cloneProc(interp, mPtr->clientData, &newClientData) != TCL_OK) { @@ -2325,7 +2330,7 @@ CloneClassMethod( m2Ptr = (Method *) Tcl_NewMethod(interp, (Tcl_Class) clsPtr, namePtr, mPtr->flags & PUBLIC_METHOD, NULL, NULL); } else if (mPtr->typePtr->cloneProc) { - ClientData newClientData; + void *newClientData; if (mPtr->typePtr->cloneProc(interp, mPtr->clientData, &newClientData) != TCL_OK) { @@ -2371,7 +2376,7 @@ CloneClassMethod( * ---------------------------------------------------------------------- */ -ClientData +void * Tcl_ClassGetMetadata( Tcl_Class clazz, const Tcl_ObjectMetadataType *typePtr) @@ -2408,7 +2413,7 @@ void Tcl_ClassSetMetadata( Tcl_Class clazz, const Tcl_ObjectMetadataType *typePtr, - ClientData metadata) + void *metadata) { Class *clsPtr = (Class *) clazz; Tcl_HashEntry *hPtr; @@ -2451,7 +2456,7 @@ Tcl_ClassSetMetadata( Tcl_SetHashValue(hPtr, metadata); } -ClientData +void * Tcl_ObjectGetMetadata( Tcl_Object object, const Tcl_ObjectMetadataType *typePtr) @@ -2488,7 +2493,7 @@ void Tcl_ObjectSetMetadata( Tcl_Object object, const Tcl_ObjectMetadataType *typePtr, - ClientData metadata) + void *metadata) { Object *oPtr = (Object *) object; Tcl_HashEntry *hPtr; @@ -2546,7 +2551,7 @@ Tcl_ObjectSetMetadata( int TclOOPublicObjectCmd( - ClientData clientData, + void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv) @@ -2556,7 +2561,7 @@ TclOOPublicObjectCmd( static int PublicNRObjectCmd( - ClientData clientData, + void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv) @@ -2567,7 +2572,7 @@ PublicNRObjectCmd( int TclOOPrivateObjectCmd( - ClientData clientData, + void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv) @@ -2577,7 +2582,7 @@ TclOOPrivateObjectCmd( static int PrivateNRObjectCmd( - ClientData clientData, + void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv) @@ -2598,7 +2603,7 @@ TclOOInvokeObject( * (PRIVATE_METHOD), or a *really* private * context (any other value; conventionally * 0). */ - int objc, /* Number of arguments. */ + Tcl_Size objc, /* Number of arguments. */ Tcl_Obj *const *objv) /* Array of argument objects. It is assumed * that the name of the method to invoke will * be at index 1. */ @@ -2628,7 +2633,7 @@ TclOOInvokeObject( int TclOOMyClassObjCmd( - ClientData clientData, + void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv) @@ -2638,7 +2643,7 @@ TclOOMyClassObjCmd( static int MyClassNRObjCmd( - ClientData clientData, + void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv) @@ -2669,7 +2674,7 @@ int TclOOObjectCmdCore( Object *oPtr, /* The object being invoked. */ Tcl_Interp *interp, /* The interpreter containing the object. */ - int objc, /* How many arguments are being passed in. */ + Tcl_Size 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. */ @@ -2810,7 +2815,7 @@ TclOOObjectCmdCore( static int FinalizeObjectCall( - ClientData data[], + void *data[], TCL_UNUSED(Tcl_Interp *), int result) { @@ -2841,9 +2846,9 @@ int Tcl_ObjectContextInvokeNext( Tcl_Interp *interp, Tcl_ObjectContext context, - int objc, + Tcl_Size objc, Tcl_Obj *const *objv, - int skip) + Tcl_Size skip) { CallContext *contextPtr = (CallContext *) context; int savedIndex = contextPtr->index; @@ -2913,9 +2918,9 @@ int TclNRObjectContextInvokeNext( Tcl_Interp *interp, Tcl_ObjectContext context, - int objc, + Tcl_Size objc, Tcl_Obj *const *objv, - int skip) + Tcl_Size skip) { CallContext *contextPtr = (CallContext *) context; @@ -2971,7 +2976,7 @@ TclNRObjectContextInvokeNext( static int FinalizeNext( - ClientData data[], + void *data[], TCL_UNUSED(Tcl_Interp *), int result) { @@ -3042,7 +3047,7 @@ TclOOIsReachable( Class *targetPtr, Class *startPtr) { - int i; + Tcl_Size i; Class *superPtr; tailRecurse: @@ -3135,7 +3140,7 @@ Tcl_ObjectContextObject( return (Tcl_Object) ((CallContext *)context)->oPtr; } -int +Tcl_Size Tcl_ObjectContextSkippedArgs( Tcl_ObjectContext context) { diff --git a/generic/tclOOInt.h b/generic/tclOOInt.h index 9ff8e54..82422b9 100644 --- a/generic/tclOOInt.h +++ b/generic/tclOOInt.h @@ -46,7 +46,7 @@ typedef struct Method { /* The type of method. If NULL, this is a * special flag record which is just used for * the setting of the flags field. */ - int refCount; + Tcl_Size refCount; void *clientData; /* Type-specific data. */ Tcl_Obj *namePtr; /* Name of the method. */ struct Object *declaringObjectPtr; @@ -83,7 +83,7 @@ typedef struct ProcedureMethod { * includes the argument definition and the * body bytecodes. */ int flags; /* Flags to control features. */ - int refCount; + Tcl_Size refCount; void *clientData; TclOO_PmCDDeleteProc *deleteClientdataProc; TclOO_PmCDCloneProc *cloneClientdataProc; @@ -149,9 +149,9 @@ typedef struct { */ #define LIST_STATIC(listType_t) \ - struct { int num; listType_t *list; } + struct { Tcl_Size num; listType_t *list; } #define LIST_DYNAMIC(listType_t) \ - struct { int num, size; listType_t *list; } + struct { Tcl_Size num, size; listType_t *list; } /* * These types are needed in function arguments. @@ -204,18 +204,18 @@ typedef struct Object { struct Class *classPtr; /* This is non-NULL for all classes, and NULL * for everything else. It points to the class * structure. */ - int refCount; /* Number of strong references to this object. + Tcl_Size refCount; /* Number of strong references to this object. * Note that there may be many more weak * references; this mechanism exists to * avoid Tcl_Preserve. */ int flags; - int creationEpoch; /* Unique value to make comparisons of objects + Tcl_Size creationEpoch; /* Unique value to make comparisons of objects * easier. */ - int epoch; /* Per-object epoch, incremented when the way + Tcl_Size epoch; /* Per-object epoch, incremented when the way * an object should resolve call chains is * changed. */ Tcl_HashTable *metadataPtr; /* Mapping from pointers to metadata type to - * the ClientData values that are the values + * the void *values that are the values * of each piece of attached metadata. This * field starts out as NULL and is only * allocated if metadata is attached. */ @@ -306,7 +306,7 @@ typedef struct Class { Method *destructorPtr; /* Method record of the class destructor (if * any). */ Tcl_HashTable *metadataPtr; /* Mapping from pointers to metadata type to - * the ClientData values that are the values + * the void *values that are the values * of each piece of attached metadata. This * field starts out as NULL and is only * allocated if metadata is attached. */ @@ -355,7 +355,7 @@ typedef struct Class { */ typedef struct ThreadLocalData { - int nsCount; /* Epoch counter is used for keeping + Tcl_Size nsCount; /* Epoch counter is used for keeping * the values used in Tcl_Obj internal * representations sane. Must be thread-local * because Tcl_Objs can cross interpreter @@ -379,7 +379,7 @@ typedef struct Foundation { Tcl_Namespace *helpersNs; /* Namespace containing the commands that are * only valid when executing inside a * procedural method. */ - int epoch; /* Used to invalidate method chains when the + Tcl_Size epoch; /* Used to invalidate method chains when the * class structure changes. */ ThreadLocalData *tsdPtr; /* Counter so we can allocate a unique * namespace to each object. */ @@ -413,16 +413,16 @@ struct MInvoke { }; typedef struct CallChain { - int objectCreationEpoch; /* The object's creation epoch. Note that the + Tcl_Size objectCreationEpoch;/* The object's creation epoch. Note that the * object reference is not stored in the call * chain; it is in the call context. */ - int objectEpoch; /* Local (object structure) epoch counter + Tcl_Size objectEpoch; /* Local (object structure) epoch counter * snapshot. */ - int epoch; /* Global (class structure) epoch counter + Tcl_Size epoch; /* Global (class structure) epoch counter * snapshot. */ int flags; /* Assorted flags, see below. */ - int refCount; /* Reference count. */ - int numChain; /* Size of the call chain. */ + Tcl_Size refCount; /* Reference count. */ + Tcl_Size numChain; /* Size of the call chain. */ struct MInvoke *chain; /* Array of call chain entries. May point to * staticChain if the number of entries is * small. */ @@ -431,9 +431,9 @@ typedef struct CallChain { typedef struct CallContext { Object *oPtr; /* The object associated with this call. */ - int index; /* Index into the call chain of the currently + Tcl_Size index; /* Index into the call chain of the currently * executing method implementation. */ - int skip; /* Current number of arguments to skip; can + Tcl_Size skip; /* Current number of arguments to skip; can * vary depending on whether it is a direct * method call or a continuation via the * [next] command. */ @@ -520,8 +520,8 @@ MODULE_SCOPE Class * TclOOAllocClass(Tcl_Interp *interp, Object *useThisObj); MODULE_SCOPE int TclNRNewObjectInstance(Tcl_Interp *interp, Tcl_Class cls, const char *nameStr, - const char *nsNameStr, int objc, - Tcl_Obj *const *objv, int skip, + const char *nsNameStr, Tcl_Size objc, + Tcl_Obj *const *objv, Tcl_Size skip, Tcl_Object *objectPtr); MODULE_SCOPE Object * TclNewObjectInstanceCommon(Tcl_Interp *interp, Class *classPtr, @@ -563,8 +563,8 @@ MODULE_SCOPE int TclOOInvokeContext(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int TclNRObjectContextInvokeNext(Tcl_Interp *interp, - Tcl_ObjectContext context, int objc, - Tcl_Obj *const *objv, int skip); + Tcl_ObjectContext context, Tcl_Size objc, + Tcl_Obj *const *objv, Tcl_Size skip); MODULE_SCOPE void TclOONewBasicMethod(Tcl_Interp *interp, Class *clsPtr, const DeclaredClassMethod *dcm); MODULE_SCOPE Tcl_Obj * TclOOObjectName(Tcl_Interp *interp, Object *oPtr); @@ -609,7 +609,7 @@ MODULE_SCOPE void TclOOSetupVariableResolver(Tcl_Namespace *nsPtr); * A variation where the array is an array of structs. There's no issue with * possible NULLs; every element of the array will be iterated over and the * variable set to a pointer to each of those elements in turn. - * REQUIRES DECLARATION: int i; See [96551aca55] for more FOREACH_STRUCT details. + * REQUIRES DECLARATION: Tcl_Size i; See [96551aca55] for more FOREACH_STRUCT details. */ #define FOREACH_STRUCT(var,ary) \ -- cgit v0.12 From ea11b48037fc6e1e390196ddeba50a7e33991f57 Mon Sep 17 00:00:00 2001 From: apnadkarni Date: Mon, 25 Sep 2023 15:17:48 +0000 Subject: zipfs attribute tests --- tests/zipfs.test | 21 ++++++++++++++++++++- 1 file changed, 20 insertions(+), 1 deletion(-) diff --git a/tests/zipfs.test b/tests/zipfs.test index 200a8a1..f661e50 100644 --- a/tests/zipfs.test +++ b/tests/zipfs.test @@ -1318,7 +1318,26 @@ namespace eval test_ns_zipfs { testzipfsglob mountpoint $defaultMountPoint [file join [zipfs root] *] \ [list $defaultMountPoint] {} -constraints !zipfslib - # TODO tests for compress and save, + with password + # + # file attributes + proc testzipfsfileattr [list id path result [list mountpoint $defaultMountPoint] args] { + test zipfs-file-attrs-$id "zipfs file attrs $id" -setup { + mount [zippath test.zip] $mountpoint + } -cleanup cleanup -body { + lsort -stride 2 [file attributes $path] + } -result $result {*}$args + } + testzipfsfileattr noent [file join $defaultMountPoint nosuchfile] \ + {file not found: no such file or directory} $defaultMountPoint -returnCodes error + testzipfsfileattr file [file join $defaultMountPoint test] \ + [list -archive [zippath test.zip] -compsize 5 -crc [expr 0x3BB935C6] -mount $defaultMountPoint -offset 55 -permissions 0o555 -uncompsize 5] + testzipfsfileattr dir [file join $defaultMountPoint testdir] \ + [list -archive [zippath test.zip] -compsize 0 -crc 0 -mount $defaultMountPoint -offset 119 -permissions 0o555 -uncompsize 0] + testzipfsfileattr root [zipfs root] {} {} -constraints bug-4af110a6a1 + testzipfsfileattr mountpoint $defaultMountPoint \ + [list -archive [zippath test.zip] -compsize 0 -crc 0 -mount $defaultMountPoint -offset 0 -permissions 0o555 -uncompsize 0] + testzipfsfileattr mezzo [file join $defaultMountPoint a b] {} [file join $defaultMountPoint a b c] -constraints bug-4af110a6a1 + # # TODO - file copy, file rename etc. -- cgit v0.12