Fossil SCM

Add workaround for bug in Tcl_EvalObjCmd when compiled against Tcl 8.6.

mistachkin 2011-08-29 09:27 UTC tcl-integration
Commit 3a6265696af8e634d1e32916f93ea1d93e79f60c
Parent cba0f25bf2996f9…
1 file changed +26 -2
~ src/th_tcl.c
M src/th_tcl.c
+26 -2
--- src/th_tcl.c
+++ src/th_tcl.c
@@ -4,10 +4,22 @@
44
55
 #include "config.h"
66
 #include "th.h"
77
 #include "tcl.h"
88
9
+/*
10
+** Are we being compiled against Tcl 8.6 or higher?
11
+ */
12
+#if (TCL_MAJOR_VERSION > 8) || \
13
+ ((TCL_MAJOR_VERSION == 8) && (TCL_MINOR_VERSION >= 6))
14
+/*
15
+** Workaround NRE-specific issue in Tcl_EvalObjCmd (SF bug #3399564) by using
16
+** Tcl_EvalObjv instead of invoking the objProc directly.
17
+ */
18
+#define USE_TCL_EVALOBJV 1
19
+#endif
20
+
921
 /*
1022
 ** These macros are designed to reduce the redundant code required to marshal
1123
 ** arguments from TH1 to Tcl.
1224
 */
1325
 #define USE_ARGV_TO_OBJV() \
@@ -159,16 +171,20 @@
159171
 int argc,
160172
 const char **argv,
161173
 int *argl
