summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--generic/tclIORChan.c22
-rw-r--r--tests/ioCmd.test19
2 files changed, 39 insertions, 2 deletions
diff --git a/generic/tclIORChan.c b/generic/tclIORChan.c
index a09a7a6..e81ec74 100644
--- a/generic/tclIORChan.c
+++ b/generic/tclIORChan.c
@@ -118,6 +118,7 @@ typedef struct {
* plus 4 placeholders for method, channel,
* and at most two varying (method specific)
* words. */
+ Tcl_Obj *cmd; /* */
int methods; /* Bitmask of supported methods */
/*
@@ -2183,6 +2184,10 @@ NewReflectedChannel(
*/
/* ASSERT: cmdpfxObj is a Tcl List */
+ rcPtr->cmd = TclListObjCopy(NULL, cmdpfxObj);
+ Tcl_ListObjAppendElement(NULL, rcPtr->cmd, Tcl_NewObj());
+ Tcl_ListObjAppendElement(NULL, rcPtr->cmd, handleObj);
+ Tcl_IncrRefCount(rcPtr->cmd);
Tcl_ListObjGetElements(interp, cmdpfxObj, &listc, &listv);
@@ -2289,6 +2294,7 @@ FreeReflectedChannelArgs(
*/
Tcl_DecrRefCount(rcPtr->argv[n+1]);
+ Tcl_DecrRefCount(rcPtr->cmd);
rcPtr->argc = 1;
}
@@ -2352,6 +2358,8 @@ InvokeTclMethod(
Tcl_InterpState sr; /* State of handler interp */
int result; /* Result code of method invokation */
Tcl_Obj *resObj = NULL; /* Result of method invokation. */
+ Tcl_Obj *cmd;
+ int len;
if (rcPtr->dead) {
/*
@@ -2388,6 +2396,11 @@ InvokeTclMethod(
Tcl_IncrRefCount(methObj);
rcPtr->argv[rcPtr->argc - 2] = methObj;
+ cmd = TclListObjCopy(NULL, rcPtr->cmd);
+ ListObjLength(cmd, len);
+ Tcl_ListObjReplace(NULL, cmd, len - 2, 1, 1, &methObj);
+
+
/*
* Append the additional argument containing method specific details
* behind the channel id. If specified.
@@ -2399,9 +2412,11 @@ InvokeTclMethod(
cmdc = rcPtr->argc;
if (argOneObj) {
rcPtr->argv[cmdc] = argOneObj;
+ Tcl_ListObjAppendElement(NULL, cmd, argOneObj);
cmdc++;
if (argTwoObj) {
rcPtr->argv[cmdc] = argTwoObj;
+ Tcl_ListObjAppendElement(NULL, cmd, argTwoObj);
cmdc++;
}
}
@@ -2411,9 +2426,11 @@ InvokeTclMethod(
* existing state intact.
*/
+ Tcl_IncrRefCount(cmd);
sr = Tcl_SaveInterpState(rcPtr->interp, 0 /* Dummy */);
Tcl_Preserve(rcPtr->interp);
- result = Tcl_EvalObjv(rcPtr->interp, cmdc, rcPtr->argv, TCL_EVAL_GLOBAL);
+// result = Tcl_EvalObjv(rcPtr->interp, cmdc, rcPtr->argv, TCL_EVAL_GLOBAL);
+ result = Tcl_GlobalEvalObj(rcPtr->interp, cmd);
/*
* We do not try to extract the result information if the caller has no
@@ -2439,7 +2456,7 @@ InvokeTclMethod(
*/
if (result != TCL_ERROR) {
- Tcl_Obj *cmd = Tcl_NewListObj(cmdc, rcPtr->argv);
+// Tcl_Obj *cmd = Tcl_NewListObj(cmdc, rcPtr->argv);
int cmdLen;
const char *cmdString = Tcl_GetStringFromObj(cmd, &cmdLen);
@@ -2458,6 +2475,7 @@ InvokeTclMethod(
}
Tcl_IncrRefCount(resObj);
}
+ Tcl_DecrRefCount(cmd);
Tcl_RestoreInterpState(rcPtr->interp, sr);
Tcl_Release(rcPtr->interp);
diff --git a/tests/ioCmd.test b/tests/ioCmd.test
index a150d59..0a61252 100644
--- a/tests/ioCmd.test
+++ b/tests/ioCmd.test
@@ -793,6 +793,25 @@ test iocmd-21.19 {chan create, init failure -> no channel, no finalize} -match g
rename foo {}
set res
} -result {{} {initialize rc* {read write}} 1 {*all required methods*} {}}
+test iocmd-21.20 {Bug 88aef05cda} -setup {
+ proc foo {method chan args} {
+ switch -- $method blocking {
+ chan configure $chan -blocking [lindex $args 0]
+ return
+ } initialize {
+ return {initialize finalize watch blocking read write
+ configure cget cgetall}
+ } finalize {
+ return
+ }
+ }
+ set ch [chan create {read write} foo]
+} -body {
+ list [catch {chan configure $ch -blocking 0} m] $m
+} -cleanup {
+ close $ch
+ rename foo {}
+} -match glob -result {1 {*nested eval*}}
# --- --- --- --------- --------- ---------
# Helper commands to record the arguments to handler methods.