Check-in [d7f83e7462]
Not logged in

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Minor cleanup of Tcl integration code. Also, add more comments describing USE_TCL_EVALOBJV.
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: d7f83e7462c75e04fdb7cf05e72a5820641f6ad5
User & Date: mistachkin 2013-09-17 10:06:43.526
Context
2013-09-17
11:33
Don't set USE_TCL_EVALOBJV=1 for Tcl 8.6b3 and higher by default. check-in: 8c8c6bce21 user: jan.nijtmans tags: trunk
10:06
Minor cleanup of Tcl integration code. Also, add more comments describing USE_TCL_EVALOBJV. check-in: d7f83e7462 user: mistachkin tags: trunk
09:31
Support overriding the USE_TCL_EVALOBJV define via a custom Makefile. check-in: 5782fa032e user: mistachkin tags: trunk
Changes
Unified Diff Ignore Whitespace Patch
Changes to src/th_tcl.c.
27
28
29
30
31
32
33
34













35
36
37
38
39
40
41
42






43
44
45
46
47
48
49

/*
** Has the decision about whether or not to use Tcl_EvalObjv already been made
** via the Makefile?
 */
#if !defined(USE_TCL_EVALOBJV)
/*
** Are we being compiled against Tcl 8.6 or higher?













 */
#if (TCL_MAJOR_VERSION > 8) || \
    ((TCL_MAJOR_VERSION == 8) && (TCL_MINOR_VERSION >= 6))
/*
** Workaround NRE-specific issue in Tcl_EvalObjCmd (SF bug #3399564) by using
** Tcl_EvalObjv instead of invoking the objProc directly.
 */
#  define USE_TCL_EVALOBJV   1






#endif /* (TCL_MAJOR_VERSION > 8) ... */
#endif /* !defined(USE_TCL_EVALOBJV) */

/*
** These macros are designed to reduce the redundant code required to marshal
** arguments from TH1 to Tcl.
 */







|
>
>
>
>
>
>
>
>
>
>
>
>
>







|
>
>
>
>
>
>







27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68

/*
** Has the decision about whether or not to use Tcl_EvalObjv already been made
** via the Makefile?
 */
#if !defined(USE_TCL_EVALOBJV)
/*
** Are we being compiled against Tcl 8.6 or higher?  This check is [mostly]
** wrong for at least the following two reasons:
**
** 1. This check assumes that all versions of Tcl 8.6 and higher suffer from
**    the issue described in SF bug #3399564, which is incorrect.
**
** 2. Technically, this check is completely useless when the stubs mechanism
**    is in use.  In that case, a runtime version check would be required and
**    that has not been implemented.
**
** However, if a particular user compiles and runs against Tcl 8.6 (or later),
** this will cause a fallback to using the "conservative" method of directly
** invoking a Tcl command.  In that case, potential crashes will be avoided if
** the user just so happened to compile or run against a late beta of Tcl 8.6.
 */
#if (TCL_MAJOR_VERSION > 8) || \
    ((TCL_MAJOR_VERSION == 8) && (TCL_MINOR_VERSION >= 6))
/*
** Workaround NRE-specific issue in Tcl_EvalObjCmd (SF bug #3399564) by using
** Tcl_EvalObjv instead of invoking the objProc directly.
 */
#  define USE_TCL_EVALOBJV    (1)
#else
/*
** We should be able to safely use Tcl_GetCommandInfoFromToken, when the need
** arises, to invoke a specific Tcl command "directly" with some arguments.
 */
#  define USE_TCL_EVALOBJV    (0)
#endif /* (TCL_MAJOR_VERSION > 8) ... */
#endif /* !defined(USE_TCL_EVALOBJV) */

/*
** These macros are designed to reduce the redundant code required to marshal
** arguments from TH1 to Tcl.
 */
767
768
769
770
771
772
773

774
775
776
777
778
779
780

781
782
783
784
785
786
787
788

789
790
791
792
793
794
795
        "could not create Tcl interpreter", (const char *)"", 0);
    return TH_ERROR;
  }
#if defined(USE_TCL_STUBS)
#if defined(FOSSIL_ENABLE_TCL_PRIVATE_STUBS)
  if( initTclStubs(interp, tclInterp)!=TH_OK ){
    tclContext->xDeleteInterp(tclInterp);

    return TH_ERROR;
  }
#else
  if( !Tcl_InitStubs(tclInterp, "8.4", 0) ){
    Th_ErrorMessage(interp,
        "could not initialize Tcl stubs", (const char *)"", 0);
    tclContext->xDeleteInterp(tclInterp);

    return TH_ERROR;
  }
#endif /* defined(FOSSIL_ENABLE_TCL_PRIVATE_STUBS) */
#endif /* defined(USE_TCL_STUBS) */
  if( Tcl_InterpDeleted(tclInterp) ){
    Th_ErrorMessage(interp,
        "Tcl interpreter appears to be deleted", (const char *)"", 0);
    tclContext->xDeleteInterp(tclInterp); /* TODO: Redundant? */

    return TH_ERROR;
  }
  tclContext->interp = tclInterp;
  if( Tcl_Init(tclInterp)!=TCL_OK ){
    Th_ErrorMessage(interp,
        "Tcl initialization error:", Tcl_GetStringResult(tclInterp), -1);
    Tcl_DeleteInterp(tclInterp);







>







>







|
>







786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
        "could not create Tcl interpreter", (const char *)"", 0);
    return TH_ERROR;
  }
#if defined(USE_TCL_STUBS)
#if defined(FOSSIL_ENABLE_TCL_PRIVATE_STUBS)
  if( initTclStubs(interp, tclInterp)!=TH_OK ){
    tclContext->xDeleteInterp(tclInterp);
    tclInterp = 0;
    return TH_ERROR;
  }
#else
  if( !Tcl_InitStubs(tclInterp, "8.4", 0) ){
    Th_ErrorMessage(interp,
        "could not initialize Tcl stubs", (const char *)"", 0);
    tclContext->xDeleteInterp(tclInterp);
    tclInterp = 0;
    return TH_ERROR;
  }
#endif /* defined(FOSSIL_ENABLE_TCL_PRIVATE_STUBS) */
#endif /* defined(USE_TCL_STUBS) */
  if( Tcl_InterpDeleted(tclInterp) ){
    Th_ErrorMessage(interp,
        "Tcl interpreter appears to be deleted", (const char *)"", 0);
    Tcl_DeleteInterp(tclInterp); /* TODO: Redundant? */
    tclInterp = 0;
    return TH_ERROR;
  }
  tclContext->interp = tclInterp;
  if( Tcl_Init(tclInterp)!=TCL_OK ){
    Th_ErrorMessage(interp,
        "Tcl initialization error:", Tcl_GetStringResult(tclInterp), -1);
    Tcl_DeleteInterp(tclInterp);