From b9a742cb40113c2ef73661316577162125e8fb22 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Sat, 16 Apr 2022 19:03:50 +0000 Subject: Fix [0061c7a476]: signed integer overflow in ZipReadInt() --- generic/tclZipfs.c | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/generic/tclZipfs.c b/generic/tclZipfs.c index c936a15..61dc615 100644 --- a/generic/tclZipfs.c +++ b/generic/tclZipfs.c @@ -467,7 +467,8 @@ ZipReadInt( Tcl_Panic("out of bounds read(4): start=%p, end=%p, ptr=%p", bufferStart, bufferEnd, ptr); } - return ptr[0] | (ptr[1] << 8) | (ptr[2] << 16) | (ptr[3] << 24); + return ptr[0] | (ptr[1] << 8) | (ptr[2] << 16) | + ((unsigned int)ptr[3] << 24); } static inline unsigned short -- cgit v0.12 From 85e07894dd32b71f4f609a27540b579175eea23a Mon Sep 17 00:00:00 2001 From: pooryorick Date: Wed, 20 Apr 2022 08:49:56 +0000 Subject: Remove some unnecessary buffer reference counting in Write(). The reference counting in FlushChannel() has got it covered. --- generic/tclIO.c | 4 ---- 1 file changed, 4 deletions(-) diff --git a/generic/tclIO.c b/generic/tclIO.c index 92bd91b..aa0a5a6 100644 --- a/generic/tclIO.c +++ b/generic/tclIO.c @@ -4363,7 +4363,6 @@ Write( bufPtr->nextAdded += saved; saved = 0; } - PreserveChannelBuffer(bufPtr); dst = InsertPoint(bufPtr); dstLen = SpaceLeft(bufPtr); @@ -4383,7 +4382,6 @@ Write( * We're reading from invalid/incomplete UTF-8. */ - ReleaseChannelBuffer(bufPtr); if (total == 0) { Tcl_SetErrno(EILSEQ); return -1; @@ -4457,7 +4455,6 @@ Write( if (IsBufferFull(bufPtr)) { if (FlushChannel(NULL, chanPtr, 0) != 0) { - ReleaseChannelBuffer(bufPtr); return -1; } flushed += statePtr->bufSize; @@ -4477,7 +4474,6 @@ Write( needNlFlush = 0; } } - ReleaseChannelBuffer(bufPtr); } if ((flushed < total) && (GotFlag(statePtr, CHANNEL_UNBUFFERED) || (needNlFlush && GotFlag(statePtr, CHANNEL_LINEBUFFERED)))) { -- cgit v0.12 From 652e37d8b556bbf41c7b1fe2dc359bacb2824044 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 20 Apr 2022 09:41:10 +0000 Subject: boolPtr -> intPtr, since Tcl doens't use pointer to bool's (they didn't exist when the API was designed) --- doc/BoolObj.3 | 28 ++++++++++++++-------------- doc/GetInt.3 | 10 ++++------ generic/tcl.decls | 10 +++++----- generic/tclDecls.h | 32 ++++++++++++++++---------------- generic/tclExecute.c | 8 ++++---- generic/tclGet.c | 6 +++--- generic/tclInt.h | 2 +- generic/tclObj.c | 36 ++++++++++++++++++------------------ 8 files changed, 65 insertions(+), 67 deletions(-) diff --git a/doc/BoolObj.3 b/doc/BoolObj.3 index 7268e1f..795c08a 100644 --- a/doc/BoolObj.3 +++ b/doc/BoolObj.3 @@ -15,15 +15,15 @@ Tcl_NewBooleanObj, Tcl_SetBooleanObj, Tcl_GetBooleanFromObj \- store/retrieve bo \fB#include \fR .sp Tcl_Obj * -\fBTcl_NewBooleanObj\fR(\fIboolValue\fR) +\fBTcl_NewBooleanObj\fR(\fIintValue\fR) .sp -\fBTcl_SetBooleanObj\fR(\fIobjPtr, boolValue\fR) +\fBTcl_SetBooleanObj\fR(\fIobjPtr, intValue\fR) .sp int -\fBTcl_GetBooleanFromObj\fR(\fIinterp, objPtr, boolPtr\fR) +\fBTcl_GetBooleanFromObj\fR(\fIinterp, objPtr, intPtr\fR) .SH ARGUMENTS -.AS Tcl_Interp boolValue in/out -.AP int boolValue in +.AS Tcl_Interp intValue in/out +.AP int intValue in Integer value to be stored as a boolean value in a Tcl_Obj. .AP Tcl_Obj *objPtr in/out Points to the Tcl_Obj in which to store, or from which to @@ -32,7 +32,7 @@ retrieve a boolean value. If a boolean value cannot be retrieved, an error message is left in the interpreter's result value unless \fIinterp\fR is NULL. -.AP int *boolPtr out +.AP int *intPtr out Points to place where \fBTcl_GetBooleanFromObj\fR stores the boolean value (0 or 1) obtained from \fIobjPtr\fR. .BE @@ -41,33 +41,33 @@ stores the boolean value (0 or 1) obtained from \fIobjPtr\fR. .PP These procedures are used to pass boolean values to and from Tcl as Tcl_Obj's. When storing a boolean value into a Tcl_Obj, -any non-zero integer value in \fIboolValue\fR is taken to be +any non-zero integer value in \fIintValue\fR is taken to be the boolean value \fB1\fR, and the integer value \fB0\fR is taken to be the boolean value \fB0\fR. .PP \fBTcl_NewBooleanObj\fR creates a new Tcl_Obj, stores the boolean -value \fIboolValue\fR in it, and returns a pointer to the new Tcl_Obj. +value \fIintValue\fR in it, and returns a pointer to the new Tcl_Obj. The new Tcl_Obj has reference count of zero. .PP \fBTcl_SetBooleanObj\fR accepts \fIobjPtr\fR, a pointer to an existing Tcl_Obj, and stores in the Tcl_Obj \fI*objPtr\fR -the boolean value \fIboolValue\fR. This is a write operation +the boolean value \fIintValue\fR. This is a write operation on \fI*objPtr\fR, so \fIobjPtr\fR must be unshared. Attempts to write to a shared Tcl_Obj will panic. A successful write -of \fIboolValue\fR into \fI*objPtr\fR implies the freeing of +of \fIintValue\fR into \fI*objPtr\fR implies the freeing of any former value stored in \fI*objPtr\fR. .PP \fBTcl_GetBooleanFromObj\fR attempts to retrieve a boolean value from the value stored in \fI*objPtr\fR. If \fIobjPtr\fR holds a string value recognized by \fBTcl_GetBoolean\fR, then the recognized boolean value is written at the address given -by \fIboolPtr\fR. +by \fIintPtr\fR. If \fIobjPtr\fR holds any value recognized as a number by Tcl, then if that value is zero a 0 is written at -the address given by \fIboolPtr\fR and if that -value is non-zero a 1 is written at the address given by \fIboolPtr\fR. +the address given by \fIintPtr\fR and if that +value is non-zero a 1 is written at the address given by \fIintPtr\fR. In all cases where a value is written at the address given -by \fIboolPtr\fR, \fBTcl_GetBooleanFromObj\fR returns \fBTCL_OK\fR. +by \fIintPtr\fR, \fBTcl_GetBooleanFromObj\fR returns \fBTCL_OK\fR. If the value of \fIobjPtr\fR does not meet any of the conditions above, then \fBTCL_ERROR\fR is returned and an error message is left in the interpreter's result unless \fIinterp\fR is NULL. diff --git a/doc/GetInt.3 b/doc/GetInt.3 index 5a3304a..1e49528 100644 --- a/doc/GetInt.3 +++ b/doc/GetInt.3 @@ -21,7 +21,7 @@ int \fBTcl_GetDouble\fR(\fIinterp, src, doublePtr\fR) .sp int -\fBTcl_GetBoolean\fR(\fIinterp, src, boolPtr\fR) +\fBTcl_GetBoolean\fR(\fIinterp, src, intPtr\fR) .SH ARGUMENTS .AS Tcl_Interp *doublePtr out .AP Tcl_Interp *interp in @@ -33,8 +33,6 @@ Points to place to store integer value converted from \fIsrc\fR. .AP double *doublePtr out Points to place to store double-precision floating-point value converted from \fIsrc\fR. -.AP int *boolPtr out -Points to place to store boolean value (0 or 1) converted from \fIsrc\fR. .BE .SH DESCRIPTION @@ -48,7 +46,7 @@ third argument. If all goes well, each of the procedures returns \fBTCL_OK\fR. If \fIsrc\fR does not have the proper syntax for the desired type then \fBTCL_ERROR\fR is returned, an error message is left in the interpreter's result, and nothing is stored at *\fIintPtr\fR -or *\fIdoublePtr\fR or *\fIboolPtr\fR. +or *\fIdoublePtr\fR. .PP \fBTcl_GetInt\fR expects \fIsrc\fR to consist of a collection of integer digits, optionally signed and optionally preceded and @@ -91,9 +89,9 @@ inter-digit separator be present. \fBTcl_GetBoolean\fR expects \fIsrc\fR to specify a boolean value. If \fIsrc\fR is any of \fB0\fR, \fBfalse\fR, \fBno\fR, or \fBoff\fR, then \fBTcl_GetBoolean\fR stores a zero -value at \fI*boolPtr\fR. +value at \fI*intPtr\fR. If \fIsrc\fR is any of \fB1\fR, \fBtrue\fR, \fByes\fR, or \fBon\fR, -then 1 is stored at \fI*boolPtr\fR. +then 1 is stored at \fI*intPtr\fR. Any of these values may be abbreviated, and upper-case spellings are also acceptable. diff --git a/generic/tcl.decls b/generic/tcl.decls index b3c3ffc..24d71c8 100644 --- a/generic/tcl.decls +++ b/generic/tcl.decls @@ -105,7 +105,7 @@ declare 21 { int Tcl_DbIsShared(Tcl_Obj *objPtr, const char *file, int line) } declare 22 { - Tcl_Obj *Tcl_DbNewBooleanObj(int boolValue, const char *file, int line) + Tcl_Obj *Tcl_DbNewBooleanObj(int intValue, const char *file, int line) } declare 23 { Tcl_Obj *Tcl_DbNewByteArrayObj(const unsigned char *bytes, int length, @@ -136,11 +136,11 @@ declare 30 { void TclFreeObj(Tcl_Obj *objPtr) } declare 31 { - int Tcl_GetBoolean(Tcl_Interp *interp, const char *src, int *boolPtr) + int Tcl_GetBoolean(Tcl_Interp *interp, const char *src, int *intPtr) } declare 32 { int Tcl_GetBooleanFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, - int *boolPtr) + int *intPtr) } declare 33 { unsigned char *Tcl_GetByteArrayFromObj(Tcl_Obj *objPtr, int *lengthPtr) @@ -199,7 +199,7 @@ declare 48 { int count, int objc, Tcl_Obj *const objv[]) } declare 49 { - Tcl_Obj *Tcl_NewBooleanObj(int boolValue) + Tcl_Obj *Tcl_NewBooleanObj(int intValue) } declare 50 { Tcl_Obj *Tcl_NewByteArrayObj(const unsigned char *bytes, int length) @@ -223,7 +223,7 @@ declare 56 { Tcl_Obj *Tcl_NewStringObj(const char *bytes, int length) } declare 57 { - void Tcl_SetBooleanObj(Tcl_Obj *objPtr, int boolValue) + void Tcl_SetBooleanObj(Tcl_Obj *objPtr, int intValue) } declare 58 { unsigned char *Tcl_SetByteArrayLength(Tcl_Obj *objPtr, int length) diff --git a/generic/tclDecls.h b/generic/tclDecls.h index 2d11df5..f299d50 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -110,7 +110,7 @@ EXTERN void Tcl_DbIncrRefCount(Tcl_Obj *objPtr, const char *file, EXTERN int Tcl_DbIsShared(Tcl_Obj *objPtr, const char *file, int line); /* 22 */ -EXTERN Tcl_Obj * Tcl_DbNewBooleanObj(int boolValue, const char *file, +EXTERN Tcl_Obj * Tcl_DbNewBooleanObj(int intValue, const char *file, int line); /* 23 */ EXTERN Tcl_Obj * Tcl_DbNewByteArrayObj(const unsigned char *bytes, @@ -135,10 +135,10 @@ EXTERN Tcl_Obj * Tcl_DuplicateObj(Tcl_Obj *objPtr); EXTERN void TclFreeObj(Tcl_Obj *objPtr); /* 31 */ EXTERN int Tcl_GetBoolean(Tcl_Interp *interp, const char *src, - int *boolPtr); + int *intPtr); /* 32 */ EXTERN int Tcl_GetBooleanFromObj(Tcl_Interp *interp, - Tcl_Obj *objPtr, int *boolPtr); + Tcl_Obj *objPtr, int *intPtr); /* 33 */ EXTERN unsigned char * Tcl_GetByteArrayFromObj(Tcl_Obj *objPtr, int *lengthPtr); @@ -190,7 +190,7 @@ EXTERN int Tcl_ListObjReplace(Tcl_Interp *interp, Tcl_Obj *listPtr, int first, int count, int objc, Tcl_Obj *const objv[]); /* 49 */ -EXTERN Tcl_Obj * Tcl_NewBooleanObj(int boolValue); +EXTERN Tcl_Obj * Tcl_NewBooleanObj(int intValue); /* 50 */ EXTERN Tcl_Obj * Tcl_NewByteArrayObj(const unsigned char *bytes, int length); @@ -207,7 +207,7 @@ EXTERN Tcl_Obj * Tcl_NewObj(void); /* 56 */ EXTERN Tcl_Obj * Tcl_NewStringObj(const char *bytes, int length); /* 57 */ -EXTERN void Tcl_SetBooleanObj(Tcl_Obj *objPtr, int boolValue); +EXTERN void Tcl_SetBooleanObj(Tcl_Obj *objPtr, int intValue); /* 58 */ EXTERN unsigned char * Tcl_SetByteArrayLength(Tcl_Obj *objPtr, int length); /* 59 */ @@ -1908,7 +1908,7 @@ typedef struct TclStubs { void (*tcl_DbDecrRefCount) (Tcl_Obj *objPtr, const char *file, int line); /* 19 */ void (*tcl_DbIncrRefCount) (Tcl_Obj *objPtr, const char *file, int line); /* 20 */ int (*tcl_DbIsShared) (Tcl_Obj *objPtr, const char *file, int line); /* 21 */ - Tcl_Obj * (*tcl_DbNewBooleanObj) (int boolValue, const char *file, int line); /* 22 */ + Tcl_Obj * (*tcl_DbNewBooleanObj) (int intValue, const char *file, int line); /* 22 */ Tcl_Obj * (*tcl_DbNewByteArrayObj) (const unsigned char *bytes, int length, const char *file, int line); /* 23 */ Tcl_Obj * (*tcl_DbNewDoubleObj) (double doubleValue, const char *file, int line); /* 24 */ Tcl_Obj * (*tcl_DbNewListObj) (int objc, Tcl_Obj *const *objv, const char *file, int line); /* 25 */ @@ -1917,8 +1917,8 @@ typedef struct TclStubs { Tcl_Obj * (*tcl_DbNewStringObj) (const char *bytes, int length, const char *file, int line); /* 28 */ Tcl_Obj * (*tcl_DuplicateObj) (Tcl_Obj *objPtr); /* 29 */ void (*tclFreeObj) (Tcl_Obj *objPtr); /* 30 */ - int (*tcl_GetBoolean) (Tcl_Interp *interp, const char *src, int *boolPtr); /* 31 */ - int (*tcl_GetBooleanFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int *boolPtr); /* 32 */ + int (*tcl_GetBoolean) (Tcl_Interp *interp, const char *src, int *intPtr); /* 31 */ + int (*tcl_GetBooleanFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int *intPtr); /* 32 */ unsigned char * (*tcl_GetByteArrayFromObj) (Tcl_Obj *objPtr, int *lengthPtr); /* 33 */ int (*tcl_GetDouble) (Tcl_Interp *interp, const char *src, double *doublePtr); /* 34 */ int (*tcl_GetDoubleFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, double *doublePtr); /* 35 */ @@ -1935,7 +1935,7 @@ typedef struct TclStubs { int (*tcl_ListObjIndex) (Tcl_Interp *interp, Tcl_Obj *listPtr, int index, Tcl_Obj **objPtrPtr); /* 46 */ int (*tcl_ListObjLength) (Tcl_Interp *interp, Tcl_Obj *listPtr, int *lengthPtr); /* 47 */ int (*tcl_ListObjReplace) (Tcl_Interp *interp, Tcl_Obj *listPtr, int first, int count, int objc, Tcl_Obj *const objv[]); /* 48 */ - Tcl_Obj * (*tcl_NewBooleanObj) (int boolValue); /* 49 */ + Tcl_Obj * (*tcl_NewBooleanObj) (int intValue); /* 49 */ Tcl_Obj * (*tcl_NewByteArrayObj) (const unsigned char *bytes, int length); /* 50 */ Tcl_Obj * (*tcl_NewDoubleObj) (double doubleValue); /* 51 */ Tcl_Obj * (*tcl_NewIntObj) (int intValue); /* 52 */ @@ -1943,7 +1943,7 @@ typedef struct TclStubs { Tcl_Obj * (*tcl_NewLongObj) (long longValue); /* 54 */ Tcl_Obj * (*tcl_NewObj) (void); /* 55 */ Tcl_Obj * (*tcl_NewStringObj) (const char *bytes, int length); /* 56 */ - void (*tcl_SetBooleanObj) (Tcl_Obj *objPtr, int boolValue); /* 57 */ + void (*tcl_SetBooleanObj) (Tcl_Obj *objPtr, int intValue); /* 57 */ unsigned char * (*tcl_SetByteArrayLength) (Tcl_Obj *objPtr, int length); /* 58 */ void (*tcl_SetByteArrayObj) (Tcl_Obj *objPtr, const unsigned char *bytes, int length); /* 59 */ void (*tcl_SetDoubleObj) (Tcl_Obj *objPtr, double doubleValue); /* 60 */ @@ -3957,14 +3957,14 @@ extern const TclStubs *tclStubsPtr; Tcl_GetIndexFromObjStruct(interp, objPtr, tablePtr, \ sizeof(char *), msg, flags, indexPtr) #undef Tcl_NewBooleanObj -#define Tcl_NewBooleanObj(boolValue) \ - Tcl_NewIntObj((boolValue)!=0) +#define Tcl_NewBooleanObj(intValue) \ + Tcl_NewIntObj((intValue)!=0) #undef Tcl_DbNewBooleanObj -#define Tcl_DbNewBooleanObj(boolValue, file, line) \ - Tcl_DbNewLongObj((boolValue)!=0, file, line) +#define Tcl_DbNewBooleanObj(intValue, file, line) \ + Tcl_DbNewLongObj((intValue)!=0, file, line) #undef Tcl_SetBooleanObj -#define Tcl_SetBooleanObj(objPtr, boolValue) \ - Tcl_SetIntObj((objPtr), (boolValue)!=0) +#define Tcl_SetBooleanObj(objPtr, intValue) \ + Tcl_SetIntObj((objPtr), (intValue)!=0) #undef Tcl_SetVar #define Tcl_SetVar(interp, varName, newValue, flags) \ Tcl_SetVar2(interp, varName, NULL, newValue, flags) diff --git a/generic/tclExecute.c b/generic/tclExecute.c index a26aae1..739641b 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -549,14 +549,14 @@ VarHashCreateVar( * Tcl_GetBooleanFromObj(). The ANSI C "prototype" is: * * MODULE_SCOPE int TclGetBooleanFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, - * int *boolPtr); + * int *intPtr); */ -#define TclGetBooleanFromObj(interp, objPtr, boolPtr) \ +#define TclGetBooleanFromObj(interp, objPtr, intPtr) \ ((((objPtr)->typePtr == &tclIntType) \ || ((objPtr)->typePtr == &tclBooleanType)) \ - ? (*(boolPtr) = ((objPtr)->internalRep.longValue!=0), TCL_OK) \ - : Tcl_GetBooleanFromObj((interp), (objPtr), (boolPtr))) + ? (*(intPtr) = ((objPtr)->internalRep.longValue!=0), TCL_OK) \ + : Tcl_GetBooleanFromObj((interp), (objPtr), (intPtr))) /* * Macro used to make the check for type overflow more mnemonic. This works by diff --git a/generic/tclGet.c b/generic/tclGet.c index 97e8c7b..2f06cff 100644 --- a/generic/tclGet.c +++ b/generic/tclGet.c @@ -110,7 +110,7 @@ Tcl_GetDouble( * string. * * Results: - * The return value is normally TCL_OK; in this case *boolPtr will be set + * The return value is normally TCL_OK; in this case *intPtr will be set * to the 0/1 value equivalent to src. If src is improperly formed then * TCL_ERROR is returned and an error message will be left in the * interp's result. @@ -126,7 +126,7 @@ Tcl_GetBoolean( Tcl_Interp *interp, /* Interpreter used for error reporting. */ const char *src, /* String containing one of the boolean values * 1, 0, true, false, yes, no, on, off. */ - int *boolPtr) /* Place to store converted result, which will + int *intPtr) /* Place to store converted result, which will * be 0 or 1. */ { Tcl_Obj obj; @@ -142,7 +142,7 @@ Tcl_GetBoolean( Tcl_Panic("invalid sharing of Tcl_Obj on C stack"); } if (code == TCL_OK) { - *boolPtr = obj.internalRep.longValue; + *intPtr = obj.internalRep.longValue; } return code; } diff --git a/generic/tclInt.h b/generic/tclInt.h index 89ce8f0..e238728 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -4605,7 +4605,7 @@ MODULE_SCOPE Tcl_PackageInitProc Procbodytest_SafeInit; * * MODULE_SCOPE void TclSetIntObj(Tcl_Obj *objPtr, int intValue); * MODULE_SCOPE void TclSetLongObj(Tcl_Obj *objPtr, long longValue); - * MODULE_SCOPE void TclSetBooleanObj(Tcl_Obj *objPtr, long boolValue); + * MODULE_SCOPE void TclSetBooleanObj(Tcl_Obj *objPtr, int intValue); * MODULE_SCOPE void TclSetWideIntObj(Tcl_Obj *objPtr, Tcl_WideInt w); * MODULE_SCOPE void TclSetDoubleObj(Tcl_Obj *objPtr, double d); *---------------------------------------------------------------- diff --git a/generic/tclObj.c b/generic/tclObj.c index 9afcedb..b2fd80b 100644 --- a/generic/tclObj.c +++ b/generic/tclObj.c @@ -1730,7 +1730,7 @@ Tcl_InvalidateStringRep( * * This function is normally called when not debugging: i.e., when * TCL_MEM_DEBUG is not defined. It creates a new Tcl_Obj and - * initializes it from the argument boolean value. A nonzero "boolValue" + * initializes it from the argument boolean value. A nonzero "intValue" * is coerced to 1. * * When TCL_MEM_DEBUG is defined, this function just returns the result @@ -1751,20 +1751,20 @@ Tcl_InvalidateStringRep( Tcl_Obj * Tcl_NewBooleanObj( - int boolValue) /* Boolean used to initialize new object. */ + int intValue) /* Boolean used to initialize new object. */ { - return Tcl_DbNewBooleanObj(boolValue, "unknown", 0); + return Tcl_DbNewBooleanObj(intValue, "unknown", 0); } #else /* if not TCL_MEM_DEBUG */ Tcl_Obj * Tcl_NewBooleanObj( - int boolValue) /* Boolean used to initialize new object. */ + int intValue) /* Boolean used to initialize new object. */ { Tcl_Obj *objPtr; - TclNewBooleanObj(objPtr, boolValue); + TclNewBooleanObj(objPtr, intValue); return objPtr; } #endif /* TCL_MEM_DEBUG */ @@ -1800,7 +1800,7 @@ Tcl_NewBooleanObj( Tcl_Obj * Tcl_DbNewBooleanObj( - int boolValue, /* Boolean used to initialize new object. */ + int intValue, /* Boolean used to initialize new object. */ const char *file, /* The name of the source file calling this * function; used for debugging. */ int line) /* Line number in the source file; used for @@ -1811,7 +1811,7 @@ Tcl_DbNewBooleanObj( TclDbNewObj(objPtr, file, line); objPtr->bytes = NULL; - objPtr->internalRep.longValue = (boolValue? 1 : 0); + objPtr->internalRep.longValue = (intValue? 1 : 0); objPtr->typePtr = &tclIntType; return objPtr; } @@ -1820,13 +1820,13 @@ Tcl_DbNewBooleanObj( Tcl_Obj * Tcl_DbNewBooleanObj( - int boolValue, /* Boolean used to initialize new object. */ + int intValue, /* Boolean used to initialize new object. */ const char *file, /* The name of the source file calling this * function; used for debugging. */ int line) /* Line number in the source file; used for * debugging. */ { - return Tcl_NewBooleanObj(boolValue); + return Tcl_NewBooleanObj(intValue); } #endif /* TCL_MEM_DEBUG */ @@ -1836,7 +1836,7 @@ Tcl_DbNewBooleanObj( * Tcl_SetBooleanObj -- * * Modify an object to be a boolean object and to have the specified - * boolean value. A nonzero "boolValue" is coerced to 1. + * boolean value. A nonzero "intValue" is coerced to 1. * * Results: * None. @@ -1852,13 +1852,13 @@ Tcl_DbNewBooleanObj( void Tcl_SetBooleanObj( Tcl_Obj *objPtr, /* Object whose internal rep to init. */ - int boolValue) /* Boolean used to set object's value. */ + int intValue) /* Boolean used to set object's value. */ { if (Tcl_IsShared(objPtr)) { Tcl_Panic("%s called with shared object", "Tcl_SetBooleanObj"); } - TclSetBooleanObj(objPtr, boolValue); + TclSetLongObj(objPtr, (intValue)!=0); } /* @@ -1884,15 +1884,15 @@ int Tcl_GetBooleanFromObj( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ Tcl_Obj *objPtr, /* The object from which to get boolean. */ - int *boolPtr) /* Place to store resulting boolean. */ + int *intPtr) /* Place to store resulting boolean. */ { do { if (objPtr->typePtr == &tclIntType) { - *boolPtr = (objPtr->internalRep.longValue != 0); + *intPtr = (objPtr->internalRep.longValue != 0); return TCL_OK; } if (objPtr->typePtr == &tclBooleanType) { - *boolPtr = (int) objPtr->internalRep.longValue; + *intPtr = (int) objPtr->internalRep.longValue; return TCL_OK; } if (objPtr->typePtr == &tclDoubleType) { @@ -1909,16 +1909,16 @@ Tcl_GetBooleanFromObj( if (Tcl_GetDoubleFromObj(interp, objPtr, &d) != TCL_OK) { return TCL_ERROR; } - *boolPtr = (d != 0.0); + *intPtr = (d != 0.0); return TCL_OK; } if (objPtr->typePtr == &tclBignumType) { - *boolPtr = 1; + *intPtr = 1; return TCL_OK; } #ifndef TCL_WIDE_INT_IS_LONG if (objPtr->typePtr == &tclWideIntType) { - *boolPtr = (objPtr->internalRep.wideValue != 0); + *intPtr = (objPtr->internalRep.wideValue != 0); return TCL_OK; } #endif -- cgit v0.12 From 8837a1f1bb385b66b875d760a427bcb66b8f8a73 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 20 Apr 2022 11:27:34 +0000 Subject: Fix [https://core.tcl-lang.org/tk/tktview?name=bf0f4808d7|bf0f4808d7]: macOS Aqua : CFLAGS_OPTIMIZE --- macosx/README | 11 ++-- macosx/Tcl-Release.xcconfig | 2 +- macosx/Tcl.xcode/project.pbxproj | 16 ++--- macosx/Tcl.xcodeproj/project.pbxproj | 20 +++--- unix/configure | 123 ++--------------------------------- unix/tcl.m4 | 56 ++-------------- 6 files changed, 31 insertions(+), 197 deletions(-) diff --git a/macosx/README b/macosx/README index 3035bc8..9b8ecb8 100644 --- a/macosx/README +++ b/macosx/README @@ -118,13 +118,10 @@ your ${USER}.pbxuser file (located inside the Tcl.xcodeproj bundle directory) with a text editor. - To build universal binaries outside of the Xcode IDE, set CFLAGS as follows: - export CFLAGS="-arch i386 -arch x86_64 -arch ppc" -This requires Mac OS X 10.4 and Xcode 2.4 (or Xcode 2.2 if -arch x86_64 is -omitted, but _not_ Xcode 2.1) and will work on any architecture (on PowerPC -Tiger you need to add "-isysroot /Developer/SDKs/MacOSX10.4u.sdk"). + export CFLAGS="-arch x86_64 -arch arm64e" +This requires Mac OS X 10.4 and Xcode 2.4 and will work on any architecture. Note that configure requires CFLAGS to contain a least one architecture that can -be run on the build machine (i.e. ppc on G3/G4, ppc or ppc64 on G5, ppc or i386 -on Core and ppc, i386 or x86_64 on Core2/Xeon). +be run on the build machine (i.e. x86_64 on Core2/Xeon). Universal builds of Tcl TEA extensions are also possible with CFLAGS set as above, they will be [load]able by universal as well as thin binaries of Tcl. @@ -141,7 +138,7 @@ If you are building from CVS, omit this step (CVS source tree names usually do not contain a version number). - Setup environment variables as desired, e.g. for a universal build on 10.5: - CFLAGS="-arch i386 -arch x86_64 -arch ppc -mmacosx-version-min=10.5" + CFLAGS="-arch x86_64 -arch arm64e -mmacosx-version-min=10.5" export CFLAGS - Change to the directory containing the Tcl source tree and build: diff --git a/macosx/Tcl-Release.xcconfig b/macosx/Tcl-Release.xcconfig index d960a52..867ee78 100644 --- a/macosx/Tcl-Release.xcconfig +++ b/macosx/Tcl-Release.xcconfig @@ -14,7 +14,7 @@ DEBUG_INFORMATION_FORMAT = dwarf-with-dsym DEAD_CODE_STRIPPING = YES DEPLOYMENT_POSTPROCESSING = YES -GCC_OPTIMIZATION_LEVEL = s +GCC_OPTIMIZATION_LEVEL = 2 GCC_PREPROCESSOR_DEFINITIONS = NDEBUG $(TCL_DEFS) $(GCC_PREPROCESSOR_DEFINITIONS) CONFIGURE_ARGS = --disable-symbols $(TCL_CONFIGURE_ARGS) $(CONFIGURE_ARGS) MAKE_TARGET = deploy diff --git a/macosx/Tcl.xcode/project.pbxproj b/macosx/Tcl.xcode/project.pbxproj index 0746261..09e5e8b 100644 --- a/macosx/Tcl.xcode/project.pbxproj +++ b/macosx/Tcl.xcode/project.pbxproj @@ -2133,8 +2133,8 @@ isa = XCBuildConfiguration; baseConfigurationReference = F97AE82B0B65C69B00310EA2 /* Tcl-Release.xcconfig */; buildSettings = { - ARCHS = "$(ARCHS_STANDARD_32_64_BIT)"; - CFLAGS = "-arch i386 -arch x86_64 -arch ppc $(CFLAGS)"; + ARCHS = "$(ARCHS_STANDARD_64_BIT)"; + CFLAGS = "-arch x86_64 -arch arm64e $(CFLAGS)"; MACOSX_DEPLOYMENT_TARGET = 10.5; PREBINDING = NO; }; @@ -2598,8 +2598,8 @@ isa = XCBuildConfiguration; baseConfigurationReference = F97AE82B0B65C69B00310EA2 /* Tcl-Release.xcconfig */; buildSettings = { - ARCHS = "$(ARCHS_STANDARD_32_64_BIT)"; - CFLAGS = "-arch i386 -arch x86_64 -arch ppc $(CFLAGS)"; + ARCHS = "$(ARCHS_STANDARD_64_BIT)"; + CFLAGS = "-arch x86_64 -arch arm64e $(CFLAGS)"; GCC_VERSION = 4.0; MACOSX_DEPLOYMENT_TARGET = 10.5; PREBINDING = NO; @@ -2636,8 +2636,8 @@ isa = XCBuildConfiguration; baseConfigurationReference = F97AE82B0B65C69B00310EA2 /* Tcl-Release.xcconfig */; buildSettings = { - ARCHS = "$(ARCHS_STANDARD_32_64_BIT)"; - CFLAGS = "-arch i386 -arch x86_64 -arch ppc $(CFLAGS)"; + ARCHS = "$(ARCHS_STANDARD_64_BIT)"; + CFLAGS = "-arch x86_64 -arch arm64e $(CFLAGS)"; DEBUG_INFORMATION_FORMAT = dwarf; GCC = "llvm-gcc"; GCC_OPTIMIZATION_LEVEL = 4; @@ -2790,8 +2790,8 @@ isa = XCBuildConfiguration; baseConfigurationReference = F97AE82B0B65C69B00310EA2 /* Tcl-Release.xcconfig */; buildSettings = { - ARCHS = "$(ARCHS_STANDARD_32_64_BIT)"; - CFLAGS = "-arch i386 -arch x86_64 -arch ppc $(CFLAGS)"; + ARCHS = "$(ARCHS_STANDARD_64_BIT)"; + CFLAGS = "-arch x86_64 -arch arm64e $(CFLAGS)"; CPPFLAGS = "-isysroot $(SDKROOT) $(CPPFLAGS)"; MACOSX_DEPLOYMENT_TARGET = 10.5; PREBINDING = NO; diff --git a/macosx/Tcl.xcodeproj/project.pbxproj b/macosx/Tcl.xcodeproj/project.pbxproj index 6bb3417..da673a4 100644 --- a/macosx/Tcl.xcodeproj/project.pbxproj +++ b/macosx/Tcl.xcodeproj/project.pbxproj @@ -2131,8 +2131,8 @@ isa = XCBuildConfiguration; baseConfigurationReference = F97AE82B0B65C69B00310EA2 /* Tcl-Release.xcconfig */; buildSettings = { - ARCHS = "$(ARCHS_STANDARD_32_64_BIT)"; - CFLAGS = "-arch i386 -arch x86_64 -arch ppc $(CFLAGS)"; + ARCHS = "$(ARCHS_STANDARD_64_BIT)"; + CFLAGS = "-arch x86_64 -arch arm64e $(CFLAGS)"; MACOSX_DEPLOYMENT_TARGET = 10.6; PREBINDING = NO; }; @@ -2596,8 +2596,8 @@ isa = XCBuildConfiguration; baseConfigurationReference = F97AE82B0B65C69B00310EA2 /* Tcl-Release.xcconfig */; buildSettings = { - ARCHS = "$(ARCHS_STANDARD_32_64_BIT)"; - CFLAGS = "-arch i386 -arch x86_64 -arch ppc $(CFLAGS)"; + ARCHS = "$(ARCHS_STANDARD_64_BIT)"; + CFLAGS = "-arch x86_64 -arch arm64e $(CFLAGS)"; GCC_VERSION = 4.0; MACOSX_DEPLOYMENT_TARGET = 10.6; PREBINDING = NO; @@ -2634,12 +2634,11 @@ isa = XCBuildConfiguration; baseConfigurationReference = F97AE82B0B65C69B00310EA2 /* Tcl-Release.xcconfig */; buildSettings = { - ARCHS = "$(ARCHS_STANDARD_32_64_BIT)"; - CFLAGS = "-arch i386 -arch x86_64 -arch ppc $(CFLAGS)"; + ARCHS = "$(ARCHS_STANDARD_64_BIT)"; + CFLAGS = "-arch x86_64 -arch arm64e $(CFLAGS)"; DEBUG_INFORMATION_FORMAT = dwarf; GCC = "llvm-gcc"; GCC_OPTIMIZATION_LEVEL = 4; - "GCC_OPTIMIZATION_LEVEL[arch=ppc]" = s; GCC_VERSION = com.apple.compilers.llvmgcc42; MACOSX_DEPLOYMENT_TARGET = 10.6; PREBINDING = NO; @@ -2817,9 +2816,8 @@ buildSettings = { ARCHS = ( "$(NATIVE_ARCH_64_BIT)", - "$(NATIVE_ARCH_32_BIT)", ); - CFLAGS = "-arch i386 -arch x86_64 $(CFLAGS)"; + CFLAGS = "-arch x86_64 -arch arm64e $(CFLAGS)"; DEBUG_INFORMATION_FORMAT = dwarf; GCC = clang; GCC_OPTIMIZATION_LEVEL = 4; @@ -2885,8 +2883,8 @@ isa = XCBuildConfiguration; baseConfigurationReference = F97AE82B0B65C69B00310EA2 /* Tcl-Release.xcconfig */; buildSettings = { - ARCHS = "$(ARCHS_STANDARD_32_64_BIT)"; - CFLAGS = "-arch i386 -arch x86_64 -arch ppc $(CFLAGS)"; + ARCHS = "$(ARCHS_STANDARD_64_BIT)"; + CFLAGS = "-arch x86_64 -arch arm64e $(CFLAGS)"; CPPFLAGS = "-isysroot $(SDKROOT) $(CPPFLAGS)"; MACOSX_DEPLOYMENT_TARGET = 10.5; PREBINDING = NO; diff --git a/unix/configure b/unix/configure index 5d18196..148f055 100755 --- a/unix/configure +++ b/unix/configure @@ -6411,7 +6411,7 @@ fi LDFLAGS="$LDFLAGS -pthread" ;; Darwin-*) - CFLAGS_OPTIMIZE="-Os" + CFLAGS_OPTIMIZE="-O2" SHLIB_CFLAGS="-fno-common" # To avoid discrepancies between what headers configure sees during # preprocessing tests and compiling tests, move any -isysroot and @@ -6426,47 +6426,7 @@ fi then : case `arch` in - ppc) - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking if compiler accepts -arch ppc64 flag" >&5 -printf %s "checking if compiler accepts -arch ppc64 flag... " >&6; } -if test ${tcl_cv_cc_arch_ppc64+y} -then : - printf %s "(cached) " >&6 -else $as_nop - - hold_cflags=$CFLAGS - CFLAGS="$CFLAGS -arch ppc64 -mpowerpc64 -mcpu=G5" - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - -int -main (void) -{ - - ; - return 0; -} -_ACEOF -if ac_fn_c_try_link "$LINENO" -then : - tcl_cv_cc_arch_ppc64=yes -else $as_nop - tcl_cv_cc_arch_ppc64=no -fi -rm -f core conftest.err conftest.$ac_objext conftest.beam \ - conftest$ac_exeext conftest.$ac_ext - CFLAGS=$hold_cflags -fi -{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_cc_arch_ppc64" >&5 -printf "%s\n" "$tcl_cv_cc_arch_ppc64" >&6; } - if test $tcl_cv_cc_arch_ppc64 = yes -then : - - CFLAGS="$CFLAGS -arch ppc64 -mpowerpc64 -mcpu=G5" - do64bit_ok=yes - -fi;; - i386) + x86_64) { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking if compiler accepts -arch x86_64 flag" >&5 printf %s "checking if compiler accepts -arch x86_64 flag... " >&6; } if test ${tcl_cv_cc_arch_x86_64+y} @@ -6506,21 +6466,13 @@ then : do64bit_ok=yes fi;; + arm64e) + do64bit_ok=yes;; *) { printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: Don't know how enable 64-bit on architecture \`arch\`" >&5 printf "%s\n" "$as_me: WARNING: Don't know how enable 64-bit on architecture \`arch\`" >&2;};; esac -else $as_nop - - # Check for combined 32-bit and 64-bit fat build - if echo "$CFLAGS " |grep -E -q -- '-arch (ppc64|x86_64) ' \ - && echo "$CFLAGS " |grep -E -q -- '-arch (ppc|i386) ' -then : - - fat_32_64=yes -fi - fi SHLIB_LD='${CC} -dynamiclib ${CFLAGS} ${LDFLAGS}' { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking if ld accepts -single_module flag" >&5 @@ -6643,17 +6595,6 @@ then : else $as_nop hold_libs=$LIBS - if test "$fat_32_64" = yes -then : - - for v in CFLAGS CPPFLAGS LDFLAGS; do - # On Tiger there is no 64-bit CF, so remove 64-bit - # archs from CFLAGS et al. while testing for - # presence of CF. 64-bit CF is disabled in - # tclUnixPort.h if necessary. - eval 'hold_'$v'="$'$v'";'$v'="`echo "$'$v' "|sed -e "s/-arch ppc64 / /g" -e "s/-arch x86_64 / /g"`"' - done -fi LIBS="$LIBS -framework CoreFoundation" cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ @@ -6674,13 +6615,6 @@ else $as_nop fi rm -f core conftest.err conftest.$ac_objext conftest.beam \ conftest$ac_exeext conftest.$ac_ext - if test "$fat_32_64" = yes -then : - - for v in CFLAGS CPPFLAGS LDFLAGS; do - eval $v'="$hold_'$v'"' - done -fi LIBS=$hold_libs fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_lib_corefoundation" >&5 @@ -6696,55 +6630,6 @@ printf "%s\n" "#define HAVE_COREFOUNDATION 1" >>confdefs.h else $as_nop tcl_corefoundation=no fi - if test "$fat_32_64" = yes -a $tcl_corefoundation = yes -then : - - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for 64-bit CoreFoundation" >&5 -printf %s "checking for 64-bit CoreFoundation... " >&6; } -if test ${tcl_cv_lib_corefoundation_64+y} -then : - printf %s "(cached) " >&6 -else $as_nop - - for v in CFLAGS CPPFLAGS LDFLAGS; do - eval 'hold_'$v'="$'$v'";'$v'="`echo "$'$v' "|sed -e "s/-arch ppc / /g" -e "s/-arch i386 / /g"`"' - done - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include -int -main (void) -{ -CFBundleRef b = CFBundleGetMainBundle(); - ; - return 0; -} -_ACEOF -if ac_fn_c_try_link "$LINENO" -then : - tcl_cv_lib_corefoundation_64=yes -else $as_nop - tcl_cv_lib_corefoundation_64=no -fi -rm -f core conftest.err conftest.$ac_objext conftest.beam \ - conftest$ac_exeext conftest.$ac_ext - for v in CFLAGS CPPFLAGS LDFLAGS; do - eval $v'="$hold_'$v'"' - done -fi -{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_lib_corefoundation_64" >&5 -printf "%s\n" "$tcl_cv_lib_corefoundation_64" >&6; } - if test $tcl_cv_lib_corefoundation_64 = no -then : - - -printf "%s\n" "#define NO_COREFOUNDATION_64 1" >>confdefs.h - - LDFLAGS="$LDFLAGS -Wl,-no_arch_warnings" - -fi - -fi fi ;; diff --git a/unix/tcl.m4 b/unix/tcl.m4 index dfbb9be..064c49a 100644 --- a/unix/tcl.m4 +++ b/unix/tcl.m4 @@ -1369,7 +1369,7 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [ LDFLAGS="$LDFLAGS -pthread" ;; Darwin-*) - CFLAGS_OPTIMIZE="-Os" + CFLAGS_OPTIMIZE="-O2" SHLIB_CFLAGS="-fno-common" # To avoid discrepancies between what headers configure sees during # preprocessing tests and compiling tests, move any -isysroot and @@ -1382,19 +1382,7 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [ if (!([$]i~/^(isysroot|mmacosx-version-min)/)) print "-"[$]i}'`" AS_IF([test $do64bit = yes], [ case `arch` in - ppc) - AC_CACHE_CHECK([if compiler accepts -arch ppc64 flag], - tcl_cv_cc_arch_ppc64, [ - hold_cflags=$CFLAGS - CFLAGS="$CFLAGS -arch ppc64 -mpowerpc64 -mcpu=G5" - AC_LINK_IFELSE([AC_LANG_PROGRAM([[]], [[]])], - [tcl_cv_cc_arch_ppc64=yes],[tcl_cv_cc_arch_ppc64=no]) - CFLAGS=$hold_cflags]) - AS_IF([test $tcl_cv_cc_arch_ppc64 = yes], [ - CFLAGS="$CFLAGS -arch ppc64 -mpowerpc64 -mcpu=G5" - do64bit_ok=yes - ]);; - i386) + x86_64) AC_CACHE_CHECK([if compiler accepts -arch x86_64 flag], tcl_cv_cc_arch_x86_64, [ hold_cflags=$CFLAGS @@ -1406,15 +1394,12 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [ CFLAGS="$CFLAGS -arch x86_64" do64bit_ok=yes ]);; + arm64e) + do64bit_ok=yes;; *) AC_MSG_WARN([Don't know how enable 64-bit on architecture `arch`]);; esac - ], [ - # Check for combined 32-bit and 64-bit fat build - AS_IF([echo "$CFLAGS " |grep -E -q -- '-arch (ppc64|x86_64) ' \ - && echo "$CFLAGS " |grep -E -q -- '-arch (ppc|i386) '], [ - fat_32_64=yes]) - ]) + ], []) SHLIB_LD='${CC} -dynamiclib ${CFLAGS} ${LDFLAGS}' AC_CACHE_CHECK([if ld accepts -single_module flag], tcl_cv_ld_single_module, [ hold_ldflags=$LDFLAGS @@ -1461,48 +1446,17 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [ AC_CACHE_CHECK([for CoreFoundation.framework], tcl_cv_lib_corefoundation, [ hold_libs=$LIBS - AS_IF([test "$fat_32_64" = yes], [ - for v in CFLAGS CPPFLAGS LDFLAGS; do - # On Tiger there is no 64-bit CF, so remove 64-bit - # archs from CFLAGS et al. while testing for - # presence of CF. 64-bit CF is disabled in - # tclUnixPort.h if necessary. - eval 'hold_'$v'="$'$v'";'$v'="`echo "$'$v' "|sed -e "s/-arch ppc64 / /g" -e "s/-arch x86_64 / /g"`"' - done]) LIBS="$LIBS -framework CoreFoundation" AC_LINK_IFELSE([AC_LANG_PROGRAM([[#include ]], [[CFBundleRef b = CFBundleGetMainBundle();]])], [tcl_cv_lib_corefoundation=yes], [tcl_cv_lib_corefoundation=no]) - AS_IF([test "$fat_32_64" = yes], [ - for v in CFLAGS CPPFLAGS LDFLAGS; do - eval $v'="$hold_'$v'"' - done]) LIBS=$hold_libs]) AS_IF([test $tcl_cv_lib_corefoundation = yes], [ LIBS="$LIBS -framework CoreFoundation" AC_DEFINE(HAVE_COREFOUNDATION, 1, [Do we have access to Darwin CoreFoundation.framework?]) ], [tcl_corefoundation=no]) - AS_IF([test "$fat_32_64" = yes -a $tcl_corefoundation = yes],[ - AC_CACHE_CHECK([for 64-bit CoreFoundation], - tcl_cv_lib_corefoundation_64, [ - for v in CFLAGS CPPFLAGS LDFLAGS; do - eval 'hold_'$v'="$'$v'";'$v'="`echo "$'$v' "|sed -e "s/-arch ppc / /g" -e "s/-arch i386 / /g"`"' - done - AC_LINK_IFELSE([AC_LANG_PROGRAM([[#include ]], - [[CFBundleRef b = CFBundleGetMainBundle();]])], - [tcl_cv_lib_corefoundation_64=yes], - [tcl_cv_lib_corefoundation_64=no]) - for v in CFLAGS CPPFLAGS LDFLAGS; do - eval $v'="$hold_'$v'"' - done]) - AS_IF([test $tcl_cv_lib_corefoundation_64 = no], [ - AC_DEFINE(NO_COREFOUNDATION_64, 1, - [Is Darwin CoreFoundation unavailable for 64-bit?]) - LDFLAGS="$LDFLAGS -Wl,-no_arch_warnings" - ]) - ]) ]) ;; OS/390-*) -- cgit v0.12 From 46e63b3be5cb5ce16dd97cc9f4c17481a5c2f0c8 Mon Sep 17 00:00:00 2001 From: pooryorick Date: Wed, 20 Apr 2022 12:08:45 +0000 Subject: Fix for [a12ad5c4bd7efcf2], buffer allocation on every call to Write(). --- generic/tclIO.c | 41 ++++++++++++++++++++++++++++------------- 1 file changed, 28 insertions(+), 13 deletions(-) diff --git a/generic/tclIO.c b/generic/tclIO.c index aa0a5a6..b504369 100644 --- a/generic/tclIO.c +++ b/generic/tclIO.c @@ -2711,6 +2711,7 @@ FlushChannel( int wroteSome = 0; /* Set to one if any data was written to the * driver. */ + int bufExists; /* * Prevent writing on a dead channel -- a channel that has been closed but * not yet deallocated. This can occur if the exit handler for the channel @@ -2879,8 +2880,8 @@ FlushChannel( * queued. */ - DiscardOutputQueued(statePtr); ReleaseChannelBuffer(bufPtr); + DiscardOutputQueued(statePtr); break; } else { /* @@ -2891,20 +2892,32 @@ FlushChannel( wroteSome = 1; } - bufPtr->nextRemoved += written; + bufExists = bufPtr->refCount > 1; + ReleaseChannelBuffer(bufPtr); + if (bufExists) { + /* There is still a reference to this buffer other than the one + * this routine just released, meaning that final cleanup of the + * buffer hasn't been ordered by, e.g. by a reflected channel + * closing the channel from within one of its handler scripts (not + * something one would expecte, but it must be considered). Normal + * operations on the buffer can proceed. + */ - /* - * If this buffer is now empty, recycle it. - */ + bufPtr->nextRemoved += written; - if (IsBufferEmpty(bufPtr)) { - statePtr->outQueueHead = bufPtr->nextPtr; - if (statePtr->outQueueHead == NULL) { - statePtr->outQueueTail = NULL; + /* + * If this buffer is now empty, recycle it. + */ + + if (IsBufferEmpty(bufPtr)) { + statePtr->outQueueHead = bufPtr->nextPtr; + if (statePtr->outQueueHead == NULL) { + statePtr->outQueueTail = NULL; + } + RecycleBuffer(statePtr, bufPtr, 0); } - RecycleBuffer(statePtr, bufPtr, 0); } - ReleaseChannelBuffer(bufPtr); + } /* Closes "while". */ /* @@ -6957,15 +6970,17 @@ GetInput( PreserveChannelBuffer(bufPtr); nread = ChanRead(chanPtr, InsertPoint(bufPtr), toRead); + ReleaseChannelBuffer(bufPtr); if (nread < 0) { result = Tcl_GetErrno(); } else { result = 0; - bufPtr->nextAdded += nread; + if (statePtr->inQueueTail != NULL) { + statePtr->inQueueTail->nextAdded += nread; + } } - ReleaseChannelBuffer(bufPtr); return result; } -- cgit v0.12