summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2012-05-24 10:05:50 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2012-05-24 10:05:50 (GMT)
commit3186e522afae18a8fe8e1513d4a9e27500486613 (patch)
treeaab209c5964341792f32189bac2d3ddc546f2328 /generic
parente859f7d69ec73922d1dbdfaa19df6e7f0b82c593 (diff)
parent78bbbde35c3f53764827e54afe963af4ea244aa4 (diff)
downloadtcl-3186e522afae18a8fe8e1513d4a9e27500486613.zip
tcl-3186e522afae18a8fe8e1513d4a9e27500486613.tar.gz
tcl-3186e522afae18a8fe8e1513d4a9e27500486613.tar.bz2
merge trunk
Diffstat (limited to 'generic')
-rw-r--r--generic/tclFileName.c4
-rw-r--r--generic/tclIORChan.c4
-rw-r--r--generic/tclIORTrans.c11
-rw-r--r--generic/tclOO.c68
-rw-r--r--generic/tclOOBasic.c138
-rw-r--r--generic/tclOODefineCmds.c103
-rw-r--r--generic/tclOOInt.h9
-rw-r--r--generic/tclOOMethod.c9
-rw-r--r--generic/tclPathObj.c2
-rw-r--r--generic/tclZlib.c498
10 files changed, 576 insertions, 270 deletions
diff --git a/generic/tclFileName.c b/generic/tclFileName.c
index 5048308..b130169 100644
--- a/generic/tclFileName.c
+++ b/generic/tclFileName.c
@@ -863,7 +863,7 @@ TclpNativeJoinPath(
if (length > 0 && (start[length-1] != '/')) {
Tcl_AppendToObj(prefix, "/", 1);
- length++;
+ Tcl_GetStringFromObj(prefix, &length);
}
needsSep = 0;
@@ -899,7 +899,7 @@ TclpNativeJoinPath(
if ((length > 0) &&
(start[length-1] != '/') && (start[length-1] != ':')) {
Tcl_AppendToObj(prefix, "/", 1);
- length++;
+ Tcl_GetStringFromObj(prefix, &length);
}
needsSep = 0;
diff --git a/generic/tclIORChan.c b/generic/tclIORChan.c
index 2d31da3..938def2 100644
--- a/generic/tclIORChan.c
+++ b/generic/tclIORChan.c
@@ -934,8 +934,11 @@ TclChanPostEventObjCmd(
* We have the channel and the events to post.
*/
+#ifdef TCL_THREADS
if (rcPtr->owner == rcPtr->thread) {
+#endif
Tcl_NotifyChannel (chan, events);
+#ifdef TCL_THREADS
} else {
ReflectEvent* ev = ckalloc (sizeof (ReflectEvent));
ev->header.proc = ReflectEventRun;
@@ -965,6 +968,7 @@ TclChanPostEventObjCmd(
Tcl_ThreadQueueEvent (rcPtr->owner, (Tcl_Event*) ev, TCL_QUEUE_TAIL);
Tcl_ThreadAlert (rcPtr->owner);
}
+#endif
/*
* Squash interp results left by the event script.
diff --git a/generic/tclIORTrans.c b/generic/tclIORTrans.c
index 6c9a41b..fd25f2d 100644
--- a/generic/tclIORTrans.c
+++ b/generic/tclIORTrans.c
@@ -439,13 +439,6 @@ static const char *msg_dstlost =
*/
/*
- * Number of milliseconds to wait before firing an event to try to flush out
- * information waiting in buffers (fileevent support).
- */
-
-#define FLUSH_DELAY (5)
-
-/*
* Helper functions encapsulating some of the thread forwarding to make the
* control flow in callers easier.
*/
@@ -1230,7 +1223,7 @@ ReflectInput(
*
* ReflectOutput --
*
- * This function is invoked when data is writen to the channel.
+ * This function is invoked when data is written to the channel.
*
* Results:
* The number of bytes actually written.
@@ -2861,7 +2854,7 @@ TimerSetup(
return;
}
- rtPtr->timer = Tcl_CreateTimerHandler(FLUSH_DELAY, TimerRun, rtPtr);
+ rtPtr->timer = Tcl_CreateTimerHandler(0, TimerRun, rtPtr);
}
/*
diff --git a/generic/tclOO.c b/generic/tclOO.c
index d5cc6e1..26e6d75 100644
--- a/generic/tclOO.c
+++ b/generic/tclOO.c
@@ -123,6 +123,16 @@ static const DeclaredClassMethod objMethods[] = {
};
/*
+ * And for the oo::class constructor...
+ */
+
+static const Tcl_MethodType classConstructor = {
+ TCL_OO_METHOD_VERSION_CURRENT,
+ "oo::class constructor",
+ TclOO_Class_Constructor, NULL, NULL
+};
+
+/*
* Scripted parts of TclOO. First, the master script (cannot be outside this
* file).
*/
@@ -135,18 +145,6 @@ static const char *initScript =
/* " tcloo.tcl OO_LIBRARY oo::library;"; */
/*
- * The body of the constructor for oo::class.
- */
-
-static const char *classConstructorBody =
-"set script [list ::oo::define [self] $definitionScript];"
-"lassign [::oo::UpCatch $script] msg opts;"
-"if {[dict get $opts -code] == 1} {"
-" dict set opts -errorline 0xDeadBeef"
-"};"
-"return -options $opts $msg;";
-
-/*
* The scripted part of the definitions of slots.
*/
@@ -340,12 +338,12 @@ InitFoundation(
TclNewLiteralStringObj(fPtr->constructorName, "<constructor>");
TclNewLiteralStringObj(fPtr->destructorName, "<destructor>");
TclNewLiteralStringObj(fPtr->clonedName, "<cloned>");
+ TclNewLiteralStringObj(fPtr->defineName, "::oo::define");
Tcl_IncrRefCount(fPtr->unknownMethodNameObj);
Tcl_IncrRefCount(fPtr->constructorName);
Tcl_IncrRefCount(fPtr->destructorName);
Tcl_IncrRefCount(fPtr->clonedName);
- Tcl_NRCreateCommand(interp, "::oo::UpCatch", TclOOUpcatchCmd,
- TclOONRUpcatch, NULL, NULL);
+ Tcl_IncrRefCount(fPtr->defineName);
Tcl_CreateObjCommand(interp, "::oo::UnknownDefinition",
TclOOUnknownDefinition, NULL, NULL);
TclNewLiteralStringObj(namePtr, "::oo::UnknownDefinition");
@@ -418,28 +416,19 @@ InitFoundation(
bodyPtr = Tcl_NewStringObj(clonedBody, -1);
TclOONewProcMethod(interp, fPtr->objectCls, 0, fPtr->clonedName, argsPtr,
bodyPtr, NULL);
- Tcl_DecrRefCount(argsPtr);
+ TclDecrRefCount(argsPtr);
/*
* Finish setting up the class of classes by marking the 'new' method as
* private; classes, unlike general objects, must have explicit names. We
* also need to create the constructor for classes.
- *
- * The 0xDeadBeef is a special signal to the errorInfo logger that is used
- * by constructors that stops it from generating extra error information
- * that is confusing.
*/
TclNewLiteralStringObj(namePtr, "new");
Tcl_NewInstanceMethod(interp, (Tcl_Object) fPtr->classCls->thisPtr,
namePtr /* keeps ref */, 0 /* ==private */, NULL, NULL);
-
- TclNewLiteralStringObj(argsPtr, "{definitionScript {}}");
- Tcl_IncrRefCount(argsPtr);
- bodyPtr = Tcl_NewStringObj(classConstructorBody, -1);
- fPtr->classCls->constructorPtr = TclOONewProcMethod(interp,
- fPtr->classCls, 0, NULL, argsPtr, bodyPtr, NULL);
- Tcl_DecrRefCount(argsPtr);
+ fPtr->classCls->constructorPtr = (Method *) Tcl_NewMethod(interp,
+ (Tcl_Class) fPtr->classCls, NULL, 0, &classConstructor, NULL);
/*
* Create non-object commands and plug ourselves into the Tcl [info]
@@ -529,10 +518,11 @@ KillFoundation(
DelRef(fPtr->objectCls->thisPtr);
DelRef(fPtr->objectCls);
- Tcl_DecrRefCount(fPtr->unknownMethodNameObj);
- Tcl_DecrRefCount(fPtr->constructorName);
- Tcl_DecrRefCount(fPtr->destructorName);
- Tcl_DecrRefCount(fPtr->clonedName);
+ TclDecrRefCount(fPtr->unknownMethodNameObj);
+ TclDecrRefCount(fPtr->constructorName);
+ TclDecrRefCount(fPtr->destructorName);
+ TclDecrRefCount(fPtr->clonedName);
+ TclDecrRefCount(fPtr->defineName);
ckfree(fPtr);
}
@@ -789,7 +779,7 @@ ObjectRenamedTrace(
if (flags & TCL_TRACE_RENAME) {
if (oPtr->cachedNameObj) {
- Tcl_DecrRefCount(oPtr->cachedNameObj);
+ TclDecrRefCount(oPtr->cachedNameObj);
oPtr->cachedNameObj = NULL;
}
return;
@@ -1044,7 +1034,7 @@ ReleaseClassContents(
Tcl_Obj *filterObj;
FOREACH(filterObj, clsPtr->filters) {
- Tcl_DecrRefCount(filterObj);
+ TclDecrRefCount(filterObj);
}
ckfree(clsPtr->filters.list);
clsPtr->filters.num = 0;
@@ -1123,7 +1113,7 @@ ObjectNamespaceDeleted(
}
FOREACH(filterObj, oPtr->filters) {
- Tcl_DecrRefCount(filterObj);
+ TclDecrRefCount(filterObj);
}
if (i) {
ckfree(oPtr->filters.list);
@@ -1138,7 +1128,7 @@ ObjectNamespaceDeleted(
}
FOREACH(variableObj, oPtr->variables) {
- Tcl_DecrRefCount(variableObj);
+ TclDecrRefCount(variableObj);
}
if (i) {
ckfree(oPtr->variables.list);
@@ -1149,7 +1139,7 @@ ObjectNamespaceDeleted(
}
if (oPtr->cachedNameObj) {
- Tcl_DecrRefCount(oPtr->cachedNameObj);
+ TclDecrRefCount(oPtr->cachedNameObj);
oPtr->cachedNameObj = NULL;
}
@@ -1180,7 +1170,7 @@ ObjectNamespaceDeleted(
}
FOREACH(filterObj, clsPtr->filters) {
- Tcl_DecrRefCount(filterObj);
+ TclDecrRefCount(filterObj);
}
if (i) {
ckfree(clsPtr->filters.list);
@@ -1225,7 +1215,7 @@ ObjectNamespaceDeleted(
TclOODelMethodRef(clsPtr->destructorPtr);
FOREACH(variableObj, clsPtr->variables) {
- Tcl_DecrRefCount(variableObj);
+ TclDecrRefCount(variableObj);
}
if (i) {
ckfree(clsPtr->variables.list);
@@ -2490,7 +2480,7 @@ TclOOObjectCmdCore(
result = oPtr->mapMethodNameProc(interp, (Tcl_Object) oPtr,
(Tcl_Class *) startClsPtr, mappedMethodName);
if (result != TCL_OK) {
- Tcl_DecrRefCount(mappedMethodName);
+ TclDecrRefCount(mappedMethodName);
if (result == TCL_BREAK) {
goto noMapping;
} else if (result == TCL_ERROR) {
@@ -2506,7 +2496,7 @@ TclOOObjectCmdCore(
Tcl_IncrRefCount(mappedMethodName);
contextPtr = TclOOGetCallContext(oPtr, mappedMethodName,
flags | (oPtr->flags & FILTER_HANDLING), methodNamePtr);
- Tcl_DecrRefCount(mappedMethodName);
+ TclDecrRefCount(mappedMethodName);
if (contextPtr == NULL) {
Tcl_AppendResult(interp, "impossible to invoke method \"",
TclGetString(methodNamePtr),
diff --git a/generic/tclOOBasic.c b/generic/tclOOBasic.c
index 329f0a4..5e983fc 100644
--- a/generic/tclOOBasic.c
+++ b/generic/tclOOBasic.c
@@ -19,6 +19,8 @@
static inline Tcl_Object *AddConstructionFinalizer(Tcl_Interp *interp);
static int AfterNRDestructor(ClientData data[],
Tcl_Interp *interp, int result);
+static int DecrRefsPostClassConstructor(ClientData data[],
+ Tcl_Interp *interp, int result);
static int FinalizeConstruction(ClientData data[],
Tcl_Interp *interp, int result);
static int FinalizeEval(ClientData data[],
@@ -70,6 +72,74 @@ FinalizeConstruction(
/*
* ----------------------------------------------------------------------
*
+ * TclOO_Class_Constructor --
+ *
+ * Implementation for oo::class constructor.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+int
+TclOO_Class_Constructor(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ Tcl_ObjectContext context,
+ int objc,
+ Tcl_Obj *const *objv)
+{
+ Object *oPtr = (Object *) Tcl_ObjectContextObject(context);
+ Tcl_Obj *invoke[3];
+
+ if (objc-1 > Tcl_ObjectContextSkippedArgs(context)) {
+ Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
+ "?definitionScript?");
+ return TCL_ERROR;
+ } else if (objc == Tcl_ObjectContextSkippedArgs(context)) {
+ return TCL_OK;
+ }
+
+ /*
+ * Delegate to [oo::define] to do the work.
+ */
+
+ invoke[0] = oPtr->fPtr->defineName;
+ invoke[1] = TclOOObjectName(interp, oPtr);
+ invoke[2] = objv[objc-1];
+
+ /*
+ * Must add references or errors in configuration script will cause
+ * trouble.
+ */
+
+ Tcl_IncrRefCount(invoke[0]);
+ Tcl_IncrRefCount(invoke[1]);
+ Tcl_IncrRefCount(invoke[2]);
+ TclNRAddCallback(interp, DecrRefsPostClassConstructor,
+ invoke[0], invoke[1], invoke[2], NULL);
+
+ /*
+ * Tricky point: do not want the extra reported level in the Tcl stack
+ * trace, so use TCL_EVAL_NOERR.
+ */
+
+ return TclNREvalObjv(interp, 3, invoke, TCL_EVAL_NOERR, NULL);
+}
+
+static int
+DecrRefsPostClassConstructor(
+ ClientData data[],
+ Tcl_Interp *interp,
+ int result)
+{
+ TclDecrRefCount((Tcl_Obj *) data[0]);
+ TclDecrRefCount((Tcl_Obj *) data[1]);
+ TclDecrRefCount((Tcl_Obj *) data[2]);
+ return result;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
* TclOO_Class_Create --
*
* Implementation for oo::class->create method.
@@ -1141,74 +1211,6 @@ TclOOCopyObjectCmd(
}
/*
- * ----------------------------------------------------------------------
- *
- * TclOOUpcatchCmd --
- *
- * Implementation of the [oo::UpCatch] command, which is a combination of
- * [uplevel 1] and [catch] that makes it easier to write transparent
- * error handling in scripts.
- *
- * ----------------------------------------------------------------------
- */
-
-int
-TclOOUpcatchCmd(
- ClientData ignored,
- Tcl_Interp *interp,
- int objc,
- Tcl_Obj *const objv[])
-{
- return Tcl_NRCallObjProc(interp, TclOONRUpcatch, NULL, objc, objv);
-}
-
-static int
-UpcatchCallback(
- ClientData data[],
- Tcl_Interp *interp,
- int result)
-{
- Interp *iPtr = (Interp *) interp;
- CallFrame *savedFramePtr = data[0];
- Tcl_Obj *resultObj[2];
- int rewind = iPtr->execEnvPtr->rewind;
-
- iPtr->varFramePtr = savedFramePtr;
- if (rewind || Tcl_LimitExceeded(interp)) {
- Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
- "\n (\"UpCatch\" body line %d)", Tcl_GetErrorLine(interp)));
- return TCL_ERROR;
- }
- resultObj[0] = Tcl_GetObjResult(interp);
- resultObj[1] = Tcl_GetReturnOptions(interp, result);
- Tcl_SetObjResult(interp, Tcl_NewListObj(2, resultObj));
- return TCL_OK;
-}
-
-int
-TclOONRUpcatch(
- ClientData ignored,
- Tcl_Interp *interp,
- int objc,
- Tcl_Obj *const objv[])
-{
- Interp *iPtr = (Interp *) interp;
- CallFrame *savedFramePtr = iPtr->varFramePtr;
-
- if (objc != 2) {
- Tcl_WrongNumArgs(interp, 1, objv, "script");
- return TCL_ERROR;
- }
- if (iPtr->varFramePtr->callerVarPtr != NULL) {
- iPtr->varFramePtr = iPtr->varFramePtr->callerVarPtr;
- }
-
- Tcl_NRAddCallback(interp, UpcatchCallback, savedFramePtr, NULL,NULL,NULL);
- return TclNREvalObjEx(interp, objv[1], TCL_EVAL_NOERR,
- iPtr->cmdFramePtr, 1);
-}
-
-/*
* Local Variables:
* mode: c
* c-basic-offset: 4
diff --git a/generic/tclOODefineCmds.c b/generic/tclOODefineCmds.c
index 3d72690..69cffb0 100644
--- a/generic/tclOODefineCmds.c
+++ b/generic/tclOODefineCmds.c
@@ -17,6 +17,13 @@
#include "tclOOInt.h"
/*
+ * The maximum length of fully-qualified object name to use in an errorinfo
+ * message. Longer than this will be curtailed.
+ */
+
+#define OBJNAME_LENGTH_IN_ERRORINFO_LIMIT 30
+
+/*
* Some things that make it easier to declare a slot.
*/
@@ -40,6 +47,8 @@ struct DeclaredSlot {
static inline void BumpGlobalEpoch(Tcl_Interp *interp, Class *classPtr);
static Tcl_Command FindCommand(Tcl_Interp *interp, Tcl_Obj *stringObj,
Tcl_Namespace *const namespacePtr);
+static void GenerateErrorInfo(Tcl_Interp *interp, Object *oPtr,
+ Tcl_Obj *savedNameObj, const char *typeOfSubject);
static inline Class * GetClassInOuterContext(Tcl_Interp *interp,
Tcl_Obj *className, const char *errMsg);
static inline int InitDefineContext(Tcl_Interp *interp,
@@ -673,6 +682,7 @@ TclOOGetDefineCmdContext(
Tcl_Interp *interp)
{
Interp *iPtr = (Interp *) interp;
+ Tcl_Object object;
if ((iPtr->varFramePtr == NULL)
|| (iPtr->varFramePtr->isProcCallFrame != FRAME_IS_OO_DEFINE)) {
@@ -682,7 +692,14 @@ TclOOGetDefineCmdContext(
Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
return NULL;
}
- return (Tcl_Object) iPtr->varFramePtr->clientData;
+ object = iPtr->varFramePtr->clientData;
+ if (Tcl_ObjectDeleted(object)) {
+ Tcl_AppendResult(interp, "this command cannot be called when the "
+ "object has been deleted", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
+ return NULL;
+ }
+ return object;
}
/*
@@ -730,6 +747,44 @@ GetClassInOuterContext(
/*
* ----------------------------------------------------------------------
*
+ * GenerateErrorInfo --
+ * Factored out code to generate part of the error trace messages.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static void
+GenerateErrorInfo(
+ Tcl_Interp *interp, /* Where to store the error info trace. */
+ Object *oPtr, /* What object (or class) was being configured
+ * when the error occurred? */
+ Tcl_Obj *savedNameObj, /* Name of object saved from before script was
+ * evaluated, which is needed if the object
+ * goes away part way through execution. OTOH,
+ * if the object isn't deleted then its
+ * current name (post-execution) has to be
+ * used. This matters, because the object
+ * could have been renamed... */
+ const char *typeOfSubject) /* Part of the message, saying whether it was
+ * an object, class or class-as-object that
+ * was being configured. */
+{
+ int length;
+ Tcl_Obj *realNameObj = Tcl_ObjectDeleted((Tcl_Object) oPtr)
+ ? savedNameObj : TclOOObjectName(interp, oPtr);
+ const char *objName = Tcl_GetStringFromObj(realNameObj, &length);
+ int limit = OBJNAME_LENGTH_IN_ERRORINFO_LIMIT;
+ int overflow = (length > limit);
+
+ Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
+ "\n (in definition script for %s \"%.*s%s\" line %d)",
+ typeOfSubject, (overflow ? limit : length), objName,
+ (overflow ? "..." : ""), Tcl_GetErrorLine(interp)));
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
* TclOODefineObjCmd --
* Implementation of the "oo::define" command. Works by effectively doing
* the same as 'namespace eval', but with extra magic applied so that the
@@ -779,20 +834,15 @@ TclOODefineObjCmd(
AddRef(oPtr);
if (objc == 3) {
+ Tcl_Obj *objNameObj = TclOOObjectName(interp, oPtr);
+
+ Tcl_IncrRefCount(objNameObj);
result = TclEvalObjEx(interp, objv[2], 0,
((Interp *)interp)->cmdFramePtr, 2);
-
if (result == TCL_ERROR) {
- int length;
- const char *objName = Tcl_GetStringFromObj(objv[1], &length);
- int limit = 60;
- int overflow = (length > limit);
-
- Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
- "\n (in definition script for object \"%.*s%s\" line %d)",
- (overflow ? limit : length), objName,
- (overflow ? "..." : ""), Tcl_GetErrorLine(interp)));
+ GenerateErrorInfo(interp, oPtr, objNameObj, "class");
}
+ TclDecrRefCount(objNameObj);
} else {
Tcl_Obj *objPtr, *obj2Ptr, **objs;
Interp *iPtr = (Interp *) interp;
@@ -898,20 +948,15 @@ TclOOObjDefObjCmd(
AddRef(oPtr);
if (objc == 3) {
+ Tcl_Obj *objNameObj = TclOOObjectName(interp, oPtr);
+
+ Tcl_IncrRefCount(objNameObj);
result = TclEvalObjEx(interp, objv[2], 0,
((Interp *)interp)->cmdFramePtr, 2);
-
if (result == TCL_ERROR) {
- int length;
- const char *objName = Tcl_GetStringFromObj(objv[1], &length);
- int limit = 60;
- int overflow = (length > limit);
-
- Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
- "\n (in definition script for object \"%.*s%s\" line %d)",
- (overflow ? limit : length), objName,
- (overflow ? "..." : ""), Tcl_GetErrorLine(interp)));
+ GenerateErrorInfo(interp, oPtr, objNameObj, "object");
}
+ TclDecrRefCount(objNameObj);
} else {
Tcl_Obj *objPtr, *obj2Ptr, **objs;
Interp *iPtr = (Interp *) interp;
@@ -1017,21 +1062,15 @@ TclOODefineSelfObjCmd(
AddRef(oPtr);
if (objc == 2) {
+ Tcl_Obj *objNameObj = TclOOObjectName(interp, oPtr);
+
+ Tcl_IncrRefCount(objNameObj);
result = TclEvalObjEx(interp, objv[1], 0,
((Interp *)interp)->cmdFramePtr, 2);
-
if (result == TCL_ERROR) {
- int length;
- const char *objName = Tcl_GetStringFromObj(
- TclOOObjectName(interp, oPtr), &length);
- int limit = 60;
- int overflow = (length > limit);
-
- Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
- "\n (in definition script for object \"%.*s%s\" line %d)",
- (overflow ? limit : length), objName,
- (overflow ? "..." : ""), Tcl_GetErrorLine(interp)));
+ GenerateErrorInfo(interp, oPtr, objNameObj, "class object");
}
+ TclDecrRefCount(objNameObj);
} else {
Tcl_Obj *objPtr, *obj2Ptr, **objs;
Interp *iPtr = (Interp *) interp;
diff --git a/generic/tclOOInt.h b/generic/tclOOInt.h
index 7988452..631961f 100644
--- a/generic/tclOOInt.h
+++ b/generic/tclOOInt.h
@@ -322,6 +322,7 @@ typedef struct Foundation {
* destructor. */
Tcl_Obj *clonedName; /* Shared object containing the name of a
* "<cloned>" pseudo-constructor. */
+ Tcl_Obj *defineName; /* Fully qualified name of oo::define. */
} Foundation;
/*
@@ -453,6 +454,9 @@ MODULE_SCOPE int TclOOSelfObjCmd(ClientData clientData,
* Method implementations (in tclOOBasic.c).
*/
+MODULE_SCOPE int TclOO_Class_Constructor(ClientData clientData,
+ Tcl_Interp *interp, Tcl_ObjectContext context,
+ int objc, Tcl_Obj *const *objv);
MODULE_SCOPE int TclOO_Class_Create(ClientData clientData,
Tcl_Interp *interp, Tcl_ObjectContext context,
int objc, Tcl_Obj *const *objv);
@@ -519,8 +523,6 @@ MODULE_SCOPE int TclNRObjectContextInvokeNext(Tcl_Interp *interp,
Tcl_Obj *const *objv, int skip);
MODULE_SCOPE void TclOONewBasicMethod(Tcl_Interp *interp, Class *clsPtr,
const DeclaredClassMethod *dcm);
-MODULE_SCOPE int TclOONRUpcatch(ClientData ignored, Tcl_Interp *interp,
- int objc, Tcl_Obj *const objv[]);
MODULE_SCOPE Tcl_Obj * TclOOObjectName(Tcl_Interp *interp, Object *oPtr);
MODULE_SCOPE void TclOORemoveFromInstances(Object *oPtr, Class *clsPtr);
MODULE_SCOPE void TclOORemoveFromMixinSubs(Class *subPtr,
@@ -532,9 +534,6 @@ MODULE_SCOPE Tcl_Obj * TclOORenderCallChain(Tcl_Interp *interp,
MODULE_SCOPE void TclOOStashContext(Tcl_Obj *objPtr,
CallContext *contextPtr);
MODULE_SCOPE void TclOOSetupVariableResolver(Tcl_Namespace *nsPtr);
-MODULE_SCOPE int TclOOUpcatchCmd(ClientData ignored,
- Tcl_Interp *interp, int objc,
- Tcl_Obj *const objv[]);
/*
* Include all the private API, generated from tclOO.decls.
diff --git a/generic/tclOOMethod.c b/generic/tclOOMethod.c
index 4e7edb8..877c3db 100644
--- a/generic/tclOOMethod.c
+++ b/generic/tclOOMethod.c
@@ -1204,15 +1204,6 @@ ConstructorErrorHandler(
const char *objectName, *kindName;
int objectNameLen;
- if (Tcl_GetErrorLine(interp) == (int) 0xDEADBEEF) {
- /*
- * Horrible hack to deal with certain constructors that must not add
- * information to the error trace.
- */
-
- return;
- }
-
if (mPtr->declaringObjectPtr != NULL) {
declarerPtr = mPtr->declaringObjectPtr;
kindName = "object";
diff --git a/generic/tclPathObj.c b/generic/tclPathObj.c
index 4f86755..2402128 100644
--- a/generic/tclPathObj.c
+++ b/generic/tclPathObj.c
@@ -1087,7 +1087,7 @@ TclJoinPath(
if (length > 0 && ptr[length -1] != '/') {
Tcl_AppendToObj(res, &separator, 1);
- length++;
+ Tcl_GetStringFromObj(res, &length);
}
Tcl_SetObjLength(res, length + (int) strlen(strElt));
diff --git a/generic/tclZlib.c b/generic/tclZlib.c
index 356772e..3063b59 100644
--- a/generic/tclZlib.c
+++ b/generic/tclZlib.c
@@ -17,6 +17,7 @@
#include "tclInt.h"
#ifdef HAVE_ZLIB
#include <zlib.h>
+#include "tclIO.h"
/*
* Magic flags used with wbits fields to indicate that we're handling the gzip
@@ -103,6 +104,7 @@ typedef struct {
GzipHeader outHeader; /* Header to write to an output stream, when
* compressing a gzip stream. */
Tcl_TimerToken timer; /* Timer used for keeping events fresh. */
+ Tcl_DString decompressed; /* Buffer for decompression results. */
Tcl_Obj *compDictObj; /* Byte-array object containing compression
* dictionary (not dictObj!) to use if
* necessary. */
@@ -128,11 +130,10 @@ typedef struct {
#define DEFAULT_BUFFER_SIZE 4096
/*
- * Time to wait (in milliseconds) before flushing the channel when reading
- * data through the transform.
+ * Time to wait before delivering a timer event.
*/
-#define TRANSFORM_FLUSH_DELAY 5
+#define TRANSFORM_TIMEOUT 0
/*
* Prototypes for private procedures defined later in this file:
@@ -143,7 +144,7 @@ static Tcl_DriverBlockModeProc ZlibTransformBlockMode;
static Tcl_DriverCloseProc ZlibTransformClose;
static Tcl_DriverGetHandleProc ZlibTransformGetHandle;
static Tcl_DriverGetOptionProc ZlibTransformGetOption;
-static Tcl_DriverHandlerProc ZlibTransformHandler;
+static Tcl_DriverHandlerProc ZlibTransformEventHandler;
static Tcl_DriverInputProc ZlibTransformInput;
static Tcl_DriverOutputProc ZlibTransformOutput;
static Tcl_DriverSetOptionProc ZlibTransformSetOption;
@@ -157,6 +158,10 @@ static int GenerateHeader(Tcl_Interp *interp, Tcl_Obj *dictObj,
GzipHeader *headerPtr, int *extraSizePtr);
static int ZlibPushSubcmd(Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
+static inline int ResultCopy(ZlibChannelData *cd, char *buf,
+ int toRead);
+static int ResultGenerate(ZlibChannelData *cd, int n, int flush,
+ int *errorCodePtr);
static Tcl_Channel ZlibStackChannelTransform(Tcl_Interp *interp,
int mode, int format, int level,
Tcl_Channel channel, Tcl_Obj *gzipHeaderDictPtr,
@@ -164,9 +169,8 @@ static Tcl_Channel ZlibStackChannelTransform(Tcl_Interp *interp,
static void ZlibStreamCleanup(ZlibStreamHandle *zshPtr);
static int ZlibStreamSubcmd(Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
-static void ZlibTransformTimerKill(ZlibChannelData *cd);
+static inline void ZlibTransformEventTimerKill(ZlibChannelData *cd);
static void ZlibTransformTimerRun(ClientData clientData);
-static void ZlibTransformTimerSetup(ZlibChannelData *cd);
/*
* Type of zlib-based compressing and decompressing channels.
@@ -186,7 +190,7 @@ static const Tcl_ChannelType zlibChannelType = {
NULL, /* close2Proc */
ZlibTransformBlockMode,
NULL, /* flushProc */
- ZlibTransformHandler,
+ ZlibTransformEventHandler,
NULL, /* wideSeekProc */
NULL,
NULL
@@ -2595,6 +2599,12 @@ ZlibStreamCmd(
*----------------------------------------------------------------------
* Set of functions to support channel stacking.
*----------------------------------------------------------------------
+ *
+ * ZlibTransformClose --
+ *
+ * How to shut down a stacked compressing/decompressing transform.
+ *
+ *----------------------------------------------------------------------
*/
static int
@@ -2609,7 +2619,7 @@ ZlibTransformClose(
* Delete the support timer.
*/
- ZlibTransformTimerKill(cd);
+ ZlibTransformEventTimerKill(cd);
/*
* Flush any data waiting to be compressed.
@@ -2654,6 +2664,8 @@ ZlibTransformClose(
* Release all memory.
*/
+ Tcl_DStringFree(&cd->decompressed);
+
if (cd->inBuffer) {
ckfree(cd->inBuffer);
cd->inBuffer = NULL;
@@ -2665,6 +2677,16 @@ ZlibTransformClose(
ckfree(cd);
return result;
}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ZlibTransformInput --
+ *
+ * Reader filter that does decompression.
+ *
+ *----------------------------------------------------------------------
+ */
static int
ZlibTransformInput(
@@ -2676,84 +2698,144 @@ ZlibTransformInput(
ZlibChannelData *cd = instanceData;
Tcl_DriverInputProc *inProc =
Tcl_ChannelInputProc(Tcl_GetChannelType(cd->parent));
- int e, readBytes, flush = Z_NO_FLUSH;
+ int readBytes, gotBytes, copied;
if (cd->mode == TCL_ZLIB_STREAM_DEFLATE) {
return inProc(Tcl_GetChannelInstanceData(cd->parent), buf, toRead,
errorCodePtr);
}
- cd->inStream.next_out = (Bytef *) buf;
- cd->inStream.avail_out = toRead;
- if (cd->inStream.next_in == NULL) {
- goto doReadFirst;
- }
- while (1) {
- e = inflate(&cd->inStream, flush);
- if (e == Z_NEED_DICT && cd->compDictObj) {
- e = SetInflateDictionary(&cd->inStream, cd->compDictObj);
- if (e == Z_OK) {
- continue;
- }
- }
- if ((e == Z_STREAM_END) || (e==Z_OK && cd->inStream.avail_out==0)) {
- return toRead - cd->inStream.avail_out;
- }
-
+ gotBytes = 0;
+ while (toRead > 0) {
/*
- * Z_BUF_ERROR can be ignored as per http://www.zlib.net/zlib_how.html
- *
- * Just indicates that the zlib couldn't consume input/produce output,
- * and is fixed by supplying more input.
+ * Loop until the request is satisfied (or no data available from
+ * below, possibly EOF).
*/
- if ((e != Z_OK) && (e != Z_BUF_ERROR)) {
- Tcl_Obj *errObj = Tcl_NewListObj(0, NULL);
+ copied = ResultCopy(cd, buf, toRead);
+ toRead -= copied;
+ buf += copied;
+ gotBytes += copied;
- Tcl_ListObjAppendElement(NULL, errObj,
- Tcl_NewStringObj(cd->inStream.msg, -1));
- Tcl_SetChannelError(cd->parent, errObj);
- *errorCodePtr = EINVAL;
- return -1;
+ if (toRead == 0) {
+ return gotBytes;
}
/*
- * Check if the inflate stopped early.
+ * The buffer is exhausted, but the caller wants even more. We now
+ * have to go to the underlying channel, get more bytes and then
+ * transform them for delivery. We may not get what we want (full EOF
+ * or temporarily out of data).
+ *
+ * Length (cd->decompressed) == 0, toRead > 0 here.
+ *
+ * The zlib transform allows us to read at most one character from the
+ * underlying channel to properly identify Z_STREAM_END without
+ * reading over the border.
*/
- if (cd->inStream.avail_in > 0) {
- continue;
- }
+ readBytes = Tcl_ReadRaw(cd->parent, cd->inBuffer, 1);
/*
- * Emptied the buffer of data from the underlying channel. Get some
- * more.
+ * Three cases here:
+ * 1. Got some data from the underlying channel (readBytes > 0) so
+ * it should be fed through the decompression engine.
+ * 2. Got an error (readBytes < 0) which we should report up except
+ * for the case where we can convert it to a short read.
+ * 3. Got an end-of-data from EOF or blocking (readBytes == 0). If
+ * it is EOF, try flushing the data out of the decompressor.
*/
- doReadFirst:
- /*
- * Hack for Bug 2762041. Disable pre-reading of lots of input, read
- * only one character. This way the Z_END_OF_STREAM can be read
- * without triggering an EOF in the base channel. The higher input
- * loops in DoReadChars() would react to that by stopping, despite the
- * transform still having data which could be read.
- *
- * This is only a hack because other transforms may not be able to
- * work around the general problem in this way.
- */
-
- readBytes = Tcl_ReadRaw(cd->parent, cd->inBuffer, 1);
if (readBytes < 0) {
+ /*
+ * Report errors to caller. The state of the seek system is
+ * unchanged!
+ */
+
+ if ((Tcl_GetErrno() == EAGAIN) && (gotBytes > 0)) {
+ /*
+ * EAGAIN is a special situation. If we had some data before
+ * we report that instead of the request to re-try.
+ */
+
+ return gotBytes;
+ }
+
*errorCodePtr = Tcl_GetErrno();
return -1;
} else if (readBytes == 0) {
- flush = Z_SYNC_FLUSH;
- }
+ /*
+ * Check wether we hit on EOF in 'parent' or not. If not,
+ * differentiate between blocking and non-blocking modes. In
+ * non-blocking mode we ran temporarily out of data. Signal this
+ * to the caller via EWOULDBLOCK and error return (-1). In the
+ * other cases we simply return what we got and let the caller
+ * wait for more. On the other hand, if we got an EOF we have to
+ * convert and flush all waiting partial data.
+ */
- cd->inStream.next_in = (Bytef *) cd->inBuffer;
- cd->inStream.avail_in = readBytes;
+ if (!Tcl_Eof(cd->parent)) {
+ /*
+ * The state of the seek system is unchanged!
+ */
+
+ if ((gotBytes == 0) && (cd->flags & ASYNC)) {
+ *errorCodePtr = EWOULDBLOCK;
+ return -1;
+ }
+ return gotBytes;
+ }
+
+ /*
+ * (Semi-)Eof in parent.
+ *
+ * Now this is a bit different. The partial data waiting is
+ * converted and returned.
+ */
+
+ if (ResultGenerate(cd, 0, Z_SYNC_FLUSH, errorCodePtr) != TCL_OK) {
+ return -1;
+ }
+
+ if (Tcl_DStringLength(&cd->decompressed) == 0) {
+ /*
+ * The drain delivered nothing. Time to deliver what we've
+ * got.
+ */
+
+ return gotBytes;
+ }
+
+ /*
+ * Reset eof, force caller to drain result buffer.
+ */
+
+ ((Channel *) cd->parent)->state->flags &= ~CHANNEL_EOF;
+ } else /* readBytes > 0 */ {
+ /*
+ * Transform the read chunk, which was not empty. Anything we get
+ * back is a transformation result to be put into our buffers, and
+ * the next iteration will put it into the result.
+ */
+
+ if (ResultGenerate(cd, readBytes, Z_NO_FLUSH,
+ errorCodePtr) != TCL_OK) {
+ return -1;
+ }
+ }
}
+ return gotBytes;
}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ZlibTransformOutput --
+ *
+ * Writer filter that does compression.
+ *
+ *----------------------------------------------------------------------
+ */
static int
ZlibTransformOutput(
@@ -2798,6 +2880,16 @@ ZlibTransformOutput(
return toWrite - cd->outStream.avail_in;
}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ZlibTransformSetOption --
+ *
+ * Writing side of [fconfigure] on our channel.
+ *
+ *----------------------------------------------------------------------
+ */
static int
ZlibTransformSetOption( /* not used */
@@ -2871,7 +2963,7 @@ ZlibTransformSetOption( /* not used */
}
if (Tcl_WriteRaw(cd->parent, cd->outBuffer,
- cd->outStream.next_out - (Bytef*)cd->outBuffer) < 0) {
+ cd->outStream.next_out - (Bytef *) cd->outBuffer) < 0) {
Tcl_AppendResult(interp, "problem flushing channel: ",
Tcl_PosixError(interp), NULL);
return TCL_ERROR;
@@ -2888,9 +2980,24 @@ ZlibTransformSetOption( /* not used */
}
}
+ /*
+ * Pass all unknown options down, to deeper transforms and/or the base
+ * channel.
+ */
+
return setOptionProc(Tcl_GetChannelInstanceData(cd->parent), interp,
optionName, value);
}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ZlibTransformGetOption --
+ *
+ * Reading side of [fconfigure] on our channel.
+ *
+ *----------------------------------------------------------------------
+ */
static int
ZlibTransformGetOption(
@@ -2989,6 +3096,17 @@ ZlibTransformGetOption(
}
return Tcl_BadChannelOption(interp, optionName, chanOptions);
}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ZlibTransformWatch, ZlibTransformEventHandler --
+ *
+ * If we have data pending, trigger a readable event after a short time
+ * (in order to allow a real event to catch up).
+ *
+ *----------------------------------------------------------------------
+ */
static void
ZlibTransformWatch(
@@ -3004,63 +3122,28 @@ ZlibTransformWatch(
watchProc = Tcl_ChannelWatchProc(Tcl_GetChannelType(cd->parent));
watchProc(Tcl_GetChannelInstanceData(cd->parent), mask);
- if (!(mask & TCL_READABLE)
- || (cd->inStream.avail_in == (uInt) cd->inAllocated)) {
- ZlibTransformTimerKill(cd);
- } else {
- ZlibTransformTimerSetup(cd);
- }
-}
-
-static int
-ZlibTransformGetHandle(
- ClientData instanceData,
- int direction,
- ClientData *handlePtr)
-{
- ZlibChannelData *cd = instanceData;
- return Tcl_GetChannelHandle(cd->parent, direction, handlePtr);
-}
-
-static int
-ZlibTransformBlockMode(
- ClientData instanceData,
- int mode)
-{
- ZlibChannelData *cd = instanceData;
-
- if (mode == TCL_MODE_NONBLOCKING) {
- cd->flags |= ASYNC;
- } else {
- cd->flags &= ~ASYNC;
+ if (!(mask & TCL_READABLE) || Tcl_DStringLength(&cd->decompressed) == 0) {
+ ZlibTransformEventTimerKill(cd);
+ } else if (cd->timer == NULL) {
+ cd->timer = Tcl_CreateTimerHandler(TRANSFORM_TIMEOUT,
+ ZlibTransformTimerRun, cd);
}
- return TCL_OK;
}
static int
-ZlibTransformHandler(
+ZlibTransformEventHandler(
ClientData instanceData,
int interestMask)
{
ZlibChannelData *cd = instanceData;
- ZlibTransformTimerKill(cd);
+ ZlibTransformEventTimerKill(cd);
return interestMask;
}
-static void
-ZlibTransformTimerSetup(
- ZlibChannelData *cd)
-{
- if (cd->timer == NULL) {
- cd->timer = Tcl_CreateTimerHandler(TRANSFORM_FLUSH_DELAY,
- ZlibTransformTimerRun, cd);
- }
-}
-
-static void
-ZlibTransformTimerKill(
+static inline void
+ZlibTransformEventTimerKill(
ZlibChannelData *cd)
{
if (cd->timer != NULL) {
@@ -3082,6 +3165,53 @@ ZlibTransformTimerRun(
/*
*----------------------------------------------------------------------
*
+ * ZlibTransformGetHandle --
+ *
+ * Anything that needs the OS handle is told to get it from what we are
+ * stacked on top of.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ZlibTransformGetHandle(
+ ClientData instanceData,
+ int direction,
+ ClientData *handlePtr)
+{
+ ZlibChannelData *cd = instanceData;
+
+ return Tcl_GetChannelHandle(cd->parent, direction, handlePtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ZlibTransformBlockMode --
+ *
+ * We need to keep track of the blocking mode; it changes our behavior.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ZlibTransformBlockMode(
+ ClientData instanceData,
+ int mode)
+{
+ ZlibChannelData *cd = instanceData;
+
+ if (mode == TCL_MODE_NONBLOCKING) {
+ cd->flags |= ASYNC;
+ } else {
+ cd->flags &= ~ASYNC;
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* ZlibStackChannelTransform --
*
* Stacks either compression or decompression onto a channel.
@@ -3207,6 +3337,8 @@ ZlibStackChannelTransform(
}
}
+ Tcl_DStringInit(&cd->decompressed);
+
chan = Tcl_StackChannel(interp, &zlibChannelType, cd,
Tcl_GetChannelMode(channel), channel);
if (chan == NULL) {
@@ -3235,6 +3367,162 @@ ZlibStackChannelTransform(
/*
*----------------------------------------------------------------------
+ *
+ * ResultCopy --
+ *
+ * Copies the requested number of bytes from the buffer into the
+ * specified array and removes them from the buffer afterward. Copies
+ * less if there is not enough data in the buffer.
+ *
+ * Side effects:
+ * See above.
+ *
+ * Result:
+ * The number of actually copied bytes, possibly less than 'toRead'.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static inline int
+ResultCopy(
+ ZlibChannelData *cd, /* The location of the buffer to read from. */
+ char *buf, /* The buffer to copy into */
+ int toRead) /* Number of requested bytes */
+{
+ int have = Tcl_DStringLength(&cd->decompressed);
+
+ if (have == 0) {
+ /*
+ * Nothing to copy in the case of an empty buffer.
+ */
+
+ return 0;
+ } else if (have > toRead) {
+ /*
+ * The internal buffer contains more than requested. Copy the
+ * requested subset to the caller, shift the remaining bytes down, and
+ * truncate.
+ */
+
+ char *src = Tcl_DStringValue(&cd->decompressed);
+
+ memcpy(buf, src, toRead);
+ memmove(src, src + toRead, have - toRead);
+
+ Tcl_DStringSetLength(&cd->decompressed, have - toRead);
+ return toRead;
+ } else /* have <= toRead */ {
+ /*
+ * There is just or not enough in the buffer to fully satisfy the
+ * caller, so take everything as best effort.
+ */
+
+ memcpy(buf, Tcl_DStringValue(&cd->decompressed), have);
+ Tcl_DStringSetLength(&cd->decompressed, 0);
+ return have;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ResultGenerate --
+ *
+ * Extract uncompressed bytes from the compression engine and store them
+ * in our working buffer.
+ *
+ * Result:
+ * TCL_OK/TCL_ERROR (with *errorCodePtr updated with reason).
+ *
+ * Side effects:
+ * See above.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ResultGenerate(
+ ZlibChannelData *cd,
+ int n,
+ int flush,
+ int *errorCodePtr)
+{
+#define MAXBUF 1024
+ unsigned char buf[MAXBUF];
+ int e, written;
+
+ cd->inStream.next_in = (Bytef *) cd->inBuffer;
+ cd->inStream.avail_in = n;
+
+ while (1) {
+ cd->inStream.next_out = (Bytef *) buf;
+ cd->inStream.avail_out = MAXBUF;
+
+ e = inflate(&cd->inStream, flush);
+ if (e == Z_NEED_DICT && cd->compDictObj) {
+ e = SetInflateDictionary(&cd->inStream, cd->compDictObj);
+ if (e == Z_OK) {
+ /*
+ * A repetition of Z_NEED_DICT is just an error.
+ */
+
+ cd->inStream.next_out = (Bytef *) buf;
+ cd->inStream.avail_out = MAXBUF;
+ e = inflate(&cd->inStream, flush);
+ }
+ }
+
+ /*
+ * avail_out is now the left over space in the output. Therefore
+ * "MAXBUF - avail_out" is the amount of bytes generated.
+ */
+
+ written = MAXBUF - cd->inStream.avail_out;
+ if (written) {
+ Tcl_DStringAppend(&cd->decompressed, (char *) buf, written);
+ }
+
+ /*
+ * The cases where we're definitely done.
+ */
+
+ if (((flush == Z_SYNC_FLUSH) && (e == Z_BUF_ERROR))
+ || (e == Z_STREAM_END)
+ || (e == Z_OK && cd->inStream.avail_out == 0)) {
+ return TCL_OK;
+ }
+
+ /*
+ * Z_BUF_ERROR can be ignored as per http://www.zlib.net/zlib_how.html
+ *
+ * Just indicates that the zlib couldn't consume input/produce output,
+ * and is fixed by supplying more input.
+ *
+ * Otherwise, we've got errors and need to report to higher-up.
+ */
+
+ if ((e != Z_OK) && (e != Z_BUF_ERROR)) {
+ Tcl_Obj *errObj = Tcl_NewListObj(0, NULL);
+
+ Tcl_ListObjAppendElement(NULL, errObj,
+ Tcl_NewStringObj(cd->inStream.msg, -1));
+ Tcl_SetChannelError(cd->parent, errObj);
+ *errorCodePtr = EINVAL;
+ return TCL_ERROR;
+ }
+
+ /*
+ * Check if the inflate stopped early.
+ */
+
+ if (cd->inStream.avail_in <= 0 && flush != Z_SYNC_FLUSH) {
+ return TCL_OK;
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
* Finally, the TclZlibInit function. Used to install the zlib API.
*----------------------------------------------------------------------
*/