From 4df4a598eb231cdc6d925b2330d883786b448e71 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 5 Apr 2023 14:19:45 +0000 Subject: Use Tcl_GetIntForIndex() in testcases (tclTestObj.c) in stead of Tcl_GetWideIntFromObj(). Meant for Ashok, to show that we already have Tcl_GetSizeIntFromObj(). (I already planned this conversion for a long time, thanks, Ashok for reminding me) Also some other cleanups --- generic/tclDecls.h | 6 +-- generic/tclIndexObj.c | 63 +++++++++++++------------- generic/tclInt.decls | 2 +- generic/tclIntDecls.h | 4 +- generic/tclTestObj.c | 120 +++++++++++++++++++++++++------------------------- 5 files changed, 99 insertions(+), 96 deletions(-) diff --git a/generic/tclDecls.h b/generic/tclDecls.h index bee2ae2..84c2b4d 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -4366,11 +4366,11 @@ extern const TclStubs *tclStubsPtr; # define Tcl_UniCharNcmp(ucs,uct,n) \ ((int(*)(const Tcl_UniChar*,const Tcl_UniChar*,unsigned int))tclStubsPtr->tcl_UniCharNcmp)(ucs,uct,(unsigned int)(n)) # define Tcl_UtfNcmp(s1,s2,n) \ - ((int(*)(const char*,const char*,unsigned int))tclStubsPtr->tcl_UtfNcmp)(s1,s2,(unsigned int)(n)) + ((int(*)(const char*,const char*,unsigned int))(void *)tclStubsPtr->tcl_UtfNcmp)(s1,s2,(unsigned int)(n)) # define Tcl_UtfNcasecmp(s1,s2,n) \ - ((int(*)(const char*,const char*,unsigned int))tclStubsPtr->tcl_UtfNcasecmp)(s1,s2,(unsigned int)(n)) + ((int(*)(const char*,const char*,unsigned int))(void *)tclStubsPtr->tcl_UtfNcasecmp)(s1,s2,(unsigned int)(n)) # define Tcl_UniCharNcasecmp(ucs,uct,n) \ - ((int(*)(const Tcl_UniChar*,const Tcl_UniChar*,unsigned int))tclStubsPtr->tcl_UniCharNcasecmp)(ucs,uct,(unsigned int)(n)) + ((int(*)(const Tcl_UniChar*,const Tcl_UniChar*,unsigned int))(void *)tclStubsPtr->tcl_UniCharNcasecmp)(ucs,uct,(unsigned int)(n)) # endif #endif diff --git a/generic/tclIndexObj.c b/generic/tclIndexObj.c index 79be731..2474c97 100644 --- a/generic/tclIndexObj.c +++ b/generic/tclIndexObj.c @@ -54,8 +54,8 @@ static const Tcl_ObjType indexType = { typedef struct { void *tablePtr; /* Pointer to the table of strings */ - int offset; /* Offset between table entries */ - int index; /* Selected index into table. */ + Tcl_Size offset; /* Offset between table entries */ + Tcl_Size index; /* Selected index into table. */ } IndexRep; /* @@ -175,7 +175,8 @@ GetIndexFromObjList( int *indexPtr) /* Place to store resulting integer index. */ { - int objc, result, t; + Tcl_Size objc, t; + int result; Tcl_Obj **objv; const char **tablePtr; @@ -260,7 +261,7 @@ Tcl_GetIndexFromObjStruct( int flags, /* 0, TCL_EXACT, TCL_NULL_OK or TCL_INDEX_TEMP_TABLE */ void *indexPtr) /* Place to store resulting index. */ { - int index, idx, numAbbrev; + Tcl_Size index, idx, numAbbrev; const char *key, *p1; const char *p2; const char *const *entryPtr; @@ -295,7 +296,7 @@ Tcl_GetIndexFromObjStruct( */ key = objPtr ? TclGetString(objPtr) : ""; - index = -1; + index = TCL_INDEX_NONE; numAbbrev = 0; if (!*key && (flags & TCL_NULL_OK)) { @@ -568,8 +569,8 @@ PrefixMatchObjCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - int flags = 0, result, index; - int dummyLength, i, errorLength; + int flags = 0, result, index, i; + Tcl_Size dummyLength, errorLength; Tcl_Obj *errorPtr = NULL; const char *message = "option"; Tcl_Obj *tablePtr, *objPtr, *resultPtr; @@ -597,7 +598,7 @@ PrefixMatchObjCmd( case PRFMATCH_MESSAGE: if (i > objc-4) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "missing value for -message", -1)); + "missing value for -message", TCL_INDEX_NONE)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "NOARG", NULL); return TCL_ERROR; } @@ -607,7 +608,7 @@ PrefixMatchObjCmd( case PRFMATCH_ERROR: if (i > objc-4) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "missing value for -error", -1)); + "missing value for -error", TCL_INDEX_NONE)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "NOARG", NULL); return TCL_ERROR; } @@ -692,7 +693,8 @@ PrefixAllObjCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - int tableObjc, result, t, length, elemLength; + int result; + Tcl_Size length, elemLength, tableObjc, t; const char *string, *elemString; Tcl_Obj **tableObjv, *resultPtr; @@ -749,7 +751,8 @@ PrefixLongestObjCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - int tableObjc, result, i, t, length, elemLength, resultLength; + int result; + Tcl_Size i, length, elemLength, resultLength, tableObjc, t; const char *string, *elemString, *resultString; Tcl_Obj **tableObjv; @@ -864,7 +867,7 @@ PrefixLongestObjCmd( void Tcl_WrongNumArgs( Tcl_Interp *interp, /* Current interpreter. */ - int objc, /* Number of arguments to print from objv. */ + Tcl_Size objc, /* Number of arguments to print from objv. */ Tcl_Obj *const objv[], /* Initial argument objects, which should be * included in the error message. */ const char *message) /* Error message to print after the leading @@ -872,7 +875,7 @@ Tcl_WrongNumArgs( * NULL. */ { Tcl_Obj *objPtr; - int i, len, elemLen; + Tcl_Size i, len, elemLen; char flags; Interp *iPtr = (Interp *)interp; const char *elementStr; @@ -904,9 +907,9 @@ Tcl_WrongNumArgs( if (iPtr->flags & INTERP_ALTERNATE_WRONG_ARGS) { iPtr->flags &= ~INTERP_ALTERNATE_WRONG_ARGS; Tcl_AppendObjToObj(objPtr, Tcl_GetObjResult(interp)); - Tcl_AppendToObj(objPtr, " or \"", -1); + Tcl_AppendToObj(objPtr, " or \"", TCL_INDEX_NONE); } else { - Tcl_AppendToObj(objPtr, "wrong # args: should be \"", -1); + Tcl_AppendToObj(objPtr, "wrong # args: should be \"", TCL_INDEX_NONE); } /* @@ -915,8 +918,8 @@ Tcl_WrongNumArgs( */ if (iPtr->ensembleRewrite.sourceObjs != NULL) { - int toSkip = iPtr->ensembleRewrite.numInsertedObjs; - int toPrint = iPtr->ensembleRewrite.numRemovedObjs; + Tcl_Size toSkip = iPtr->ensembleRewrite.numInsertedObjs; + Tcl_Size toPrint = iPtr->ensembleRewrite.numRemovedObjs; Tcl_Obj *const *origObjv = TclEnsembleGetRewriteValues(interp); /* @@ -938,7 +941,7 @@ Tcl_WrongNumArgs( objc -= toSkip; /* - * We assume no object is of index type. + * Assume no object is of index type. */ for (i=0 ; itype != TCL_ARGV_END; infoPtr++) { - int length; + Tcl_Size length; if (infoPtr->keyStr == NULL) { continue; @@ -1372,7 +1375,7 @@ PrintUsage( * Now add the option information, with pretty-printing. */ - msg = Tcl_NewStringObj("Command-specific options:", -1); + msg = Tcl_NewStringObj("Command-specific options:", TCL_INDEX_NONE); for (infoPtr = argTable; infoPtr->type != TCL_ARGV_END; infoPtr++) { if ((infoPtr->type == TCL_ARGV_HELP) && (infoPtr->keyStr == NULL)) { Tcl_AppendPrintfToObj(msg, "\n%s", infoPtr->helpStr); @@ -1388,7 +1391,7 @@ PrintUsage( } numSpaces -= NUM_SPACES; } - Tcl_AppendToObj(msg, infoPtr->helpStr, -1); + Tcl_AppendToObj(msg, infoPtr->helpStr, TCL_INDEX_NONE); switch (infoPtr->type) { case TCL_ARGV_INT: Tcl_AppendPrintfToObj(msg, "\n\t\tDefault value: %d", diff --git a/generic/tclInt.decls b/generic/tclInt.decls index 4db3919..1ae651d 100644 --- a/generic/tclInt.decls +++ b/generic/tclInt.decls @@ -184,7 +184,7 @@ declare 77 {deprecated {}} { void TclpGetTime(Tcl_Time *time) } declare 81 { - void *TclpRealloc(void *ptr, unsigned int size) + void *TclpRealloc(void *ptr, TCL_HASH_TYPE size) } declare 88 {deprecated {}} { char *TclPrecTraceProc(void *clientData, Tcl_Interp *interp, diff --git a/generic/tclIntDecls.h b/generic/tclIntDecls.h index ffd559d..e4c0b19 100644 --- a/generic/tclIntDecls.h +++ b/generic/tclIntDecls.h @@ -227,7 +227,7 @@ void TclpGetTime(Tcl_Time *time); /* Slot 79 is reserved */ /* Slot 80 is reserved */ /* 81 */ -EXTERN void * TclpRealloc(void *ptr, unsigned int size); +EXTERN void * TclpRealloc(void *ptr, TCL_HASH_TYPE size); /* Slot 82 is reserved */ /* Slot 83 is reserved */ /* Slot 84 is reserved */ @@ -751,7 +751,7 @@ typedef struct TclIntStubs { void (*reserved78)(void); void (*reserved79)(void); void (*reserved80)(void); - void * (*tclpRealloc) (void *ptr, unsigned int size); /* 81 */ + void * (*tclpRealloc) (void *ptr, TCL_HASH_TYPE size); /* 81 */ void (*reserved82)(void); void (*reserved83)(void); void (*reserved84)(void); diff --git a/generic/tclTestObj.c b/generic/tclTestObj.c index e5b8a55..6c056da 100644 --- a/generic/tclTestObj.c +++ b/generic/tclTestObj.c @@ -38,10 +38,10 @@ * Forward declarations for functions defined later in this file: */ -static int CheckIfVarUnset(Tcl_Interp *interp, Tcl_Obj **varPtr, size_t varIndex); +static int CheckIfVarUnset(Tcl_Interp *interp, Tcl_Obj **varPtr, Tcl_Size varIndex); static int GetVariableIndex(Tcl_Interp *interp, - Tcl_Obj *obj, size_t *indexPtr); -static void SetVarToObj(Tcl_Obj **varPtr, size_t varIndex, Tcl_Obj *objPtr); + Tcl_Obj *obj, Tcl_Size *indexPtr); +static void SetVarToObj(Tcl_Obj **varPtr, Tcl_Size varIndex, Tcl_Obj *objPtr); static Tcl_ObjCmdProc TestbignumobjCmd; static Tcl_ObjCmdProc TestbooleanobjCmd; static Tcl_ObjCmdProc TestdoubleobjCmd; @@ -161,7 +161,7 @@ TestbignumobjCmd( BIGNUM_RADIXSIZE }; int index; - size_t varIndex; + Tcl_Size varIndex; const char *string; mp_int bignumValue; Tcl_Obj **varPtr; @@ -188,13 +188,13 @@ TestbignumobjCmd( string = Tcl_GetString(objv[3]); if (mp_init(&bignumValue) != MP_OKAY) { Tcl_SetObjResult(interp, - Tcl_NewStringObj("error in mp_init", -1)); + Tcl_NewStringObj("error in mp_init", TCL_INDEX_NONE)); return TCL_ERROR; } if (mp_read_radix(&bignumValue, string, 10) != MP_OKAY) { mp_clear(&bignumValue); Tcl_SetObjResult(interp, - Tcl_NewStringObj("error in mp_read_radix", -1)); + Tcl_NewStringObj("error in mp_read_radix", TCL_INDEX_NONE)); return TCL_ERROR; } @@ -238,7 +238,7 @@ TestbignumobjCmd( if (mp_mul_d(&bignumValue, 10, &bignumValue) != MP_OKAY) { mp_clear(&bignumValue); Tcl_SetObjResult(interp, - Tcl_NewStringObj("error in mp_mul_d", -1)); + Tcl_NewStringObj("error in mp_mul_d", TCL_INDEX_NONE)); return TCL_ERROR; } if (!Tcl_IsShared(varPtr[varIndex])) { @@ -263,7 +263,7 @@ TestbignumobjCmd( if (mp_div_d(&bignumValue, 10, &bignumValue, NULL) != MP_OKAY) { mp_clear(&bignumValue); Tcl_SetObjResult(interp, - Tcl_NewStringObj("error in mp_div_d", -1)); + Tcl_NewStringObj("error in mp_div_d", TCL_INDEX_NONE)); return TCL_ERROR; } if (!Tcl_IsShared(varPtr[varIndex])) { @@ -288,7 +288,7 @@ TestbignumobjCmd( if (mp_mod_2d(&bignumValue, 1, &bignumValue) != MP_OKAY) { mp_clear(&bignumValue); Tcl_SetObjResult(interp, - Tcl_NewStringObj("error in mp_mod_2d", -1)); + Tcl_NewStringObj("error in mp_mod_2d", TCL_INDEX_NONE)); return TCL_ERROR; } if (!Tcl_IsShared(varPtr[varIndex])) { @@ -352,7 +352,7 @@ TestbooleanobjCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - size_t varIndex; + Tcl_Size varIndex; int boolValue; const char *subCmd; Tcl_Obj **varPtr; @@ -452,7 +452,7 @@ TestdoubleobjCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - size_t varIndex; + Tcl_Size varIndex; double doubleValue; const char *subCmd; Tcl_Obj **varPtr; @@ -569,7 +569,7 @@ TestindexobjCmd( Tcl_Obj *const objv[]) /* Argument objects. */ { int allowAbbrev, index, setError, i, result; - Tcl_WideInt index2; + Tcl_Size index2; const char **argv; static const char *const tablePtr[] = {"a", "b", "check", NULL}; @@ -578,8 +578,8 @@ TestindexobjCmd( */ struct IndexRep { void *tablePtr; /* Pointer to the table of strings. */ - TCL_HASH_TYPE offset; /* Offset between table entries. */ - TCL_HASH_TYPE index; /* Selected index into table. */ + Tcl_Size offset; /* Offset between table entries. */ + Tcl_Size index; /* Selected index into table. */ } *indexRep; if ((objc == 3) && (strcmp(Tcl_GetString(objv[1]), @@ -590,7 +590,7 @@ TestindexobjCmd( * lookups. */ - if (Tcl_GetWideIntFromObj(interp, objv[2], &index2) != TCL_OK) { + if (Tcl_GetIntForIndex(interp, objv[2], TCL_INDEX_NONE, &index2) != TCL_OK) { return TCL_ERROR; } @@ -606,7 +606,7 @@ TestindexobjCmd( } if (objc < 5) { - Tcl_AppendToObj(Tcl_GetObjResult(interp), "wrong # args", -1); + Tcl_AppendToObj(Tcl_GetObjResult(interp), "wrong # args", TCL_INDEX_NONE); return TCL_ERROR; } @@ -617,7 +617,7 @@ TestindexobjCmd( return TCL_ERROR; } - argv = (const char **)ckalloc((objc-3) * sizeof(char *)); + argv = (const char **)ckalloc(((unsigned)objc-3) * sizeof(char *)); for (i = 4; i < objc; i++) { argv[i-4] = Tcl_GetString(objv[i]); } @@ -658,7 +658,7 @@ TestintobjCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - size_t varIndex; + Tcl_Size varIndex; #if (INT_MAX != LONG_MAX) /* int is not the same size as long */ int i; #endif @@ -746,7 +746,7 @@ TestintobjCmd( return TCL_ERROR; } Tcl_AppendToObj(Tcl_GetObjResult(interp), - ((wideValue == WIDE_MAX)? "1" : "0"), -1); + ((wideValue == WIDE_MAX)? "1" : "0"), TCL_INDEX_NONE); } else if (strcmp(subCmd, "get") == 0) { if (objc != 3) { goto wrongNumArgs; @@ -762,7 +762,7 @@ TestintobjCmd( if (CheckIfVarUnset(interp, varPtr,varIndex)) { return TCL_ERROR; } - Tcl_AppendToObj(Tcl_GetObjResult(interp), Tcl_GetString(varPtr[varIndex]), -1); + Tcl_AppendToObj(Tcl_GetObjResult(interp), Tcl_GetString(varPtr[varIndex]), TCL_INDEX_NONE); } else if (strcmp(subCmd, "inttoobigtest") == 0) { /* * If long ints have more bits than ints on this platform, verify that @@ -775,7 +775,7 @@ TestintobjCmd( goto wrongNumArgs; } #if (INT_MAX == LONG_MAX) /* int is same size as long int */ - Tcl_AppendToObj(Tcl_GetObjResult(interp), "1", -1); + Tcl_AppendToObj(Tcl_GetObjResult(interp), "1", TCL_INDEX_NONE); #else if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) { Tcl_SetWideIntObj(varPtr[varIndex], LONG_MAX); @@ -784,10 +784,10 @@ TestintobjCmd( } if (Tcl_GetIntFromObj(interp, varPtr[varIndex], &i) != TCL_OK) { Tcl_ResetResult(interp); - Tcl_AppendToObj(Tcl_GetObjResult(interp), "1", -1); + Tcl_AppendToObj(Tcl_GetObjResult(interp), "1", TCL_INDEX_NONE); return TCL_OK; } - Tcl_AppendToObj(Tcl_GetObjResult(interp), "0", -1); + Tcl_AppendToObj(Tcl_GetObjResult(interp), "0", TCL_INDEX_NONE); #endif } else if (strcmp(subCmd, "mult10") == 0) { if (objc != 3) { @@ -903,9 +903,9 @@ TestlistobjCmd( LISTOBJ_GETELEMENTSMEMCHECK, } cmdIndex; - size_t varIndex; /* Variable number converted to binary */ - Tcl_WideInt first; /* First index in the list */ - Tcl_WideInt count; /* Count of elements in a list */ + Tcl_Size varIndex; /* Variable number converted to binary */ + Tcl_Size first; /* First index in the list */ + Tcl_Size count; /* Count of elements in a list */ Tcl_Obj **varPtr; int i, len; @@ -948,8 +948,8 @@ TestlistobjCmd( "varIndex start count ?element...?"); return TCL_ERROR; } - if (Tcl_GetWideIntFromObj(interp, objv[3], &first) != TCL_OK - || Tcl_GetWideIntFromObj(interp, objv[4], &count) != TCL_OK) { + if (Tcl_GetIntForIndex(interp, objv[3], TCL_INDEX_NONE, &first) != TCL_OK + || Tcl_GetIntForIndex(interp, objv[4], TCL_INDEX_NONE, &count) != TCL_OK) { return TCL_ERROR; } if (Tcl_IsShared(varPtr[varIndex])) { @@ -1036,7 +1036,7 @@ TestobjCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - size_t varIndex, destIndex; + Tcl_Size varIndex, destIndex; int i; const Tcl_ObjType *targetType; Tcl_Obj **varPtr; @@ -1112,7 +1112,7 @@ TestobjCmd( const char *typeName; if (objv[2]->typePtr == NULL) { - Tcl_SetObjResult(interp, Tcl_NewStringObj("none", -1)); + Tcl_SetObjResult(interp, Tcl_NewStringObj("none", TCL_INDEX_NONE)); } else { typeName = objv[2]->typePtr->name; if (!strcmp(typeName, "utf32string")) @@ -1120,7 +1120,7 @@ TestobjCmd( #ifndef TCL_WIDE_INT_IS_LONG else if (!strcmp(typeName, "wideInt")) typeName = "int"; #endif - Tcl_SetObjResult(interp, Tcl_NewStringObj(typeName, -1)); + Tcl_SetObjResult(interp, Tcl_NewStringObj(typeName, TCL_INDEX_NONE)); } } return TCL_OK; @@ -1214,15 +1214,15 @@ TestobjCmd( goto wrongNumArgs; } if (varPtr[varIndex]->typePtr == NULL) { /* a string! */ - Tcl_AppendToObj(Tcl_GetObjResult(interp), "string", -1); + Tcl_AppendToObj(Tcl_GetObjResult(interp), "string", TCL_INDEX_NONE); #ifndef TCL_WIDE_INT_IS_LONG } else if (!strcmp(varPtr[varIndex]->typePtr->name, "wideInt")) { Tcl_AppendToObj(Tcl_GetObjResult(interp), - "int", -1); + "int", TCL_INDEX_NONE); #endif } else { Tcl_AppendToObj(Tcl_GetObjResult(interp), - varPtr[varIndex]->typePtr->name, -1); + varPtr[varIndex]->typePtr->name, TCL_INDEX_NONE); } break; default: @@ -1258,9 +1258,9 @@ TeststringobjCmd( Tcl_Obj *const objv[]) /* Argument objects. */ { unsigned short *unicode; - size_t varIndex; - int size, option, i; - Tcl_WideInt length; + Tcl_Size size, varIndex; + int option, i; + Tcl_Size length; #define MAX_STRINGS 11 const char *string, *strings[MAX_STRINGS+1]; String *strPtr; @@ -1291,7 +1291,7 @@ TeststringobjCmd( if (objc != 5) { goto wrongNumArgs; } - if (Tcl_GetWideIntFromObj(interp, objv[4], &length) != TCL_OK) { + if (Tcl_GetIntForIndex(interp, objv[4], TCL_INDEX_NONE, &length) != TCL_OK) { return TCL_ERROR; } if (varPtr[varIndex] == NULL) { @@ -1353,7 +1353,7 @@ TeststringobjCmd( if (CheckIfVarUnset(interp, varPtr, varIndex)) { return TCL_ERROR; } - Tcl_AppendToObj(Tcl_GetObjResult(interp), Tcl_GetString(varPtr[varIndex]), -1); + Tcl_AppendToObj(Tcl_GetObjResult(interp), Tcl_GetString(varPtr[varIndex]), TCL_INDEX_NONE); break; case 4: /* length */ if (objc != 3) { @@ -1413,7 +1413,7 @@ TeststringobjCmd( if (objc != 4) { goto wrongNumArgs; } - if (Tcl_GetWideIntFromObj(interp, objv[3], &length) != TCL_OK) { + if (Tcl_GetIntForIndex(interp, objv[3], TCL_INDEX_NONE, &length) != TCL_OK) { return TCL_ERROR; } if (varPtr[varIndex] != NULL) { @@ -1439,12 +1439,12 @@ TeststringobjCmd( Tcl_SetWideIntObj(Tcl_GetObjResult(interp), length); break; case 10: { /* range */ - int first, last; + Tcl_Size first, last; if (objc != 5) { goto wrongNumArgs; } - if ((Tcl_GetIntFromObj(interp, objv[3], &first) != TCL_OK) - || (Tcl_GetIntFromObj(interp, objv[4], &last) != TCL_OK)) { + if ((Tcl_GetIntForIndex(interp, objv[3], TCL_INDEX_NONE, &first) != TCL_OK) + || (Tcl_GetIntForIndex(interp, objv[4], TCL_INDEX_NONE, &last) != TCL_OK)) { return TCL_ERROR; } Tcl_SetObjResult(interp, Tcl_GetRange(varPtr[varIndex], first, last)); @@ -1469,12 +1469,12 @@ TeststringobjCmd( string = Tcl_GetStringFromObj(varPtr[varIndex], &size); - if (Tcl_GetWideIntFromObj(interp, objv[3], &length) != TCL_OK) { + if (Tcl_GetIntForIndex(interp, objv[3], size-1, &length) != TCL_OK) { return TCL_ERROR; } - if ((length < 0) || (length > size)) { + if (length == TCL_INDEX_NONE) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "index value out of range", -1)); + "index value out of range", TCL_INDEX_NONE)); return TCL_ERROR; } @@ -1500,12 +1500,12 @@ TeststringobjCmd( unicode = Tcl_GetUnicodeFromObj(varPtr[varIndex], &size); - if (Tcl_GetWideIntFromObj(interp, objv[3], &length) != TCL_OK) { + if (Tcl_GetIntForIndex(interp, objv[3], size-1, &length) != TCL_OK) { return TCL_ERROR; } - if ((length < 0) || (length > size)) { + if (length == TCL_INDEX_NONE) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "index value out of range", -1)); + "index value out of range", TCL_INDEX_NONE)); return TCL_ERROR; } @@ -1513,7 +1513,7 @@ TeststringobjCmd( Tcl_SetObjResult(interp, varPtr[varIndex]); break; case 13: /* newunicode*/ - unicode = (unsigned short *) ckalloc((objc - 3) * sizeof(unsigned short)); + unicode = (unsigned short *) ckalloc(((unsigned)objc - 3) * sizeof(unsigned short)); for (i = 0; i < (objc - 3); ++i) { int val; if (Tcl_GetIntFromObj(interp, objv[i + 3], &val) != TCL_OK) { @@ -1529,7 +1529,7 @@ TeststringobjCmd( Tcl_SetObjResult(interp, varPtr[varIndex]); ckfree(unicode); break; - } + } return TCL_OK; } @@ -1556,7 +1556,7 @@ TeststringobjCmd( static void SetVarToObj( Tcl_Obj **varPtr, - size_t varIndex, /* Designates the assignment variable. */ + Tcl_Size varIndex, /* Designates the assignment variable. */ Tcl_Obj *objPtr) /* Points to object to assign to var. */ { if (varPtr[varIndex] != NULL) { @@ -1590,16 +1590,16 @@ GetVariableIndex( Tcl_Obj *obj, /* The variable index * specified as a nonnegative number less than * NUMBER_OF_OBJECT_VARS. */ - size_t *indexPtr) /* Place to store converted result. */ + Tcl_Size *indexPtr) /* Place to store converted result. */ { - Tcl_WideInt index; + Tcl_Size index; - if (Tcl_GetWideIntFromObj(interp, obj, &index) != TCL_OK) { + if (Tcl_GetIntForIndex(interp, obj, NUMBER_OF_OBJECT_VARS - 1, &index) != TCL_OK) { return TCL_ERROR; } - if (index < 0 || index >= NUMBER_OF_OBJECT_VARS) { + if (index == TCL_INDEX_NONE) { Tcl_ResetResult(interp); - Tcl_AppendToObj(Tcl_GetObjResult(interp), "bad variable index", -1); + Tcl_AppendToObj(Tcl_GetObjResult(interp), "bad variable index", TCL_INDEX_NONE); return TCL_ERROR; } @@ -1629,14 +1629,14 @@ static int CheckIfVarUnset( Tcl_Interp *interp, /* Interpreter for error reporting. */ Tcl_Obj ** varPtr, - size_t varIndex) /* Index of the test variable to check. */ + Tcl_Size varIndex) /* Index of the test variable to check. */ { if (varPtr[varIndex] == NULL) { char buf[32 + TCL_INTEGER_SPACE]; - snprintf(buf, sizeof(buf), "variable %" TCL_Z_MODIFIER "u is unset (NULL)", varIndex); + snprintf(buf, sizeof(buf), "variable %d is unset (NULL)", varIndex); Tcl_ResetResult(interp); - Tcl_AppendToObj(Tcl_GetObjResult(interp), buf, -1); + Tcl_AppendToObj(Tcl_GetObjResult(interp), buf, TCL_INDEX_NONE); return 1; } return 0; -- cgit v0.12 From fc9cd641eb779a5038416f122c6d0da0949cbbcb Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 5 Apr 2023 16:05:36 +0000 Subject: Make sure that infoPtr->validMask only contains TCL_READABLE|TCL_WRITABLE|TCL_EXCEPTION, no other flags --- win/tclWinChan.c | 6 +++--- win/tclWinSerial.c | 2 +- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/win/tclWinChan.c b/win/tclWinChan.c index 8a4db89..93596ee 100644 --- a/win/tclWinChan.c +++ b/win/tclWinChan.c @@ -1092,7 +1092,7 @@ Tcl_MakeFileChannel( TclFile readFile = NULL, writeFile = NULL; BOOL result; - if (mode == 0) { + if ((mode & (TCL_READABLE|TCL_WRITABLE)) == 0) { return NULL; } @@ -1375,7 +1375,7 @@ OpenFileChannel( for (infoPtr = tsdPtr->firstFilePtr; infoPtr != NULL; infoPtr = infoPtr->nextPtr) { if (infoPtr->handle == (HANDLE) handle) { - return (permissions==infoPtr->validMask) ? infoPtr->channel : NULL; + return ((permissions & (TCL_READABLE|TCL_WRITABLE|TCL_EXCEPTION))==infoPtr->validMask) ? infoPtr->channel : NULL; } } @@ -1388,7 +1388,7 @@ OpenFileChannel( */ infoPtr->nextPtr = NULL; - infoPtr->validMask = permissions; + infoPtr->validMask = permissions & (TCL_READABLE|TCL_WRITABLE|TCL_EXCEPTION); infoPtr->watchMask = 0; infoPtr->flags = appendMode; infoPtr->handle = handle; diff --git a/win/tclWinSerial.c b/win/tclWinSerial.c index 62af1c5..a55a23f 100644 --- a/win/tclWinSerial.c +++ b/win/tclWinSerial.c @@ -1458,7 +1458,7 @@ TclWinOpenSerialChannel( infoPtr = (SerialInfo *)ckalloc(sizeof(SerialInfo)); memset(infoPtr, 0, sizeof(SerialInfo)); - infoPtr->validMask = permissions; + infoPtr->validMask = permissions & (TCL_READABLE|TCL_WRITABLE); infoPtr->handle = handle; infoPtr->channel = (Tcl_Channel) NULL; infoPtr->readable = 0; -- cgit v0.12 From 9deff281ee0c1e768b0662466e61b8894fb9d54a Mon Sep 17 00:00:00 2001 From: apnadkarni Date: Wed, 5 Apr 2023 17:04:05 +0000 Subject: TIP 602 - update manpages --- doc/FileSystem.3 | 18 ++---------------- doc/Translate.3 | 3 +-- doc/cd.n | 2 +- doc/cookiejar.n | 4 ++-- doc/exec.n | 2 +- doc/file.n | 7 ++----- doc/glob.n | 22 +++------------------- doc/tclvars.n | 10 +++++----- 8 files changed, 17 insertions(+), 51 deletions(-) diff --git a/doc/FileSystem.3 b/doc/FileSystem.3 index 469af22..3387f50 100644 --- a/doc/FileSystem.3 +++ b/doc/FileSystem.3 @@ -678,11 +678,6 @@ of zero, they will be freed when this function returns. \fBTcl_FSConvertToPathType\fR tries to convert the given Tcl_Obj to a valid Tcl path type, taking account of the fact that the cwd may have changed even if this value is already supposedly of the correct type. -The filename may begin with -.QW ~ -(to indicate current user's home directory) or -.QW ~ -(to indicate any user's home directory). .PP If the conversion succeeds (i.e.\ the value is a valid path in one of the current filesystems), then \fBTCL_OK\fR is returned. Otherwise @@ -704,14 +699,7 @@ from the given Tcl_Obj. .PP If the translation succeeds (i.e.\ the value is a valid path), then it is returned. Otherwise NULL will be returned, and an error message may be -left in the interpreter. A -.QW translated -path is one which contains no -.QW ~ -or -.QW ~user -sequences (these have been expanded to their current -representation in the filesystem). The value returned is owned by the +left in the interpreter. The value returned is owned by the caller, which must store it or call \fBTcl_DecrRefCount\fR to ensure memory is freed. This function is of little practical use, and \fBTcl_FSGetNormalizedPath\fR or \fBTcl_FSGetNativePath\fR are usually @@ -1068,9 +1056,7 @@ must have a single unique string representation. Depending on the filesystem, there may be more than one unnormalized string representation which refers to that path (e.g.\ a relative path, a path with different -character case if the filesystem is case insensitive, a path contain a -reference to a home directory such as -.QW ~ , +character case if the filesystem is case insensitive, a path containing symbolic links, etc). If the very last component in the path is a symbolic link, it should not be converted into the value it points to (but diff --git a/doc/Translate.3 b/doc/Translate.3 index 256baec..e7668eb 100644 --- a/doc/Translate.3 +++ b/doc/Translate.3 @@ -21,8 +21,7 @@ char * .AP Tcl_Interp *interp in Interpreter in which to report an error, if any. .AP "const char" *name in -File name, which may start with a -.QW ~ . +File name .AP Tcl_DString *bufferPtr in/out If needed, this dynamic string is used to store the new file name. At the time of the call it should be uninitialized or free. The diff --git a/doc/cd.n b/doc/cd.n index 4cd4792..c6d8527 100644 --- a/doc/cd.n +++ b/doc/cd.n @@ -28,7 +28,7 @@ and all threads. Change to the home directory of the user \fBfred\fR: .PP .CS -\fBcd\fR ~fred +\fBcd\fR [file home fred] .CE .PP Change to the directory \fBlib\fR that is a sibling directory of the diff --git a/doc/cookiejar.n b/doc/cookiejar.n index 7d2f46b..1391e01 100644 --- a/doc/cookiejar.n +++ b/doc/cookiejar.n @@ -178,7 +178,7 @@ the start of the application. package require http \fBpackage require cookiejar\fR -set cookiedb ~/.tclcookies.db +set cookiedb [file join [file home] cookiejar] http::configure -cookiejar [\fBhttp::cookiejar new\fR $cookiedb] # No further explicit steps are required to use cookies @@ -201,7 +201,7 @@ oo::class create MyCookieJar { } } -set cookiedb ~/.tclcookies.db +set cookiedb [file join [file home] cookiejar] http::configure -cookiejar [MyCookieJar new $cookiedb] # No further explicit steps are required to use cookies diff --git a/doc/exec.n b/doc/exec.n index 1f87818..9421eb1 100644 --- a/doc/exec.n +++ b/doc/exec.n @@ -449,7 +449,7 @@ encrypted so that only the current user can access it requires use of the \fICIPHER\fR command, like this: .PP .CS -set secureDir "~/Desktop/Secure Directory" +set secureDir [file join [file home] Desktop/SecureDirectory] file mkdir $secureDir \fBexec\fR CIPHER /e /s:[file nativename $secureDir] .CE diff --git a/doc/file.n b/doc/file.n index 5a064af..ff581c9 100644 --- a/doc/file.n +++ b/doc/file.n @@ -242,10 +242,7 @@ must be relative to the actual \fIlinkName\fR's location (not to the cwd), but on all other platforms where relative links are not supported, target paths will always be converted to absolute, normalized form before the link is created (and therefore relative paths are interpreted -as relative to the cwd). Furthermore, -.QW ~user -paths are always expanded -to absolute form. When creating links on filesystems that either do not +as relative to the cwd). When creating links on filesystems that either do not support any links, or do not support the specific type requested, an error message will be returned. Most Unix platforms support both symbolic and hard links (the latter for files only). Windows @@ -571,7 +568,7 @@ interface) but the name passed to the operating system must be in native format: .PP .CS -exec {*}[auto_execok start] {} [\fBfile nativename\fR ~/example.txt] +exec {*}[auto_execok start] {} [\fBfile nativename\fR C:/Users/fred/example.txt] .CE .SH "SEE ALSO" filename(n), open(n), close(n), eof(n), gets(n), tell(n), seek(n), diff --git a/doc/glob.n b/doc/glob.n index 80610f7..b19e47f 100644 --- a/doc/glob.n +++ b/doc/glob.n @@ -72,7 +72,7 @@ is equivalent to .QW "\fBset pwd [pwd]; cd $dir; glob *; cd $pwd\fR" . For \fB\-path\fR specifications, the returned names will include the last path segment, so -.QW "\fBglob \-tails \-path [file rootname ~/foo.tex] .*\fR" +.QW "\fBglob \-tails \-path [file rootname /home/fred/foo.tex] .*\fR" will return paths like \fBfoo.aux foo.bib foo.tex\fR etc. .TP \fB\-types\fR \fItypeList\fR @@ -168,16 +168,6 @@ which must be matched explicitly (this is to avoid a recursive pattern like from recursing up the directory hierarchy as well as down). In addition, all .QW / characters must be matched explicitly. -.LP -If the first character in a \fIpattern\fR is -.QW ~ -then it refers to the home directory for the user whose name follows the -.QW ~ . -If the -.QW ~ -is followed immediately by -.QW / -then the value of the HOME environment variable is used. .PP The \fBglob\fR command differs from csh globbing in two ways. First, it does not sort its result list (use the \fBlsort\fR @@ -188,13 +178,7 @@ contains a ?, *, or [] construct. .SH "WINDOWS PORTABILITY ISSUES" .PP For Windows UNC names, the servername and sharename components of the path -may not contain ?, *, or [] constructs. On Windows NT, if \fIpattern\fR is -of the form -.QW \fB~\fIusername\fB@\fIdomain\fR , -it refers to the home -directory of the user whose account information resides on the specified NT -domain server. Otherwise, user account information is obtained from -the local computer. +may not contain ?, *, or [] constructs. .PP Since the backslash character has a special meaning to the glob command, glob patterns containing Windows style path separators need @@ -229,7 +213,7 @@ Find all the Tcl files in the user's home directory, irrespective of what the current directory is: .PP .CS -\fBglob\fR \-directory ~ *.tcl +\fBglob\fR \-directory [file home] *.tcl .CE .PP Find all subdirectories of the current directory: diff --git a/doc/tclvars.n b/doc/tclvars.n index 8214473..d244953 100644 --- a/doc/tclvars.n +++ b/doc/tclvars.n @@ -73,11 +73,11 @@ The following elements of \fBenv\fR are special to Tcl: \fBenv(HOME)\fR . This environment variable, if set, gives the location of the directory -considered to be the current user's home directory, and to which a -call of \fBcd\fR without arguments or with just -.QW ~ -as an argument will change into. Most platforms set this correctly by -default; it does not normally need to be set by user code. +considered to be the current user's home directory. The value of this variable +is returned by the \fBfile home\fR command. Most platforms set this correctly by +default; it does not normally need to be set by user code. On Windows, if not +already set, it is set to the value of the \fBUSERPROFILE\fR environment +variable. .TP \fBenv(TCL_LIBRARY)\fR . -- cgit v0.12 From 1c1cbe4444dd361c05d21208a775bbaca087a142 Mon Sep 17 00:00:00 2001 From: pooryorick Date: Thu, 6 Apr 2023 10:03:49 +0000 Subject: Further fix for [fa3d9fd818fa0072]. In ChannelState.encoding, NULL no longer represents the binary encoding. --- generic/tclIO.c | 74 +++++++++++++++++++++++++------------------------------ tests/chanio.test | 5 ++-- tests/io.test | 58 ++++++++++++++++++++++++++++++------------- tests/ioCmd.test | 3 ++- tests/zlib.test | 4 +-- 5 files changed, 82 insertions(+), 62 deletions(-) diff --git a/generic/tclIO.c b/generic/tclIO.c index a45f39a..cea8119 100644 --- a/generic/tclIO.c +++ b/generic/tclIO.c @@ -1675,11 +1675,8 @@ Tcl_CreateChannel( * interpretation that Tcl_Channels give to the "-encoding binary" option. */ - statePtr->encoding = NULL; name = Tcl_GetEncodingName(NULL); - if (strcmp(name, "binary") != 0) { - statePtr->encoding = Tcl_GetEncoding(NULL, name); - } + statePtr->encoding = Tcl_GetEncoding(NULL, name); statePtr->inputEncodingState = NULL; statePtr->inputEncodingFlags = TCL_ENCODING_START; CHANNEL_PROFILE_SET(statePtr->inputEncodingFlags, @@ -3480,7 +3477,8 @@ TclClose( stickyError = 0; - if (GotFlag(statePtr, TCL_WRITABLE) && (statePtr->encoding != NULL) + if (GotFlag(statePtr, TCL_WRITABLE) + && (statePtr->encoding != GetBinaryEncoding()) && !(statePtr->outputEncodingFlags & TCL_ENCODING_START)) { int code = CheckChannelErrors(statePtr, TCL_WRITABLE); @@ -4269,11 +4267,7 @@ Tcl_WriteObj( do { int chunkSize = srcLen > INT_MAX ? INT_MAX : srcLen; int written; - if (statePtr->encoding == NULL) { - written = WriteBytes(chanPtr, src, chunkSize); - } else { - written = WriteChars(chanPtr, src, chunkSize); - } + written = WriteChars(chanPtr, src, chunkSize); if (written < 0) { return TCL_INDEX_NONE; } @@ -4651,7 +4645,7 @@ Tcl_GetsObj( * done on objPtr. */ - if ((statePtr->encoding == NULL) + if (statePtr->encoding == GetBinaryEncoding() && ((statePtr->inputTranslation == TCL_TRANSLATE_LF) || (statePtr->inputTranslation == TCL_TRANSLATE_CR)) && Tcl_GetByteArrayFromObj(objPtr, (size_t *)NULL) != NULL) { @@ -4682,15 +4676,6 @@ Tcl_GetsObj( } /* - * If there is no encoding, use "iso8859-1" -- Tcl_GetsObj() doesn't - * produce ByteArray objects. - */ - - if (encoding == NULL) { - encoding = GetBinaryEncoding(); - } - - /* * Object used by FilterInputBytes to keep track of how much data has been * consumed from the channel buffers. */ @@ -5236,7 +5221,7 @@ TclGetsObjBinary( * XXX - unimplemented. */ - if (statePtr->encoding != NULL) { + if (statePtr->encoding != GetBinaryEncoding()) { } /* @@ -5951,7 +5936,7 @@ DoReadChars( #define UTF_EXPANSION_FACTOR 1024 int factor = UTF_EXPANSION_FACTOR; - binaryMode = (encoding == NULL) + binaryMode = (encoding == GetBinaryEncoding()) && (statePtr->inputTranslation == TCL_TRANSLATE_LF) && (statePtr->inEofChar == '\0'); @@ -6244,8 +6229,7 @@ ReadChars( * UTF-8. On output, contains another guess * based on the data seen so far. */ { - Tcl_Encoding encoding = statePtr->encoding? statePtr->encoding - : GetBinaryEncoding(); + Tcl_Encoding encoding = statePtr->encoding; Tcl_EncodingState savedState = statePtr->inputEncodingState; ChannelBuffer *bufPtr = statePtr->inQueueHead; int savedIEFlags = statePtr->inputEncodingFlags; @@ -7971,12 +7955,8 @@ Tcl_GetChannelOption( if (len == 0) { Tcl_DStringAppendElement(dsPtr, "-encoding"); } - if (statePtr->encoding == NULL) { - Tcl_DStringAppendElement(dsPtr, "binary"); - } else { - Tcl_DStringAppendElement(dsPtr, - Tcl_GetEncodingName(statePtr->encoding)); - } + Tcl_DStringAppendElement(dsPtr, + Tcl_GetEncodingName(statePtr->encoding)); if (len > 0) { return TCL_OK; } @@ -8196,7 +8176,13 @@ Tcl_SetChannelOption( int profile; if ((newValue[0] == '\0') || (strcmp(newValue, "binary") == 0)) { - encoding = NULL; + encoding = Tcl_GetEncoding(NULL, "iso8859-1"); + CHANNEL_PROFILE_SET(statePtr->inputEncodingFlags + ,CHANNEL_PROFILE_GET(statePtr->inputEncodingFlags) + |TCL_ENCODING_PROFILE_STRICT); + CHANNEL_PROFILE_SET(statePtr->outputEncodingFlags + ,CHANNEL_PROFILE_GET(statePtr->outputEncodingFlags) + |TCL_ENCODING_PROFILE_STRICT); } else { encoding = Tcl_GetEncoding(interp, newValue); if (encoding == NULL) { @@ -8209,7 +8195,7 @@ Tcl_SetChannelOption( * iso2022, the terminated escape sequence must write to the buffer. */ - if ((statePtr->encoding != NULL) + if ((statePtr->encoding != GetBinaryEncoding()) && !(statePtr->outputEncodingFlags & TCL_ENCODING_START) && (CheckChannelErrors(statePtr, TCL_WRITABLE) == 0)) { statePtr->outputEncodingFlags |= TCL_ENCODING_END; @@ -8304,7 +8290,13 @@ Tcl_SetChannelOption( translation = TCL_TRANSLATE_LF; statePtr->inEofChar = 0; Tcl_FreeEncoding(statePtr->encoding); - statePtr->encoding = NULL; + statePtr->encoding = Tcl_GetEncoding(NULL, "iso8859-1"); + CHANNEL_PROFILE_SET(statePtr->inputEncodingFlags + ,CHANNEL_PROFILE_GET(statePtr->inputEncodingFlags) + |TCL_ENCODING_PROFILE_STRICT); + CHANNEL_PROFILE_SET(statePtr->outputEncodingFlags + ,CHANNEL_PROFILE_GET(statePtr->outputEncodingFlags) + |TCL_ENCODING_PROFILE_STRICT); } else if (strcmp(readMode, "lf") == 0) { translation = TCL_TRANSLATE_LF; } else if (strcmp(readMode, "cr") == 0) { @@ -8353,7 +8345,13 @@ Tcl_SetChannelOption( } else if (strcmp(writeMode, "binary") == 0) { statePtr->outputTranslation = TCL_TRANSLATE_LF; Tcl_FreeEncoding(statePtr->encoding); - statePtr->encoding = NULL; + statePtr->encoding = Tcl_GetEncoding(NULL, "iso8859-1"); + CHANNEL_PROFILE_SET(statePtr->inputEncodingFlags + ,CHANNEL_PROFILE_GET(statePtr->inputEncodingFlags) + |TCL_ENCODING_PROFILE_STRICT); + CHANNEL_PROFILE_SET(statePtr->outputEncodingFlags + ,CHANNEL_PROFILE_GET(statePtr->outputEncodingFlags) + |TCL_ENCODING_PROFILE_STRICT); } else if (strcmp(writeMode, "lf") == 0) { statePtr->outputTranslation = TCL_TRANSLATE_LF; } else if (strcmp(writeMode, "cr") == 0) { @@ -10271,13 +10269,9 @@ Lossless( && outStatePtr->outputTranslation == TCL_TRANSLATE_LF && ( ( - (inStatePtr->encoding == NULL - || inStatePtr->encoding == GetBinaryEncoding() - ) + inStatePtr->encoding == GetBinaryEncoding() && - (outStatePtr->encoding == NULL - || outStatePtr->encoding == GetBinaryEncoding() - ) + outStatePtr->encoding == GetBinaryEncoding() ) || ( diff --git a/tests/chanio.test b/tests/chanio.test index c3caa1c..d13aaab 100644 --- a/tests/chanio.test +++ b/tests/chanio.test @@ -6868,7 +6868,7 @@ test chan-io-52.9 {TclCopyChannel & encodings} {fcopy} { [file size $path(utf8-fcopy.txt)] \ [file size $path(utf8-rp.txt)] } {3 5 5} -test chan-io-52.10 {TclCopyChannel & encodings} {fcopy notWinCI} { +test chan-io-52.10 {TclCopyChannel & encodings} -constraints {fcopy} -body { # encoding to binary (=> implies that the internal utf-8 is written) set in [open $path(kyrillic.txt) r] set out [open $path(utf8-fcopy.txt) w] @@ -6879,7 +6879,8 @@ test chan-io-52.10 {TclCopyChannel & encodings} {fcopy notWinCI} { chan close $in chan close $out file size $path(utf8-fcopy.txt) -} 5 +} -returnCodes 1 -match glob -result {error writing "*":\ + invalid or incomplete multibyte or wide character} test chan-io-52.11 {TclCopyChannel & encodings} -setup { set f [open $path(utf8-fcopy.txt) w] fconfigure $f -encoding utf-8 -translation lf diff --git a/tests/io.test b/tests/io.test index 5fd255c..fe0a580 100644 --- a/tests/io.test +++ b/tests/io.test @@ -7500,7 +7500,7 @@ test io-52.9 {TclCopyChannel & encodings} {fcopy} { [file size $path(utf8-fcopy.txt)] \ [file size $path(utf8-rp.txt)] } {3 5 5} -test io-52.10 {TclCopyChannel & encodings} {fcopy notWinCI} { +test io-52.10 {TclCopyChannel & encodings} -constraints fcopy -body { # encoding to binary (=> implies that the # internal utf-8 is written) @@ -7516,7 +7516,8 @@ test io-52.10 {TclCopyChannel & encodings} {fcopy notWinCI} { close $out file size $path(utf8-fcopy.txt) -} 5 +} -returnCodes 1 -match glob -result {error writing "*":\ + invalid or incomplete multibyte or wide character} test io-52.11 {TclCopyChannel & encodings} -setup { set out [open $path(utf8-fcopy.txt) w] fconfigure $out -encoding utf-8 -translation lf -profile strict @@ -8374,7 +8375,7 @@ test io-53.13 {TclCopyChannel: read error reporting} -setup { catch {close $out} removeFile out rename driver {} -} -result {error reading "*": *} -returnCodes error -match glob +} -result {error reading "rc*": *} -returnCodes error -match glob test io-53.14 {TclCopyChannel: write error reporting} -setup { proc driver {cmd args} { variable buffer @@ -9264,7 +9265,7 @@ test io-75.5 {invalid utf-8 encoding read is ignored (-profile tcl8)} -setup { removeFile io-75.5 } -result 4181 -test io-75.6 {invalid utf-8 encoding gets is not ignored (-profile strict)} -setup { +test io-75.6 {invalid utf-8 encoding, gets is not ignored (-profile strict)} -setup { set fn [makeFile {} io-75.6] set f [open $fn w+] fconfigure $f -encoding binary @@ -9278,7 +9279,8 @@ test io-75.6 {invalid utf-8 encoding gets is not ignored (-profile strict)} -set } -cleanup { close $f removeFile io-75.6 -} -match glob -returnCodes 1 -result {error reading "*": invalid or incomplete multibyte or wide character} +} -match glob -returnCodes 1 -result {error reading "file*":\ + invalid or incomplete multibyte or wide character} test io-75.7 {invalid utf-8 encoding gets is not ignored (-profile strict)} -setup { set fn [makeFile {} io-75.7] @@ -9294,7 +9296,8 @@ test io-75.7 {invalid utf-8 encoding gets is not ignored (-profile strict)} -set } -cleanup { close $f removeFile io-75.7 -} -match glob -returnCodes 1 -result {error reading "*": invalid or incomplete multibyte or wide character} +} -match glob -returnCodes 1 -result {error reading "file*":\ + invalid or incomplete multibyte or wide character} test io-75.8 {invalid utf-8 encoding eof handling (-profile strict)} -setup { set fn [makeFile {} io-75.8] @@ -9330,10 +9333,11 @@ test io-75.9 {unrepresentable character write passes and is replaced by ?} -setu removeFile io-75.9 } -match glob -result [list {A} {error writing "*": invalid or incomplete multibyte or wide character}] -# Incomplete sequence test. -# This error may IMHO only be detected with the close. -# But the read already returns the incomplete sequence. -test io-75.10 {incomplete multibyte encoding read is ignored} -setup { +test io-75.10 { + incomplete multibyte encoding read is not ignored because "binary" sets + profile to strict +} -setup { + set res {} set fn [makeFile {} io-75.10] set f [open $fn w+] fconfigure $f -encoding binary @@ -9342,13 +9346,21 @@ test io-75.10 {incomplete multibyte encoding read is ignored} -setup { seek $f 0 fconfigure $f -encoding utf-8 -buffering none } -body { + catch {read $f} errmsg + lappend res $errmsg + seek $f 0 + chan configure $f -profile tcl8 set d [read $f] binary scan $d H* hd - set hd + lappend res $hd + return $res } -cleanup { close $f removeFile io-75.10 -} -result 41c0 + unset result +} -match glob -result {{error reading "file*":\ + invalid or incomplete multibyte or wide character} 41c0} + # The current result returns the orphan byte as byte. # This may be expected due to special utf-8 handling. @@ -9372,9 +9384,14 @@ test io-75.11 {shiftjis encoding error read results in raw bytes} -setup { } -cleanup { close $f removeFile io-75.11 -} -match glob -result {41 1 {error reading "*": invalid or incomplete multibyte or wide character}} +} -match glob -result {41 1 {error reading "file*":\ + invalid or incomplete multibyte or wide character}} -test io-75.12 {invalid utf-8 encoding read is ignored} -setup { +test io-75.12 { + invalid utf-8 encoding read is not ignored because setting the encoding to + "binary" also set the profile to strict +} -setup { + set res {} set fn [makeFile {} io-75.12] set f [open $fn w+] fconfigure $f -encoding binary @@ -9383,13 +9400,20 @@ test io-75.12 {invalid utf-8 encoding read is ignored} -setup { seek $f 0 fconfigure $f -encoding utf-8 -buffering none -eofchar "" -translation lf } -body { + catch {read $f} errmsg + lappend res $errmsg + chan configure $f -profile tcl8 + seek $f 0 set d [read $f] binary scan $d H* hd - set hd + lappend res $hd + return $res } -cleanup { close $f removeFile io-75.12 -} -result 4181 + unset res +} -match glob -result {{error reading "file*":\ + invalid or incomplete multibyte or wide character} 4181} test io-75.13 {invalid utf-8 encoding read is not ignored (-profile strict)} -setup { set fn [makeFile {} io-75.13] set f [open $fn w+] @@ -9407,7 +9431,7 @@ test io-75.13 {invalid utf-8 encoding read is not ignored (-profile strict)} -se } -cleanup { close $f removeFile io-75.13 -} -match glob -result {41 1 {error reading "*": invalid or incomplete multibyte or wide character}} +} -match glob -result {41 1 {error reading "file*": invalid or incomplete multibyte or wide character}} # ### ### ### ######### ######### ######### diff --git a/tests/ioCmd.test b/tests/ioCmd.test index cab4745..2df2ca0 100644 --- a/tests/ioCmd.test +++ b/tests/ioCmd.test @@ -266,7 +266,7 @@ test iocmd-8.9 {fconfigure command} -setup { fconfigure $f1 } -cleanup { catch {close $f1} -} -result {-blocking 1 -buffering none -buffersize 4040 -encoding binary -eofchar {} -profile tcl8 -translation lf} +} -result {-blocking 1 -buffering none -buffersize 4040 -encoding iso8859-1 -eofchar {} -profile tcl8 -translation lf} test iocmd-8.10 {fconfigure command} -returnCodes error -body { fconfigure a b } -result {can not find channel named "a"} @@ -496,6 +496,7 @@ test iocmd-12.10 {POSIX open access modes: BINARY} { set result } 5 test iocmd-12.11 {POSIX open access modes: BINARY} -body { + after 100 set f [open $path(test1) {WRONLY BINARY TRUNC}] puts $f Ɉ ;# throws an exception } -cleanup { diff --git a/tests/zlib.test b/tests/zlib.test index 720fdd6..93c568b 100644 --- a/tests/zlib.test +++ b/tests/zlib.test @@ -292,7 +292,7 @@ test zlib-8.6 {transformation and fconfigure} -setup { } -cleanup { catch {close $fd} removeFile $file -} -result {{-blocking 1 -buffering full -buffersize 4096 -encoding binary -eofchar {} -profile tcl8 -translation lf} {-blocking 1 -buffering full -buffersize 4096 -encoding binary -eofchar {} -profile tcl8 -translation lf -checksum 1 -dictionary {}} {-blocking 1 -buffering full -buffersize 4096 -encoding binary -eofchar {} -profile tcl8 -translation lf}} +} -result {{-blocking 1 -buffering full -buffersize 4096 -encoding iso8859-1 -eofchar {} -profile strict -translation lf} {-blocking 1 -buffering full -buffersize 4096 -encoding iso8859-1 -eofchar {} -profile strict -translation lf -checksum 1 -dictionary {}} {-blocking 1 -buffering full -buffersize 4096 -encoding iso8859-1 -eofchar {} -profile strict -translation lf}} test zlib-8.7 {transformation and fconfigure} -setup { set file [makeFile {} test.gz] set fd [open $file wb] @@ -302,7 +302,7 @@ test zlib-8.7 {transformation and fconfigure} -setup { } -cleanup { catch {close $fd} removeFile $file -} -result {{-blocking 1 -buffering full -buffersize 4096 -encoding binary -eofchar {} -profile tcl8 -translation lf} {-blocking 1 -buffering full -buffersize 4096 -encoding binary -eofchar {} -profile tcl8 -translation lf -checksum 0} {-blocking 1 -buffering full -buffersize 4096 -encoding binary -eofchar {} -profile tcl8 -translation lf}} +} -result {{-blocking 1 -buffering full -buffersize 4096 -encoding iso8859-1 -eofchar {} -profile strict -translation lf} {-blocking 1 -buffering full -buffersize 4096 -encoding iso8859-1 -eofchar {} -profile strict -translation lf -checksum 0} {-blocking 1 -buffering full -buffersize 4096 -encoding iso8859-1 -eofchar {} -profile strict -translation lf}} # Input is headers from fetching SPDY draft # Dictionary is that which is proposed _in_ SPDY draft set spdyHeaders "HTTP/1.0 200 OK\r\nContent-Type: text/html; charset=utf-8\r\nX-Robots-Tag: noarchive\r\nLast-Modified: Tue, 05 Jun 2012 02:43:25 GMT\r\nETag: \"1338864205129|#public|0|en|||0\"\r\nExpires: Tue, 05 Jun 2012 16:17:11 GMT\r\nDate: Tue, 05 Jun 2012 16:17:06 GMT\r\nCache-Control: public, max-age=5\r\nX-Content-Type-Options: nosniff\r\nX-XSS-Protection: 1; mode=block\r\nServer: GSE\r\n" -- cgit v0.12 From 20d27150a6bb99d8549374523861dcf56e0ca299 Mon Sep 17 00:00:00 2001 From: pooryorick Date: Thu, 6 Apr 2023 10:28:19 +0000 Subject: Remove obsolete comments. --- tests/chanio.test | 1 - tests/io.test | 3 --- 2 files changed, 4 deletions(-) diff --git a/tests/chanio.test b/tests/chanio.test index d13aaab..680039c 100644 --- a/tests/chanio.test +++ b/tests/chanio.test @@ -6869,7 +6869,6 @@ test chan-io-52.9 {TclCopyChannel & encodings} {fcopy} { [file size $path(utf8-rp.txt)] } {3 5 5} test chan-io-52.10 {TclCopyChannel & encodings} -constraints {fcopy} -body { - # encoding to binary (=> implies that the internal utf-8 is written) set in [open $path(kyrillic.txt) r] set out [open $path(utf8-fcopy.txt) w] chan configure $in -encoding koi8-r -translation lf diff --git a/tests/io.test b/tests/io.test index fe0a580..444b3de 100644 --- a/tests/io.test +++ b/tests/io.test @@ -7501,9 +7501,6 @@ test io-52.9 {TclCopyChannel & encodings} {fcopy} { [file size $path(utf8-rp.txt)] } {3 5 5} test io-52.10 {TclCopyChannel & encodings} -constraints fcopy -body { - # encoding to binary (=> implies that the - # internal utf-8 is written) - set in [open $path(kyrillic.txt) r] set out [open $path(utf8-fcopy.txt) w] -- cgit v0.12 From edb446d26796467febbd3e23586b19cf12ed9daf Mon Sep 17 00:00:00 2001 From: pooryorick Date: Thu, 6 Apr 2023 12:10:56 +0000 Subject: Update the documentation for [chan] with regard to binary data. --- doc/chan.n | 29 +++++++++++++---------------- 1 file changed, 13 insertions(+), 16 deletions(-) diff --git a/doc/chan.n b/doc/chan.n index 14fa941..62121d1 100644 --- a/doc/chan.n +++ b/doc/chan.n @@ -124,18 +124,8 @@ returned by \fBencoding names\fR, or from Unicode to the encoding. .RS .PP -\fBbinary\fR is an alias for \fBiso8859-1\fR: Each byte read from the -channel becomes the Unicode character having the same value as that byte, and -each character written to the channel becomes a single byte in the output, -allowing Tcl to work seamlessly with binary data as long as each "character" in -the data remains in the range of 0 to 255 so that there is no distinction between -binary data and text. For example, A JPEG image can be read from a -\fBbinary\fR channel, manipulated, and then written back to a \fBbinary\fR -channel. - -For working with binary data \fB\-translation binary\fR is usually used -instead, as it sets the encoding to \fBbinary\fR and also disables other -translations on the channel. +\fBbinary\fR is an alias for \fBiso8859-1\fR. This alone is not sufficient for +working with binary data. Use \fB\-translation binary\fR instead. .PP The encoding of a new channel is the value of \fBencoding system\fR, which returns the platform- and locale-dependent system encoding used to @@ -196,10 +186,17 @@ platforms it is \fBcrlf\fR for both input and output. .TP \fBbinary\fR . -Like \fBlf\fR, no end-of-line translation is performed, but in addition, -\fB\-eofchar\fR is set to the empty string to disable it, and \fB\-encoding\fR -is set to \fBbinary\fR. With this one setting, a channel is fully configured -for binary input and output. +Like \fBlf\fR, no end-of-line translation is performed, but in addition, sets +\fB\-eofchar\fR to the empty string to disable it, sets \fB\-encoding\fR to +\fBiso8859-1\fR, and sets \fB-profile\fR to \fBstrict\fR so the the channel is +fully configured for binary input and output: Each byte read from the channel +becomes the Unicode character having the same value as that byte, and each +character written to the channel becomes a single byte in the output. This +makes it possible to work seamlessly with binary data as long as each character +in the data remains in the range of 0 to 255 so that there is no distinction +between binary data and text. For example, A JPEG image can be read from a +such a channel, manipulated, and then written back to such a channel. + .TP \fBcr\fR . -- cgit v0.12 From 9365f75b619c40e1112a29085e1f491dfcbfc873 Mon Sep 17 00:00:00 2001 From: pointsman Date: Fri, 7 Apr 2023 23:14:20 +0000 Subject: Editorial fix in Tcl_Panic() message. --- generic/tclObj.c | 2 +- generic/tclStringObj.c | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/generic/tclObj.c b/generic/tclObj.c index 9d37fdc..2b21675 100644 --- a/generic/tclObj.c +++ b/generic/tclObj.c @@ -1702,7 +1702,7 @@ TclGetStringFromObj( if (lengthPtr != NULL) { if (objPtr->length > INT_MAX) { Tcl_Panic("Tcl_GetStringFromObj with 'int' lengthPtr" - "cannot handle such long strings. Please use 'size_t'"); + " cannot handle such long strings. Please use 'size_t'"); } *lengthPtr = (int)objPtr->length; } diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c index 959a221..9080d09 100644 --- a/generic/tclStringObj.c +++ b/generic/tclStringObj.c @@ -693,7 +693,7 @@ TclGetUnicodeFromObj( if (lengthPtr != NULL) { if (stringPtr->numChars > INT_MAX) { Tcl_Panic("Tcl_GetUnicodeFromObj with 'int' lengthPtr" - "cannot handle such long strings. Please use 'size_t'"); + " cannot handle such long strings. Please use 'size_t'"); } *lengthPtr = (int)stringPtr->numChars; } -- cgit v0.12