162174
 ){
163175
 Tcl_Interp *tclInterp;
176
+#ifndef USE_TCL_EVALOBJV
164177
 Tcl_Command command;
165178
 Tcl_CmdInfo cmdInfo;
179
+#endif
166180
 int rc;
167181
 int nResult;
168182
 const char *zResult;
183
+#ifndef USE_TCL_EVALOBJV
169184
 Tcl_Obj *objPtr;
185
+#endif
170186
 USE_ARGV_TO_OBJV();
171187
172188
 if( argc<2 ){
173189
 return Th_WrongNumArgs(interp, "tclInvoke command ?arg ...?");
174190
 }
@@ -176,10 +192,11 @@
176192
 if( !tclInterp || Tcl_InterpDeleted(tclInterp) ){
177193
 Th_ErrorMessage(interp, "invalid Tcl interpreter", (const char *)"", 0);
178194
 return TH_ERROR;
179195
 }
180196
 Tcl_Preserve((ClientData)tclInterp);
197
+#ifndef USE_TCL_EVALOBJV
181198
 objPtr = Tcl_NewStringObj(argv[1], argl[1]);
182199
 Tcl_IncrRefCount(objPtr);
183200
 command = Tcl_GetCommandFromObj(tclInterp, objPtr);
184201
 if( !command || Tcl_GetCommandInfoFromToken(command,&cmdInfo)==0 ){
185202
 Th_ErrorMessage(interp, "Tcl command not found:", argv[1], argl[1]);
@@ -192,13 +209,18 @@
192209
 Tcl_DecrRefCount(objPtr);
193210
 Tcl_Release((ClientData)tclInterp);
194211
 return TH_ERROR;
195212
 }
196213
 Tcl_DecrRefCount(objPtr);
214
+#endif
197215
 COPY_ARGV_TO_OBJV();
216
+#ifdef USE_TCL_EVALOBJV
217
+ rc = Tcl_EvalObjv(tclInterp, objc, objv, 0);
218
+#else
198219
 Tcl_ResetResult(tclInterp);
199220
 rc = cmdInfo.objProc(cmdInfo.objClientData, tclInterp, objc, objv);
221
+#endif
200222
 FREE_ARGV_TO_OBJV();
201223
 zResult = getTclResult(tclInterp, &nResult);
202224
 Th_SetResult(interp, zResult, nResult);
203225
 Tcl_Release((ClientData)tclInterp);
204226
 return rc;
@@ -213,19 +235,20 @@
213235
 ClientData clientData,
214236
 Tcl_Interp *interp,
215237
 int objc,
216238
 Tcl_Obj *CONST objv[]
217239
 ){
218
- Th_Interp *th1Interp = (Th_Interp *)clientData;
240
+ Th_Interp *th1Interp;
219241
 int nArg;
220242
 const char *arg;
221243
 int rc;
222244
223245
 if( objc!=2 ){
224246
 Tcl_WrongNumArgs(interp, 1, objv, "arg");
225247
 return TCL_ERROR;
226248
 }
249
+ th1Interp = (Th_Interp *)clientData;
227250
 if( !th1Interp ){
228251
 Tcl_AppendResult(interp, "invalid TH1 interpreter", NULL);
229252
 return TCL_ERROR;
230253
 }
231254
 arg = Tcl_GetStringFromObj(objv[1], &nArg);
@@ -244,19 +267,20 @@
244267
 ClientData clientData,
245268
 Tcl_Interp *interp,
246269
 int objc,
247270
 Tcl_Obj *CONST objv[]
248271
 ){
249
- Th_Interp *th1Interp = (Th_Interp *)clientData;
272
+ Th_Interp *th1Interp;
250273
 int nArg;
251274
 const char *arg;
252275
 int rc;
253276
254277
 if( objc!=2 ){
255278
 Tcl_WrongNumArgs(interp, 1, objv, "arg");
256279
 return TCL_ERROR;
257280
 }
281
+ th1Interp = (Th_Interp *)clientData;
258282
 if( !th1Interp ){
259283
 Tcl_AppendResult(interp, "invalid TH1 interpreter", NULL);
260284
 return TCL_ERROR;
261285
 }
262286
 arg = Tcl_GetStringFromObj(objv[1], &nArg);
263287
--- src/th_tcl.c
+++ src/th_tcl.c
@@ -4,10 +4,22 @@
4
5 #include "config.h"
6 #include "th.h"
7 #include "tcl.h"
8
 
 
 
 
 
 
 
 
 
 
 
 
9 /*
10 ** These macros are designed to reduce the redundant code required to marshal
11 ** arguments from TH1 to Tcl.
12 */
13 #define USE_ARGV_TO_OBJV() \
@@ -159,16 +171,20 @@
159 int argc,
160 const char **argv,
161 int *argl
162 ){
163 Tcl_Interp *tclInterp;
 
164 Tcl_Command command;
165 Tcl_CmdInfo cmdInfo;
 
166 int rc;
167 int nResult;
168 const char *zResult;
 
169 Tcl_Obj *objPtr;
 
170 USE_ARGV_TO_OBJV();
171
172 if( argc<2 ){
173 return Th_WrongNumArgs(interp, "tclInvoke command ?arg ...?");
174 }
@@ -176,10 +192,11 @@
176 if( !tclInterp || Tcl_InterpDeleted(tclInterp) ){
177 Th_ErrorMessage(interp, "invalid Tcl interpreter", (const char *)"", 0);
178 return TH_ERROR;
179 }
180 Tcl_Preserve((ClientData)tclInterp);
 
181 objPtr = Tcl_NewStringObj(argv[1], argl[1]);
182 Tcl_IncrRefCount(objPtr);
183 command = Tcl_GetCommandFromObj(tclInterp, objPtr);
184 if( !command || Tcl_GetCommandInfoFromToken(command,&cmdInfo)==0 ){
185 Th_ErrorMessage(interp, "Tcl command not found:", argv[1], argl[1]);
@@ -192,13 +209,18 @@
192 Tcl_DecrRefCount(objPtr);
193 Tcl_Release((ClientData)tclInterp);
194 return TH_ERROR;
195 }
196 Tcl_DecrRefCount(objPtr);
 
197 COPY_ARGV_TO_OBJV();
 
 
 
198 Tcl_ResetResult(tclInterp);
199 rc = cmdInfo.objProc(cmdInfo.objClientData, tclInterp, objc, objv);
 
200 FREE_ARGV_TO_OBJV();
201 zResult = getTclResult(tclInterp, &nResult);
202 Th_SetResult(interp, zResult, nResult);
203 Tcl_Release((ClientData)tclInterp);
204 return rc;
@@ -213,19 +235,20 @@
213 ClientData clientData,
214 Tcl_Interp *interp,
215 int objc,
216 Tcl_Obj *CONST objv[]
217 ){
218 Th_Interp *th1Interp = (Th_Interp *)clientData;
219 int nArg;
220 const char *arg;
221 int rc;
222
223 if( objc!=2 ){
224 Tcl_WrongNumArgs(interp, 1, objv, "arg");
225 return TCL_ERROR;
226 }
 
227 if( !th1Interp ){
228 Tcl_AppendResult(interp, "invalid TH1 interpreter", NULL);
229 return TCL_ERROR;
230 }
231 arg = Tcl_GetStringFromObj(objv[1], &nArg);
@@ -244,19 +267,20 @@
244 ClientData clientData,
245 Tcl_Interp *interp,
246 int objc,
247 Tcl_Obj *CONST objv[]
248 ){
249 Th_Interp *th1Interp = (Th_Interp *)clientData;
250 int nArg;
251 const char *arg;
252 int rc;
253
254 if( objc!=2 ){
255 Tcl_WrongNumArgs(interp, 1, objv, "arg");
256 return TCL_ERROR;
257 }
 
258 if( !th1Interp ){
259 Tcl_AppendResult(interp, "invalid TH1 interpreter", NULL);
260 return TCL_ERROR;
261 }
262 arg = Tcl_GetStringFromObj(objv[1], &nArg);
263
--- src/th_tcl.c
+++ src/th_tcl.c
@@ -4,10 +4,22 @@
4
5 #include "config.h"
6 #include "th.h"
7 #include "tcl.h"
8
9 /*
10 ** Are we being compiled against Tcl 8.6 or higher?
11 */
12 #if (TCL_MAJOR_VERSION > 8) || \
13 ((TCL_MAJOR_VERSION == 8) && (TCL_MINOR_VERSION >= 6))
14 /*
15 ** Workaround NRE-specific issue in Tcl_EvalObjCmd (SF bug #3399564) by using
16 ** Tcl_EvalObjv instead of invoking the objProc directly.
17 */
18 #define USE_TCL_EVALOBJV 1
19 #endif
20
21 /*
22 ** These macros are designed to reduce the redundant code required to marshal
23 ** arguments from TH1 to Tcl.
24 */
25 #define USE_ARGV_TO_OBJV() \
@@ -159,16 +171,20 @@
171 int argc,
172 const char **argv,
173 int *argl
174 ){
175 Tcl_Interp *tclInterp;
176 #ifndef USE_TCL_EVALOBJV
177 Tcl_Command command;
178 Tcl_CmdInfo cmdInfo;
179 #endif
180 int rc;
181 int nResult;
182 const char *zResult;
183 #ifndef USE_TCL_EVALOBJV
184 Tcl_Obj *objPtr;
185 #endif
186 USE_ARGV_TO_OBJV();
187
188 if( argc<2 ){
189 return Th_WrongNumArgs(interp, "tclInvoke command ?arg ...?");
190 }
@@ -176,10 +192,11 @@
192 if( !tclInterp || Tcl_InterpDeleted(tclInterp) ){
193 Th_ErrorMessage(interp, "invalid Tcl interpreter", (const char *)"", 0);
194 return TH_ERROR;
195 }
196 Tcl_Preserve((ClientData)tclInterp);
197 #ifndef USE_TCL_EVALOBJV
198 objPtr = Tcl_NewStringObj(argv[1], argl[1]);
199 Tcl_IncrRefCount(objPtr);
200 command = Tcl_GetCommandFromObj(tclInterp, objPtr);
201 if( !command || Tcl_GetCommandInfoFromToken(command,&cmdInfo)==0 ){
202 Th_ErrorMessage(interp, "Tcl command not found:", argv[1], argl[1]);
@@ -192,13 +209,18 @@
209 Tcl_DecrRefCount(objPtr);
210 Tcl_Release((ClientData)tclInterp);
211 return TH_ERROR;
212 }
213 Tcl_DecrRefCount(objPtr);
214 #endif
215 COPY_ARGV_TO_OBJV();
216 #ifdef USE_TCL_EVALOBJV
217 rc = Tcl_EvalObjv(tclInterp, objc, objv, 0);
218 #else
219 Tcl_ResetResult(tclInterp);
220 rc = cmdInfo.objProc(cmdInfo.objClientData, tclInterp, objc, objv);
221 #endif
222 FREE_ARGV_TO_OBJV();
223 zResult = getTclResult(tclInterp, &nResult);
224 Th_SetResult(interp, zResult, nResult);
225 Tcl_Release((ClientData)tclInterp);
226 return rc;
@@ -213,19 +235,20 @@
235 ClientData clientData,
236 Tcl_Interp *interp,
237 int objc,
238 Tcl_Obj *CONST objv[]
239 ){
240 Th_Interp *th1Interp;
241 int nArg;
242 const char *arg;
243 int rc;
244
245 if( objc!=2 ){
246 Tcl_WrongNumArgs(interp, 1, objv, "arg");
247 return TCL_ERROR;
248 }
249 th1Interp = (Th_Interp *)clientData;
250 if( !th1Interp ){
251 Tcl_AppendResult(interp, "invalid TH1 interpreter", NULL);
252 return TCL_ERROR;
253 }
254 arg = Tcl_GetStringFromObj(objv[1], &nArg);
@@ -244,19 +267,20 @@
267 ClientData clientData,
268 Tcl_Interp *interp,
269 int objc,
270 Tcl_Obj *CONST objv[]
271 ){
272 Th_Interp *th1Interp;
273 int nArg;
274 const char *arg;
275 int rc;
276
277 if( objc!=2 ){
278 Tcl_WrongNumArgs(interp, 1, objv, "arg");
279 return TCL_ERROR;
280 }
281 th1Interp = (Th_Interp *)clientData;
282 if( !th1Interp ){
283 Tcl_AppendResult(interp, "invalid TH1 interpreter", NULL);
284 return TCL_ERROR;
285 }
286 arg = Tcl_GetStringFromObj(objv[1], &nArg);
287

Keyboard Shortcuts

Open search /
Next entry (timeline) j
Previous entry (timeline) k
Open focused entry Enter
Show this help ?
Toggle theme Top nav button