Fossil SCM

Loading Tcl 8.4 only works when USE_TCL_EVALOBJV=1. Reason: the function Tcl_GetCommandFromObj is introduced in Tcl 8.5 (TIP #139)

jan.nijtmans 2013-09-23 12:09 UTC trunk
Commit 2234fabe76cb4a976bf8dc9ada65329918494bbf
Parent da96f916cb02bdb…
2 files changed +1 -1 +19 -14
~ src/main.c ~ src/th_tcl.c
M src/main.c
+1 -1
--- src/main.c
+++ src/main.c
@@ -823,11 +823,11 @@
823823
 #if defined(FOSSIL_ENABLE_SSL)
824824
 fossil_print("SSL (%s)\n", OPENSSL_VERSION_TEXT);
825825
 #endif
826826
 #if defined(FOSSIL_ENABLE_TCL)
827827
 Th_FossilInit(TH_INIT_DEFAULT | TH_INIT_FORCE_TCL);
828
- rc = Th_Eval(g.interp, 0, "tclEval {info patchlevel}", -1);
828
+ rc = Th_Eval(g.interp, 0, "tclInvoke info patchlevel", -1);
829829
 zRc = Th_ReturnCodeName(rc, 0);
830830
 fossil_print("TCL (Tcl %s, loaded %s: %s)\n",
831831
 TCL_PATCH_LEVEL, zRc, Th_GetResult(g.interp, 0)
832832
 );
833833
 #endif
834834
--- src/main.c
+++ src/main.c
@@ -823,11 +823,11 @@
823 #if defined(FOSSIL_ENABLE_SSL)
824 fossil_print("SSL (%s)\n", OPENSSL_VERSION_TEXT);
825 #endif
826 #if defined(FOSSIL_ENABLE_TCL)
827 Th_FossilInit(TH_INIT_DEFAULT | TH_INIT_FORCE_TCL);
828 rc = Th_Eval(g.interp, 0, "tclEval {info patchlevel}", -1);
829 zRc = Th_ReturnCodeName(rc, 0);
830 fossil_print("TCL (Tcl %s, loaded %s: %s)\n",
831 TCL_PATCH_LEVEL, zRc, Th_GetResult(g.interp, 0)
832 );
833 #endif
834
--- src/main.c
+++ src/main.c
@@ -823,11 +823,11 @@
823 #if defined(FOSSIL_ENABLE_SSL)
824 fossil_print("SSL (%s)\n", OPENSSL_VERSION_TEXT);
825 #endif
826 #if defined(FOSSIL_ENABLE_TCL)
827 Th_FossilInit(TH_INIT_DEFAULT | TH_INIT_FORCE_TCL);
828 rc = Th_Eval(g.interp, 0, "tclInvoke info patchlevel", -1);
829 zRc = Th_ReturnCodeName(rc, 0);
830 fossil_print("TCL (Tcl %s, loaded %s: %s)\n",
831 TCL_PATCH_LEVEL, zRc, Th_GetResult(g.interp, 0)
832 );
833 #endif
834
M src/th_tcl.c
+19 -14
--- src/th_tcl.c
+++ src/th_tcl.c
@@ -29,27 +29,28 @@
2929
 ** Has the decision about whether or not to use Tcl_EvalObjv already been made
3030
 ** via the Makefile?
3131
 */
3232
 #if !defined(USE_TCL_EVALOBJV)
3333
 /*
34
-** Are we being compiled against Tcl 8.6b1 or b2? This check is [mostly]
34
+** Are we being compiled against Tcl 8.4, 8.6b1 or b2? This check is [mostly]
3535
 ** wrong for at the following reason:
3636
 **
3737
 ** 1. Technically, this check is completely useless when the stubs mechanism
3838
 ** is in use. In that case, a runtime version check would be required and
3939
 ** that has not been implemented.
4040
 **
41
-** However, if a particular user compiles and runs against Tcl 8.6b1 or b2,
41
+** However, if a particular user compiles and runs against Tcl 8.4, 8.6b1 or b2,
4242
 ** this will cause a fallback to using the "conservative" method of directly
4343
 ** invoking a Tcl command. In that case, potential crashes will be avoided if
44
-** the user just so happened to compile or run against Tcl 8.6b1 or b2.
44
+** the user just so happened to compile or run against Tcl 8.4, 8.6b1 or b2.
4545
 */
46
-#if (TCL_MAJOR_VERSION == 8) && (TCL_MINOR_VERSION == 6) && \
46
+#if (TCL_MAJOR_VERSION == 8) && (TCL_MINOR_VERSION < 5) || (TCL_MINOR_VERSION == 6) && \
4747
 (TCL_RELEASE_LEVEL == TCL_BETA_RELEASE) && (TCL_RELEASE_SERIAL < 3)
4848
 /*
4949
 ** Workaround NRE-specific issue in Tcl_EvalObjCmd (SF bug #3399564) by using
50
-** Tcl_EvalObjv instead of invoking the objProc directly.
50
+** Tcl_EvalObjv instead of invoking the objProc directly. In addition, Tcl 8.4
51
+** doesn't have the function Tcl_GetCommandFromObj (see TIP #139)
5152
 */
5253
 # define USE_TCL_EVALOBJV (1)
5354
 #else
5455
 /*
5556
 ** We should be able to safely use Tcl_GetCommandInfoFromToken, when the need
@@ -443,20 +444,20 @@
443444
 int argc,
444445
 const char **argv,
445446
 int *argl
446447
 ){
447448
 Tcl_Interp *tclInterp;
448
-#if !defined(USE_TCL_EVALOBJV) || !USE_TCL_EVALOBJV
449
+#if !USE_TCL_EVALOBJV
449450
 Tcl_Command command;
450451
 Tcl_CmdInfo cmdInfo;
451
-#endif /* !defined(USE_TCL_EVALOBJV) || !USE_TCL_EVALOBJV */
452
+#endif /* !USE_TCL_EVALOBJV */
452453
 int rc = TH_OK;
453454
 int nResult;
454455
 const char *zResult;
455
-#if !defined(USE_TCL_EVALOBJV) || !USE_TCL_EVALOBJV
456
+#if !USE_TCL_EVALOBJV
456457
 Tcl_Obj *objPtr;
457
-#endif /* !defined(USE_TCL_EVALOBJV) || !USE_TCL_EVALOBJV */
458
+#endif /* !USE_TCL_EVALOBJV */
458459
 USE_ARGV_TO_OBJV();
459460
460461
 if( createTclInterp(interp, ctx)!=TH_OK ){
461462
 return TH_ERROR;
462463
 }
@@ -471,11 +472,11 @@
471472
 rc = notifyPreOrPostEval(0, interp, ctx, argc, argv, argl, rc);
472473
 if( rc!=TH_OK ){
473474
 return rc;
474475
 }
475476
 Tcl_Preserve((ClientData)tclInterp);
476
-#if !defined(USE_TCL_EVALOBJV) || !USE_TCL_EVALOBJV
477
+#if !USE_TCL_EVALOBJV
477478
 objPtr = Tcl_NewStringObj(argv[1], argl[1]);
478479
 Tcl_IncrRefCount(objPtr);
479480
 command = Tcl_GetCommandFromObj(tclInterp, objPtr);
480481
 if( !command || Tcl_GetCommandInfoFromToken(command, &cmdInfo)==0 ){
481482
 Th_ErrorMessage(interp, "Tcl command not found:", argv[1], argl[1]);
@@ -488,18 +489,18 @@
488489
 Tcl_DecrRefCount(objPtr);
489490
 Tcl_Release((ClientData)tclInterp);
490491
 return TH_ERROR;
491492
 }
492493
 Tcl_DecrRefCount(objPtr);
493
-#endif /* !defined(USE_TCL_EVALOBJV) || !USE_TCL_EVALOBJV */
494
+#endif /* !USE_TCL_EVALOBJV */
494495
 COPY_ARGV_TO_OBJV();
495
-#if defined(USE_TCL_EVALOBJV) && USE_TCL_EVALOBJV
496
+#if USE_TCL_EVALOBJV
496497
 rc = Tcl_EvalObjv(tclInterp, objc, objv, 0);
497498
 #else
498499
 Tcl_ResetResult(tclInterp);
499500
 rc = cmdInfo.objProc(cmdInfo.objClientData, tclInterp, objc, objv);
500
-#endif /* defined(USE_TCL_EVALOBJV) && USE_TCL_EVALOBJV */
501
+#endif /* USE_TCL_EVALOBJV */
501502
 FREE_ARGV_TO_OBJV();
502503
 zResult = getTclResult(tclInterp, &nResult);
503504
 Th_SetResult(interp, zResult, nResult);
504505
 Tcl_Release((ClientData)tclInterp);
505506
 rc = notifyPreOrPostEval(1, interp, ctx, argc, argv, argl, rc);
@@ -670,14 +671,18 @@
670671
 *pxFindExecutable = xFindExecutable;
671672
 *pxCreateInterp = xCreateInterp;
672673
 *pxDeleteInterp = xDeleteInterp;
673674
 return TH_OK;
674675
 }
