diff options
author | jan.nijtmans <nijtmans@users.sourceforge.net> | 2023-11-20 08:41:55 (GMT) |
---|---|---|
committer | jan.nijtmans <nijtmans@users.sourceforge.net> | 2023-11-20 08:41:55 (GMT) |
commit | 3c79d696f0a9c010151d498ab2e18a83d49589e3 (patch) | |
tree | cf86afbb879566ba44f469416712dbca376338a3 /generic | |
parent | f3fb557c118759ada47f0b60a97ceb99dd0c7100 (diff) | |
parent | 62f60cd6881ad2b5ed307d57d9111e27300e90d6 (diff) | |
download | tcl-core-tip-661-candidate.zip tcl-core-tip-661-candidate.tar.gz tcl-core-tip-661-candidate.tar.bz2 |
Merge 9.0core-tip-661-candidate
Diffstat (limited to 'generic')
-rw-r--r-- | generic/tclDecls.h | 2 | ||||
-rw-r--r-- | generic/tclIO.c | 29 | ||||
-rw-r--r-- | generic/tclIOCmd.c | 10 | ||||
-rw-r--r-- | generic/tclInt.h | 1 | ||||
-rw-r--r-- | generic/tclTest.c | 30 |
5 files changed, 42 insertions, 30 deletions
diff --git a/generic/tclDecls.h b/generic/tclDecls.h index 338ac33..ad81de9 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -4314,7 +4314,7 @@ extern const TclStubs *tclStubsPtr; # ifdef TCL_NO_DEPRECATED # undef Tcl_GetByteArrayFromObj # define Tcl_GetByteArrayFromObj(objPtr, sizePtr) \ - tclStubsPtr->tcl_GetBytesFromObj(NULL, (objPtr), (sizePtr)) + Tcl_GetBytesFromObj(NULL, (objPtr), (sizePtr)) # endif #endif diff --git a/generic/tclIO.c b/generic/tclIO.c index 635144f..d7b9513 100644 --- a/generic/tclIO.c +++ b/generic/tclIO.c @@ -7546,6 +7546,33 @@ Tcl_Eof( return GotFlag(statePtr, CHANNEL_EOF) ? 1 : 0; } + +/* + *---------------------------------------------------------------------- + * + * TclChannelGetBlockingMode -- + * + * Returns 1 if the channel is in blocking mode (default), 0 otherwise. + * + * Results: + * 1 or 0, always. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +int +TclChannelGetBlockingMode( + Tcl_Channel chan) +{ + ChannelState *statePtr = ((Channel *) chan)->state; + /* State of real channel structure. */ + + return GotFlag(statePtr, CHANNEL_NONBLOCKING) ? 0 : 1; +} + /* *---------------------------------------------------------------------- * @@ -8170,7 +8197,7 @@ Tcl_SetChannelOption( obj.length = strlen(newValue); obj.typePtr = NULL; - code = TclGetWideIntFromObj(interp, &obj, &newBufferSize); + code = Tcl_GetWideIntFromObj(interp, &obj, &newBufferSize); TclFreeInternalRep(&obj); if (code == TCL_ERROR) { diff --git a/generic/tclIOCmd.c b/generic/tclIOCmd.c index 7a180e6..b6fd799 100644 --- a/generic/tclIOCmd.c +++ b/generic/tclIOCmd.c @@ -433,7 +433,12 @@ Tcl_ReadObjCmd( TclChannelPreserve(chan); charactersRead = Tcl_ReadChars(chan, resultPtr, toRead, 0); if (charactersRead == TCL_IO_FAILURE) { - Tcl_DecrRefCount(resultPtr); + Tcl_Obj *returnOptsPtr = NULL; + if (TclChannelGetBlockingMode(chan)) { + returnOptsPtr = Tcl_NewDictObj(); + Tcl_DictObjPut(NULL, returnOptsPtr, Tcl_NewStringObj("-data", -1), + resultPtr); + } /* * TIP #219. * Capture error messages put by the driver into the bypass area and @@ -447,6 +452,9 @@ Tcl_ReadObjCmd( TclGetString(chanObjPtr), Tcl_PosixError(interp))); } TclChannelRelease(chan); + if (returnOptsPtr) { + Tcl_SetReturnOptions(interp, returnOptsPtr); + } return TCL_ERROR; } diff --git a/generic/tclInt.h b/generic/tclInt.h index 6dc35c3..f3c3f91 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -3235,6 +3235,7 @@ MODULE_SCOPE int TclByteArrayMatch(const unsigned char *string, MODULE_SCOPE double TclCeil(const void *a); MODULE_SCOPE void TclChannelPreserve(Tcl_Channel chan); MODULE_SCOPE void TclChannelRelease(Tcl_Channel chan); +MODULE_SCOPE int TclChannelGetBlockingMode(Tcl_Channel chan); MODULE_SCOPE int TclCheckArrayTraces(Tcl_Interp *interp, Var *varPtr, Var *arrayPtr, Tcl_Obj *name, int index); MODULE_SCOPE int TclCheckEmptyString(Tcl_Obj *objPtr); diff --git a/generic/tclTest.c b/generic/tclTest.c index e5f3650..450ff12 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -2130,7 +2130,6 @@ static int UtfExtWrapper( } flagMap[] = { {"start", TCL_ENCODING_START}, {"end", TCL_ENCODING_END}, - {"stoponerror", TCL_ENCODING_STOPONERROR}, {"noterminate", TCL_ENCODING_NO_TERMINATE}, {"charlimit", TCL_ENCODING_CHAR_LIMIT}, {"profiletcl8", TCL_ENCODING_PROFILE_TCL8}, @@ -5769,20 +5768,7 @@ TestbytestringObjCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* The argument objects. */ { - struct { -#if !defined(TCL_NO_DEPRECATED) -# if defined(_MSC_VER) && !defined(NDEBUG) -# pragma warning(disable:4133) -# elif defined(__clang__) -# pragma clang diagnostic push -# pragma clang diagnostic ignored "-Wincompatible-pointer-types" -# endif - int n; /* On purpose, not Tcl_Size, in order to demonstrate what happens */ -#else - Tcl_Size n; -#endif - int m; /* This variable should not be overwritten */ - } x = {0, 1}; + Tcl_Size n; const char *p; if (objc != 2) { @@ -5790,21 +5776,11 @@ TestbytestringObjCmd( return TCL_ERROR; } - /* Next line produces a "warning: passing argument 3 of ... from incompatible pointer type", - * but that's on purpose: It's exactly what we are testing here */ - p = (const char *)Tcl_GetBytesFromObj(interp, objv[1], &x.n); + p = (const char *)Tcl_GetBytesFromObj(interp, objv[1], &n); if (p == NULL) { return TCL_ERROR; } -#if !defined(TCL_NO_DEPRECATED) && defined(__clang__) -# pragma clang diagnostic pop -#endif - - if (x.m != 1) { - Tcl_AppendResult(interp, "Tcl_GetBytesFromObj() overwrites variable", (void *)NULL); - return TCL_ERROR; - } - Tcl_SetObjResult(interp, Tcl_NewStringObj(p, x.n)); + Tcl_SetObjResult(interp, Tcl_NewStringObj(p, n)); return TCL_OK; } |