Fossil SCM

Reset result prior to direct Tcl invocation. Cast all ckalloc return values. Make sure the global config database is open for the 'test_th_render' command. Allow the 'tcl' setting to be enabled via the environment.

mistachkin 2011-08-28 06:54 tcl-integration
Commit 5cc15d08900cd34eba9dc5a9fad0891e692036aa
+2 -1
--- src/th_main.c
+++ src/th_main.c
@@ -363,11 +363,11 @@
363363
if( g.interp==0 ){
364364
int i;
365365
g.interp = Th_CreateInterp(&vtab);
366366
th_register_language(g.interp); /* Basic scripting commands. */
367367
#ifdef FOSSIL_ENABLE_TCL
368
- if( db_get_boolean("tcl", 0) ){
368
+ if( getenv("TH1_ENABLE_TCL")!=0 || db_get_boolean("tcl", 0) ){
369369
th_register_tcl(g.interp); /* Tcl integration commands. */
370370
}
371371
#endif
372372
for(i=0; i<sizeof(aCommand)/sizeof(aCommand[0]); i++){
373373
Th_CreateCommand(g.interp, aCommand[i].zName, aCommand[i].xProc,
@@ -534,9 +534,10 @@
534534
void test_th_render(void){
535535
Blob in;
536536
if( g.argc<3 ){
537537
usage("FILE");
538538
}
539
+ db_open_config(0); /* Needed for "tcl" setting. */
539540
blob_zero(&in);
540541
blob_read_from_file(&in, g.argv[2]);
541542
Th_Render(blob_str(&in));
542543
}
543544
--- src/th_main.c
+++ src/th_main.c
@@ -363,11 +363,11 @@
363 if( g.interp==0 ){
364 int i;
365 g.interp = Th_CreateInterp(&vtab);
366 th_register_language(g.interp); /* Basic scripting commands. */
367 #ifdef FOSSIL_ENABLE_TCL
368 if( db_get_boolean("tcl", 0) ){
369 th_register_tcl(g.interp); /* Tcl integration commands. */
370 }
371 #endif
372 for(i=0; i<sizeof(aCommand)/sizeof(aCommand[0]); i++){
373 Th_CreateCommand(g.interp, aCommand[i].zName, aCommand[i].xProc,
@@ -534,9 +534,10 @@
534 void test_th_render(void){
535 Blob in;
536 if( g.argc<3 ){
537 usage("FILE");
538 }
 
539 blob_zero(&in);
540 blob_read_from_file(&in, g.argv[2]);
541 Th_Render(blob_str(&in));
542 }
543
--- src/th_main.c
+++ src/th_main.c
@@ -363,11 +363,11 @@
363 if( g.interp==0 ){
364 int i;
365 g.interp = Th_CreateInterp(&vtab);
366 th_register_language(g.interp); /* Basic scripting commands. */
367 #ifdef FOSSIL_ENABLE_TCL
368 if( getenv("TH1_ENABLE_TCL")!=0 || db_get_boolean("tcl", 0) ){
369 th_register_tcl(g.interp); /* Tcl integration commands. */
370 }
371 #endif
372 for(i=0; i<sizeof(aCommand)/sizeof(aCommand[0]); i++){
373 Th_CreateCommand(g.interp, aCommand[i].zName, aCommand[i].xProc,
@@ -534,9 +534,10 @@
534 void test_th_render(void){
535 Blob in;
536 if( g.argc<3 ){
537 usage("FILE");
538 }
539 db_open_config(0); /* Needed for "tcl" setting. */
540 blob_zero(&in);
541 blob_read_from_file(&in, g.argv[2]);
542 Th_Render(blob_str(&in));
543 }
544
+5 -12
--- src/th_tcl.c
+++ src/th_tcl.c
@@ -37,11 +37,11 @@
3737
Tcl_IncrRefCount(objPtr);
3838
rc = Tcl_EvalObjEx(tclInterp, objPtr, 0);
3939
Tcl_DecrRefCount(objPtr);
4040
}else{
4141
int objc = argc-1;
42
- Tcl_Obj **objv = ckalloc((unsigned)(objc * sizeof(Tcl_Obj *)));
42
+ Tcl_Obj **objv = (Tcl_Obj **)ckalloc((unsigned)(objc * sizeof(Tcl_Obj *)));
4343
int i;
4444
for(i=1; i<argc; i++){
4545
objv[i-1] = Tcl_NewStringObj(argv[i], argl[i]);
4646
Tcl_IncrRefCount(objv[i-1]);
4747
}
@@ -92,11 +92,11 @@
9292
Tcl_IncrRefCount(objPtr);
9393
rc = Tcl_ExprObj(tclInterp, objPtr, &resultObjPtr);
9494
Tcl_DecrRefCount(objPtr);
9595
}else{
9696
int objc = argc-1;
97
- Tcl_Obj **objv = ckalloc((unsigned)(objc * sizeof(Tcl_Obj *)));
97
+ Tcl_Obj **objv = (Tcl_Obj **)ckalloc((unsigned)(objc * sizeof(Tcl_Obj *)));
9898
int i;
9999
for(i=1; i<argc; i++){
100100
objv[i-1] = Tcl_NewStringObj(argv[i], argl[i]);
101101
Tcl_IncrRefCount(objv[i-1]);
102102
}
@@ -143,21 +143,22 @@
143143
tclInterp = (Tcl_Interp *)ctx;
144144
if( !tclInterp ){
145145
Th_ErrorMessage(interp, "invalid Tcl interpreter", (const char *)"", 0);
146146
return TH_ERROR;
147147
}
148
- if (Tcl_GetCommandInfo(tclInterp, argv[1], &cmdInfo) == 0) {
148
+ if (Tcl_GetCommandInfo(tclInterp, argv[1], &cmdInfo) == 0){
149149
Th_ErrorMessage(interp, "Tcl command not found:", argv[1], argl[1]);
150150
return TH_ERROR;
151151
}
152152
objc = argc-1;
153
- objv = ckalloc((unsigned)(objc * sizeof(Tcl_Obj *)));
153
+ objv = (Tcl_Obj **)ckalloc((unsigned)(objc * sizeof(Tcl_Obj *)));
154154
for(i=1; i<argc; i++){
155155
objv[i-1] = Tcl_NewStringObj(argv[i], argl[i]);
156156
Tcl_IncrRefCount(objv[i-1]);
157157
}
158158
Tcl_Preserve((ClientData)tclInterp);
159
+ Tcl_ResetResult(tclInterp);
159160
rc = cmdInfo.objProc(cmdInfo.objClientData, tclInterp, objc, objv);
160161
for(i=1; i<argc; i++){
161162
Tcl_DecrRefCount(objv[i-1]);
162163
}
163164
ckfree((char *)objv);
@@ -186,16 +187,14 @@
186187
187188
if( objc!=2 ){
188189
Tcl_WrongNumArgs(interp, 1, objv, "arg");
189190
return TCL_ERROR;
190191
}
191
-
192192
if( !th1Interp ){
193193
Tcl_AppendResult(interp, "invalid TH1 interpreter", NULL);
194194
return TCL_ERROR;
195195
}
196
-
197196
arg = Tcl_GetStringFromObj(objv[1], &nArg);
198197
rc = Th_Eval(th1Interp, 0, arg, nArg);
199198
arg = Th_GetResult(th1Interp, &nArg);
200199
Tcl_SetObjResult(interp, Tcl_NewStringObj(arg, nArg));
201200
return rc;
@@ -219,16 +218,14 @@
219218
220219
if( objc!=2 ){
221220
Tcl_WrongNumArgs(interp, 1, objv, "arg");
222221
return TCL_ERROR;
223222
}
224
-
225223
if( !th1Interp ){
226224
Tcl_AppendResult(interp, "invalid TH1 interpreter", NULL);
227225
return TCL_ERROR;
228226
}
229
-
230227
arg = Tcl_GetStringFromObj(objv[1], &nArg);
231228
rc = Th_Expr(th1Interp, arg, nArg);
232229
arg = Th_GetResult(th1Interp, &nArg);
233230
Tcl_SetObjResult(interp, Tcl_NewStringObj(arg, nArg));
234231
return rc;
@@ -277,27 +274,23 @@
277274
if( !tclInterp ){
278275
Th_ErrorMessage(interp,
279276
"Could not create Tcl interpreter", (const char *)"", 0);
280277
return TH_ERROR;
281278
}
282
-
283279
if( Tcl_Init(tclInterp)!=TCL_OK ){
284280
Th_ErrorMessage(interp,
285281
"Tcl initialization error:", Tcl_GetStringResult(tclInterp), -1);
286282
Tcl_DeleteInterp(tclInterp);
287283
return TH_ERROR;
288284
}
289
-
290285
Tcl_CallWhenDeleted(tclInterp, Th1DeleteProc, interp);
291286
Tcl_CreateObjCommand(tclInterp, "th1Eval", Th1EvalObjCmd, interp, NULL);
292287
Tcl_CreateObjCommand(tclInterp, "th1Expr", Th1ExprObjCmd, interp, NULL);
293
-
294288
/* Add the Tcl integration commands. */
295289
for(i=0; i<(sizeof(aCommand)/sizeof(aCommand[0])); i++){
296290
void *ctx = aCommand[i].pContext;
297291
/* Use Tcl interpreter for context? */
298292
if( !ctx ) ctx = tclInterp;
299293
Th_CreateCommand(interp, aCommand[i].zName, aCommand[i].xProc, ctx, 0);
300294
}
301
-
302295
return TH_OK;
303296
}
304297
--- src/th_tcl.c
+++ src/th_tcl.c
@@ -37,11 +37,11 @@
37 Tcl_IncrRefCount(objPtr);
38 rc = Tcl_EvalObjEx(tclInterp, objPtr, 0);
39 Tcl_DecrRefCount(objPtr);
40 }else{
41 int objc = argc-1;
42 Tcl_Obj **objv = ckalloc((unsigned)(objc * sizeof(Tcl_Obj *)));
43 int i;
44 for(i=1; i<argc; i++){
45 objv[i-1] = Tcl_NewStringObj(argv[i], argl[i]);
46 Tcl_IncrRefCount(objv[i-1]);
47 }
@@ -92,11 +92,11 @@
92 Tcl_IncrRefCount(objPtr);
93 rc = Tcl_ExprObj(tclInterp, objPtr, &resultObjPtr);
94 Tcl_DecrRefCount(objPtr);
95 }else{
96 int objc = argc-1;
97 Tcl_Obj **objv = ckalloc((unsigned)(objc * sizeof(Tcl_Obj *)));
98 int i;
99 for(i=1; i<argc; i++){
100 objv[i-1] = Tcl_NewStringObj(argv[i], argl[i]);
101 Tcl_IncrRefCount(objv[i-1]);
102 }
@@ -143,21 +143,22 @@
143 tclInterp = (Tcl_Interp *)ctx;
144 if( !tclInterp ){
145 Th_ErrorMessage(interp, "invalid Tcl interpreter", (const char *)"", 0);
146 return TH_ERROR;
147 }
148 if (Tcl_GetCommandInfo(tclInterp, argv[1], &cmdInfo) == 0) {
149 Th_ErrorMessage(interp, "Tcl command not found:", argv[1], argl[1]);
150 return TH_ERROR;
151 }
152 objc = argc-1;
153 objv = ckalloc((unsigned)(objc * sizeof(Tcl_Obj *)));
154 for(i=1; i<argc; i++){
155 objv[i-1] = Tcl_NewStringObj(argv[i], argl[i]);
156 Tcl_IncrRefCount(objv[i-1]);
157 }
158 Tcl_Preserve((ClientData)tclInterp);
 
159 rc = cmdInfo.objProc(cmdInfo.objClientData, tclInterp, objc, objv);
160 for(i=1; i<argc; i++){
161 Tcl_DecrRefCount(objv[i-1]);
162 }
163 ckfree((char *)objv);
@@ -186,16 +187,14 @@
186
187 if( objc!=2 ){
188 Tcl_WrongNumArgs(interp, 1, objv, "arg");
189 return TCL_ERROR;
190 }
191
192 if( !th1Interp ){
193 Tcl_AppendResult(interp, "invalid TH1 interpreter", NULL);
194 return TCL_ERROR;
195 }
196
197 arg = Tcl_GetStringFromObj(objv[1], &nArg);
198 rc = Th_Eval(th1Interp, 0, arg, nArg);
199 arg = Th_GetResult(th1Interp, &nArg);
200 Tcl_SetObjResult(interp, Tcl_NewStringObj(arg, nArg));
201 return rc;
@@ -219,16 +218,14 @@
219
220 if( objc!=2 ){
221 Tcl_WrongNumArgs(interp, 1, objv, "arg");
222 return TCL_ERROR;
223 }
224
225 if( !th1Interp ){
226 Tcl_AppendResult(interp, "invalid TH1 interpreter", NULL);
227 return TCL_ERROR;
228 }
229
230 arg = Tcl_GetStringFromObj(objv[1], &nArg);
231 rc = Th_Expr(th1Interp, arg, nArg);
232 arg = Th_GetResult(th1Interp, &nArg);
233 Tcl_SetObjResult(interp, Tcl_NewStringObj(arg, nArg));
234 return rc;
@@ -277,27 +274,23 @@
277 if( !tclInterp ){
278 Th_ErrorMessage(interp,
279 "Could not create Tcl interpreter", (const char *)"", 0);
280 return TH_ERROR;
281 }
282
283 if( Tcl_Init(tclInterp)!=TCL_OK ){
284 Th_ErrorMessage(interp,
285 "Tcl initialization error:", Tcl_GetStringResult(tclInterp), -1);
286 Tcl_DeleteInterp(tclInterp);
287 return TH_ERROR;
288 }
289
290 Tcl_CallWhenDeleted(tclInterp, Th1DeleteProc, interp);
291 Tcl_CreateObjCommand(tclInterp, "th1Eval", Th1EvalObjCmd, interp, NULL);
292 Tcl_CreateObjCommand(tclInterp, "th1Expr", Th1ExprObjCmd, interp, NULL);
293
294 /* Add the Tcl integration commands. */
295 for(i=0; i<(sizeof(aCommand)/sizeof(aCommand[0])); i++){
296 void *ctx = aCommand[i].pContext;
297 /* Use Tcl interpreter for context? */
298 if( !ctx ) ctx = tclInterp;
299 Th_CreateCommand(interp, aCommand[i].zName, aCommand[i].xProc, ctx, 0);
300 }
301
302 return TH_OK;
303 }
304
--- src/th_tcl.c
+++ src/th_tcl.c
@@ -37,11 +37,11 @@
37 Tcl_IncrRefCount(objPtr);
38 rc = Tcl_EvalObjEx(tclInterp, objPtr, 0);
39 Tcl_DecrRefCount(objPtr);
40 }else{
41 int objc = argc-1;
42 Tcl_Obj **objv = (Tcl_Obj **)ckalloc((unsigned)(objc * sizeof(Tcl_Obj *)));
43 int i;
44 for(i=1; i<argc; i++){
45 objv[i-1] = Tcl_NewStringObj(argv[i], argl[i]);
46 Tcl_IncrRefCount(objv[i-1]);
47 }
@@ -92,11 +92,11 @@
92 Tcl_IncrRefCount(objPtr);
93 rc = Tcl_ExprObj(tclInterp, objPtr, &resultObjPtr);
94 Tcl_DecrRefCount(objPtr);
95 }else{
96 int objc = argc-1;
97 Tcl_Obj **objv = (Tcl_Obj **)ckalloc((unsigned)(objc * sizeof(Tcl_Obj *)));
98 int i;
99 for(i=1; i<argc; i++){
100 objv[i-1] = Tcl_NewStringObj(argv[i], argl[i]);
101 Tcl_IncrRefCount(objv[i-1]);
102 }
@@ -143,21 +143,22 @@
143 tclInterp = (Tcl_Interp *)ctx;
144 if( !tclInterp ){
145 Th_ErrorMessage(interp, "invalid Tcl interpreter", (const char *)"", 0);
146 return TH_ERROR;
147 }
148 if (Tcl_GetCommandInfo(tclInterp, argv[1], &cmdInfo) == 0){
149 Th_ErrorMessage(interp, "Tcl command not found:", argv[1], argl[1]);
150 return TH_ERROR;
151 }
152 objc = argc-1;
153 objv = (Tcl_Obj **)ckalloc((unsigned)(objc * sizeof(Tcl_Obj *)));
154 for(i=1; i<argc; i++){
155 objv[i-1] = Tcl_NewStringObj(argv[i], argl[i]);
156 Tcl_IncrRefCount(objv[i-1]);
157 }
158 Tcl_Preserve((ClientData)tclInterp);
159 Tcl_ResetResult(tclInterp);
160 rc = cmdInfo.objProc(cmdInfo.objClientData, tclInterp, objc, objv);
161 for(i=1; i<argc; i++){
162 Tcl_DecrRefCount(objv[i-1]);
163 }
164 ckfree((char *)objv);
@@ -186,16 +187,14 @@
187
188 if( objc!=2 ){
189 Tcl_WrongNumArgs(interp, 1, objv, "arg");
190 return TCL_ERROR;
191 }
 
192 if( !th1Interp ){
193 Tcl_AppendResult(interp, "invalid TH1 interpreter", NULL);
194 return TCL_ERROR;
195 }
 
196 arg = Tcl_GetStringFromObj(objv[1], &nArg);
197 rc = Th_Eval(th1Interp, 0, arg, nArg);
198 arg = Th_GetResult(th1Interp, &nArg);
199 Tcl_SetObjResult(interp, Tcl_NewStringObj(arg, nArg));
200 return rc;
@@ -219,16 +218,14 @@
218
219 if( objc!=2 ){
220 Tcl_WrongNumArgs(interp, 1, objv, "arg");
221 return TCL_ERROR;
222 }
 
223 if( !th1Interp ){
224 Tcl_AppendResult(interp, "invalid TH1 interpreter", NULL);
225 return TCL_ERROR;
226 }
 
227 arg = Tcl_GetStringFromObj(objv[1], &nArg);
228 rc = Th_Expr(th1Interp, arg, nArg);
229 arg = Th_GetResult(th1Interp, &nArg);
230 Tcl_SetObjResult(interp, Tcl_NewStringObj(arg, nArg));
231 return rc;
@@ -277,27 +274,23 @@
274 if( !tclInterp ){
275 Th_ErrorMessage(interp,
276 "Could not create Tcl interpreter", (const char *)"", 0);
277 return TH_ERROR;
278 }
 
279 if( Tcl_Init(tclInterp)!=TCL_OK ){
280 Th_ErrorMessage(interp,
281 "Tcl initialization error:", Tcl_GetStringResult(tclInterp), -1);
282 Tcl_DeleteInterp(tclInterp);
283 return TH_ERROR;
284 }
 
285 Tcl_CallWhenDeleted(tclInterp, Th1DeleteProc, interp);
286 Tcl_CreateObjCommand(tclInterp, "th1Eval", Th1EvalObjCmd, interp, NULL);
287 Tcl_CreateObjCommand(tclInterp, "th1Expr", Th1ExprObjCmd, interp, NULL);
 
288 /* Add the Tcl integration commands. */
289 for(i=0; i<(sizeof(aCommand)/sizeof(aCommand[0])); i++){
290 void *ctx = aCommand[i].pContext;
291 /* Use Tcl interpreter for context? */
292 if( !ctx ) ctx = tclInterp;
293 Th_CreateCommand(interp, aCommand[i].zName, aCommand[i].xProc, ctx, 0);
294 }
 
295 return TH_OK;
296 }
297
--- win/Makefile.mingw.mistachkin
+++ win/Makefile.mingw.mistachkin
@@ -41,11 +41,11 @@
4141
#### The directory where the Tcl library source code is located.
4242
#
4343
#
4444
TCLDIR = $(SRCDIR)/../tcl-8.6
4545
46
-#### C Compile and options for use in building executables that
46
+#### C Compile and options for use in building executables that
4747
# will run on the target platform. This is usually the same
4848
# as BCC, unless you are cross-compiling. This C compiler builds
4949
# the finished binary for fossil. The BCC compiler above is used
5050
# for building intermediate code-generator tools.
5151
#
@@ -81,10 +81,11 @@
8181
8282
# OpenSSL:
8383
ifdef FOSSIL_ENABLE_SSL
8484
LIB += -lssl -lcrypto -lgdi32
8585
endif
86
+
8687
LIB += -lmingwex -lz -lws2_32
8788
8889
ifdef FOSSIL_ENABLE_TCL
8990
LIB += -ltcl86t
9091
endif
@@ -409,18 +410,18 @@
409410
$(TCC) -o $(APPNAME) $(OBJ) $(EXTRAOBJ) $(LIB) $(OBJDIR)/icon.o
410411
411412
# This rule prevents make from using its default rules to try build
412413
# an executable named "manifest" out of the file named "manifest.c"
413414
#
414
-$(SRCDIR)/../manifest:
415
+$(SRCDIR)/../manifest:
415416
# noop
416417
417418
# Requires msys to be installed in addition to the mingw, for the "rm"
418419
# command. "del" will not work here because it is not a separate command
419420
# but a MSDOS-shell builtin.
420421
#
421
-clean:
422
+clean:
422423
rm -rf $(OBJDIR) $(APPNAME)
423424
424425
setup: $(OBJDIR) $(APPNAME)
425426
$(MAKENSIS) ./fossil.nsi
426427
427428
--- win/Makefile.mingw.mistachkin
+++ win/Makefile.mingw.mistachkin
@@ -41,11 +41,11 @@
41 #### The directory where the Tcl library source code is located.
42 #
43 #
44 TCLDIR = $(SRCDIR)/../tcl-8.6
45
46 #### C Compile and options for use in building executables that
47 # will run on the target platform. This is usually the same
48 # as BCC, unless you are cross-compiling. This C compiler builds
49 # the finished binary for fossil. The BCC compiler above is used
50 # for building intermediate code-generator tools.
51 #
@@ -81,10 +81,11 @@
81
82 # OpenSSL:
83 ifdef FOSSIL_ENABLE_SSL
84 LIB += -lssl -lcrypto -lgdi32
85 endif
 
86 LIB += -lmingwex -lz -lws2_32
87
88 ifdef FOSSIL_ENABLE_TCL
89 LIB += -ltcl86t
90 endif
@@ -409,18 +410,18 @@
409 $(TCC) -o $(APPNAME) $(OBJ) $(EXTRAOBJ) $(LIB) $(OBJDIR)/icon.o
410
411 # This rule prevents make from using its default rules to try build
412 # an executable named "manifest" out of the file named "manifest.c"
413 #
414 $(SRCDIR)/../manifest:
415 # noop
416
417 # Requires msys to be installed in addition to the mingw, for the "rm"
418 # command. "del" will not work here because it is not a separate command
419 # but a MSDOS-shell builtin.
420 #
421 clean:
422 rm -rf $(OBJDIR) $(APPNAME)
423
424 setup: $(OBJDIR) $(APPNAME)
425 $(MAKENSIS) ./fossil.nsi
426
427
--- win/Makefile.mingw.mistachkin
+++ win/Makefile.mingw.mistachkin
@@ -41,11 +41,11 @@
41 #### The directory where the Tcl library source code is located.
42 #
43 #
44 TCLDIR = $(SRCDIR)/../tcl-8.6
45
46 #### C Compile and options for use in building executables that
47 # will run on the target platform. This is usually the same
48 # as BCC, unless you are cross-compiling. This C compiler builds
49 # the finished binary for fossil. The BCC compiler above is used
50 # for building intermediate code-generator tools.
51 #
@@ -81,10 +81,11 @@
81
82 # OpenSSL:
83 ifdef FOSSIL_ENABLE_SSL
84 LIB += -lssl -lcrypto -lgdi32
85 endif
86
87 LIB += -lmingwex -lz -lws2_32
88
89 ifdef FOSSIL_ENABLE_TCL
90 LIB += -ltcl86t
91 endif
@@ -409,18 +410,18 @@
410 $(TCC) -o $(APPNAME) $(OBJ) $(EXTRAOBJ) $(LIB) $(OBJDIR)/icon.o
411
412 # This rule prevents make from using its default rules to try build
413 # an executable named "manifest" out of the file named "manifest.c"
414 #
415 $(SRCDIR)/../manifest:
416 # noop
417
418 # Requires msys to be installed in addition to the mingw, for the "rm"
419 # command. "del" will not work here because it is not a separate command
420 # but a MSDOS-shell builtin.
421 #
422 clean:
423 rm -rf $(OBJDIR) $(APPNAME)
424
425 setup: $(OBJDIR) $(APPNAME)
426 $(MAKENSIS) ./fossil.nsi
427
428

Keyboard Shortcuts

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