675
- } while( --fileName[TCL_MINOR_OFFSET]>'3' ); /* Tcl 8.4+ */
676
+ } while( --fileName[TCL_MINOR_OFFSET]>(USE_TCL_EVALOBJV?'4':'3') ); /* Tcl 8.5+ or 4*/
676677
 fileName[TCL_MINOR_OFFSET] = 'x';
677678
 Th_ErrorMessage(interp,
679
+#if USE_TCL_EVALOBJV
678680
 "could not load any supported Tcl 8.6, 8.5, or 8.4 shared library \"",
681
+#else
682
+ "could not load any supported Tcl 8.6 or 8.5 shared library \"",
683
+#endif
679684
 fileName, -1);
680685
 return TH_ERROR;
681686
 #else
682687
 *pLibrary = 0;
683688
 *pxFindExecutable = Tcl_FindExecutable;
684689
--- src/th_tcl.c
+++ src/th_tcl.c
@@ -29,27 +29,28 @@
29 ** Has the decision about whether or not to use Tcl_EvalObjv already been made
30 ** via the Makefile?
31 */
32 #if !defined(USE_TCL_EVALOBJV)
33 /*
34 ** Are we being compiled against Tcl 8.6b1 or b2? This check is [mostly]
35 ** wrong for at the following reason:
36 **
37 ** 1. Technically, this check is completely useless when the stubs mechanism
38 ** is in use. In that case, a runtime version check would be required and
39 ** that has not been implemented.
40 **
41 ** However, if a particular user compiles and runs against Tcl 8.6b1 or b2,
42 ** this will cause a fallback to using the "conservative" method of directly
43 ** invoking a Tcl command. In that case, potential crashes will be avoided if
44 ** the user just so happened to compile or run against Tcl 8.6b1 or b2.
45 */
46 #if (TCL_MAJOR_VERSION == 8) && (TCL_MINOR_VERSION == 6) && \
47 (TCL_RELEASE_LEVEL == TCL_BETA_RELEASE) && (TCL_RELEASE_SERIAL < 3)
48 /*
49 ** Workaround NRE-specific issue in Tcl_EvalObjCmd (SF bug #3399564) by using
50 ** Tcl_EvalObjv instead of invoking the objProc directly.
 
51 */
52 # define USE_TCL_EVALOBJV (1)
53 #else
54 /*
55 ** We should be able to safely use Tcl_GetCommandInfoFromToken, when the need
@@ -443,20 +444,20 @@
443 int argc,
444 const char **argv,
445 int *argl
446 ){
447 Tcl_Interp *tclInterp;
448 #if !defined(USE_TCL_EVALOBJV) || !USE_TCL_EVALOBJV
449 Tcl_Command command;
450 Tcl_CmdInfo cmdInfo;
451 #endif /* !defined(USE_TCL_EVALOBJV) || !USE_TCL_EVALOBJV */
452 int rc = TH_OK;
453 int nResult;
454 const char *zResult;
455 #if !defined(USE_TCL_EVALOBJV) || !USE_TCL_EVALOBJV
456 Tcl_Obj *objPtr;
457 #endif /* !defined(USE_TCL_EVALOBJV) || !USE_TCL_EVALOBJV */
458 USE_ARGV_TO_OBJV();
459
460 if( createTclInterp(interp, ctx)!=TH_OK ){
461 return TH_ERROR;
462 }
@@ -471,11 +472,11 @@
471 rc = notifyPreOrPostEval(0, interp, ctx, argc, argv, argl, rc);
472 if( rc!=TH_OK ){
473 return rc;
474 }
475 Tcl_Preserve((ClientData)tclInterp);
476 #if !defined(USE_TCL_EVALOBJV) || !USE_TCL_EVALOBJV
477 objPtr = Tcl_NewStringObj(argv[1], argl[1]);
478 Tcl_IncrRefCount(objPtr);
479 command = Tcl_GetCommandFromObj(tclInterp, objPtr);
480 if( !command || Tcl_GetCommandInfoFromToken(command, &cmdInfo)==0 ){
481 Th_ErrorMessage(interp, "Tcl command not found:", argv[1], argl[1]);
@@ -488,18 +489,18 @@
488 Tcl_DecrRefCount(objPtr);
489 Tcl_Release((ClientData)tclInterp);
490 return TH_ERROR;
491 }
492 Tcl_DecrRefCount(objPtr);
493 #endif /* !defined(USE_TCL_EVALOBJV) || !USE_TCL_EVALOBJV */
494 COPY_ARGV_TO_OBJV();
495 #if defined(USE_TCL_EVALOBJV) && USE_TCL_EVALOBJV
496 rc = Tcl_EvalObjv(tclInterp, objc, objv, 0);
497 #else
498 Tcl_ResetResult(tclInterp);
499 rc = cmdInfo.objProc(cmdInfo.objClientData, tclInterp, objc, objv);
500 #endif /* defined(USE_TCL_EVALOBJV) && USE_TCL_EVALOBJV */
501 FREE_ARGV_TO_OBJV();
502 zResult = getTclResult(tclInterp, &nResult);
503 Th_SetResult(interp, zResult, nResult);
504 Tcl_Release((ClientData)tclInterp);
505 rc = notifyPreOrPostEval(1, interp, ctx, argc, argv, argl, rc);
@@ -670,14 +671,18 @@
670 *pxFindExecutable = xFindExecutable;
671 *pxCreateInterp = xCreateInterp;
672 *pxDeleteInterp = xDeleteInterp;
673 return TH_OK;
674 }
675 } while( --fileName[TCL_MINOR_OFFSET]>'3' ); /* Tcl 8.4+ */
676 fileName[TCL_MINOR_OFFSET] = 'x';
677 Th_ErrorMessage(interp,
 
678 "could not load any supported Tcl 8.6, 8.5, or 8.4 shared library \"",
 
 
 
679 fileName, -1);
680 return TH_ERROR;
681 #else
682 *pLibrary = 0;
683 *pxFindExecutable = Tcl_FindExecutable;
684
--- src/th_tcl.c
+++ src/th_tcl.c
@@ -29,27 +29,28 @@
29 ** Has the decision about whether or not to use Tcl_EvalObjv already been made
30 ** via the Makefile?
31 */
32 #if !defined(USE_TCL_EVALOBJV)
33 /*
34 ** Are we being compiled against Tcl 8.4, 8.6b1 or b2? This check is [mostly]
35 ** wrong for at the following reason:
36 **
37 ** 1. Technically, this check is completely useless when the stubs mechanism
38 ** is in use. In that case, a runtime version check would be required and
39 ** that has not been implemented.
40 **
41 ** However, if a particular user compiles and runs against Tcl 8.4, 8.6b1 or b2,
42 ** this will cause a fallback to using the "conservative" method of directly
43 ** invoking a Tcl command. In that case, potential crashes will be avoided if
44 ** the user just so happened to compile or run against Tcl 8.4, 8.6b1 or b2.
45 */
46 #if (TCL_MAJOR_VERSION == 8) && (TCL_MINOR_VERSION < 5) || (TCL_MINOR_VERSION == 6) && \
47 (TCL_RELEASE_LEVEL == TCL_BETA_RELEASE) && (TCL_RELEASE_SERIAL < 3)
48 /*
49 ** Workaround NRE-specific issue in Tcl_EvalObjCmd (SF bug #3399564) by using
50 ** Tcl_EvalObjv instead of invoking the objProc directly. In addition, Tcl 8.4
51 ** doesn't have the function Tcl_GetCommandFromObj (see TIP #139)
52 */
53 # define USE_TCL_EVALOBJV (1)
54 #else
55 /*
56 ** We should be able to safely use Tcl_GetCommandInfoFromToken, when the need
@@ -443,20 +444,20 @@
444 int argc,
445 const char **argv,
446 int *argl
447 ){
448 Tcl_Interp *tclInterp;
449 #if !USE_TCL_EVALOBJV
450 Tcl_Command command;
451 Tcl_CmdInfo cmdInfo;
452 #endif /* !USE_TCL_EVALOBJV */
453 int rc = TH_OK;
454 int nResult;
455 const char *zResult;
456 #if !USE_TCL_EVALOBJV
457 Tcl_Obj *objPtr;
458 #endif /* !USE_TCL_EVALOBJV */
459 USE_ARGV_TO_OBJV();
460
461 if( createTclInterp(interp, ctx)!=TH_OK ){
462 return TH_ERROR;
463 }
@@ -471,11 +472,11 @@
472 rc = notifyPreOrPostEval(0, interp, ctx, argc, argv, argl, rc);
473 if( rc!=TH_OK ){
474 return rc;
475 }
476 Tcl_Preserve((ClientData)tclInterp);
477 #if !USE_TCL_EVALOBJV
478 objPtr = Tcl_NewStringObj(argv[1], argl[1]);
479 Tcl_IncrRefCount(objPtr);
480 command = Tcl_GetCommandFromObj(tclInterp, objPtr);
481 if( !command || Tcl_GetCommandInfoFromToken(command, &cmdInfo)==0 ){
482 Th_ErrorMessage(interp, "Tcl command not found:", argv[1], argl[1]);
@@ -488,18 +489,18 @@
489 Tcl_DecrRefCount(objPtr);
490 Tcl_Release((ClientData)tclInterp);
491 return TH_ERROR;
492 }
493 Tcl_DecrRefCount(objPtr);
494 #endif /* !USE_TCL_EVALOBJV */
495 COPY_ARGV_TO_OBJV();
496 #if USE_TCL_EVALOBJV
497 rc = Tcl_EvalObjv(tclInterp, objc, objv, 0);
498 #else
499 Tcl_ResetResult(tclInterp);
500 rc = cmdInfo.objProc(cmdInfo.objClientData, tclInterp, objc, objv);
501 #endif /* USE_TCL_EVALOBJV */
502 FREE_ARGV_TO_OBJV();
503 zResult = getTclResult(tclInterp, &nResult);
504 Th_SetResult(interp, zResult, nResult);
505 Tcl_Release((ClientData)tclInterp);
506 rc = notifyPreOrPostEval(1, interp, ctx, argc, argv, argl, rc);
@@ -670,14 +671,18 @@
671 *pxFindExecutable = xFindExecutable;
672 *pxCreateInterp = xCreateInterp;
673 *pxDeleteInterp = xDeleteInterp;
674 return TH_OK;
675 }
676 } while( --fileName[TCL_MINOR_OFFSET]>(USE_TCL_EVALOBJV?'4':'3') ); /* Tcl 8.5+ or 4*/
677 fileName[TCL_MINOR_OFFSET] = 'x';
678 Th_ErrorMessage(interp,
679 #if USE_TCL_EVALOBJV
680 "could not load any supported Tcl 8.6, 8.5, or 8.4 shared library \"",
681 #else
682 "could not load any supported Tcl 8.6 or 8.5 shared library \"",
683 #endif
684 fileName, -1);
685 return TH_ERROR;
686 #else
687 *pLibrary = 0;
688 *pxFindExecutable = Tcl_FindExecutable;
689

Keyboard Shortcuts

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