Fossil

Check-in [92fd8ddc]
Login

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

Overview
Comment:Use Tcl_EvalObjv in any Tcl version, not only when compiled with Tcl 8.6 headers.
Downloads: Tarball | ZIP archive
Timelines: family | ancestors | pending-review
Files: files | file ages | folders
SHA1: 92fd8ddc1308fc04ba83f46be30001b51a3926a2
User & Date: jan.nijtmans 2013-09-17 09:00:50.433
Context
2013-09-17
09:00
Use Tcl_EvalObjv in any Tcl version, not only when compiled with Tcl 8.6 headers. ... (Closed-Leaf check-in: 92fd8ddc user: jan.nijtmans tags: pending-review)
08:43
new clean-zlib, clean-openssl and clean-tcl targets in the mingw makefiles. ... (check-in: 9112867c user: jan.nijtmans tags: pending-review)
Changes
Unified Diff Ignore Whitespace Patch
Changes to src/th_tcl.c.
︙︙
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46

#include "config.h"

#ifdef FOSSIL_ENABLE_TCL

#include "th.h"
#include "tcl.h"

/*
** 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

/*
** These macros are designed to reduce the redundant code required to marshal
** arguments from TH1 to Tcl.
 */
#define USE_ARGV_TO_OBJV() \
  int objc;                \
  Tcl_Obj **objv;          \








<
<
<
<
<
<
<
<
<
<
<
<








21
22
23
24
25
26
27












28
29
30
31
32
33
34

#include "config.h"

#ifdef FOSSIL_ENABLE_TCL

#include "th.h"
#include "tcl.h"













/*
** These macros are designed to reduce the redundant code required to marshal
** arguments from TH1 to Tcl.
 */
#define USE_ARGV_TO_OBJV() \
  int objc;                \
  Tcl_Obj **objv;          \
︙︙
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485

  Th_Interp *interp,
  void *ctx,
  int argc,
  const char **argv,
  int *argl
){
  Tcl_Interp *tclInterp;
#if !defined(USE_TCL_EVALOBJV)
  Tcl_Command command;
  Tcl_CmdInfo cmdInfo;
#endif /* !defined(USE_TCL_EVALOBJV) */
  int rc = TH_OK;
  int nResult;
  const char *zResult;
#if !defined(USE_TCL_EVALOBJV)
  Tcl_Obj *objPtr;
#endif /* !defined(USE_TCL_EVALOBJV) */
  USE_ARGV_TO_OBJV();

  if( createTclInterp(interp, ctx)!=TH_OK ){
    return TH_ERROR;
  }
  if( argc<2 ){
    return Th_WrongNumArgs(interp, "tclInvoke command ?arg ...?");
  }
  tclInterp = GET_CTX_TCL_INTERP(ctx);
  if( !tclInterp || Tcl_InterpDeleted(tclInterp) ){
    Th_ErrorMessage(interp, "invalid Tcl interpreter", (const char *)"", 0);
    return TH_ERROR;
  }
  rc = notifyPreOrPostEval(0, interp, ctx, argc, argv, argl, rc);
  if( rc!=TH_OK ){
    return rc;
  }
  Tcl_Preserve((ClientData)tclInterp);
#if !defined(USE_TCL_EVALOBJV)
  objPtr = Tcl_NewStringObj(argv[1], argl[1]);
  Tcl_IncrRefCount(objPtr);
  command = Tcl_GetCommandFromObj(tclInterp, objPtr);
  if( !command || Tcl_GetCommandInfoFromToken(command, &cmdInfo)==0 ){
    Th_ErrorMessage(interp, "Tcl command not found:", argv[1], argl[1]);
    Tcl_DecrRefCount(objPtr);
    Tcl_Release((ClientData)tclInterp);
    return TH_ERROR;
  }
  if( !cmdInfo.objProc ){
    Th_ErrorMessage(interp, "cannot invoke Tcl command:", argv[1], argl[1]);
    Tcl_DecrRefCount(objPtr);
    Tcl_Release((ClientData)tclInterp);
    return TH_ERROR;
  }
  Tcl_DecrRefCount(objPtr);
#endif /* !defined(USE_TCL_EVALOBJV) */
  COPY_ARGV_TO_OBJV();
#if defined(USE_TCL_EVALOBJV)
  rc = Tcl_EvalObjv(tclInterp, objc, objv, 0);
#else
  Tcl_ResetResult(tclInterp);
  rc = cmdInfo.objProc(cmdInfo.objClientData, tclInterp, objc, objv);
#endif /* defined(USE_TCL_EVALOBJV) */
  FREE_ARGV_TO_OBJV();
  zResult = getTclResult(tclInterp, &nResult);
  Th_SetResult(interp, zResult, nResult);
  Tcl_Release((ClientData)tclInterp);
  rc = notifyPreOrPostEval(1, interp, ctx, argc, argv, argl, rc);
  return rc;
}








<
<
<
<



<
<
<


















<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<

<

<
<
<
<








407
408
409
410
411
412
413




414
415
416



417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434


















435

436




437
438
439
440
441
442
443

  Th_Interp *interp,
  void *ctx,
  int argc,
  const char **argv,
  int *argl
){
  Tcl_Interp *tclInterp;




  int rc = TH_OK;
  int nResult;
  const char *zResult;



  USE_ARGV_TO_OBJV();

  if( createTclInterp(interp, ctx)!=TH_OK ){
    return TH_ERROR;
  }
  if( argc<2 ){
    return Th_WrongNumArgs(interp, "tclInvoke command ?arg ...?");
  }
  tclInterp = GET_CTX_TCL_INTERP(ctx);
  if( !tclInterp || Tcl_InterpDeleted(tclInterp) ){
    Th_ErrorMessage(interp, "invalid Tcl interpreter", (const char *)"", 0);
    return TH_ERROR;
  }
  rc = notifyPreOrPostEval(0, interp, ctx, argc, argv, argl, rc);
  if( rc!=TH_OK ){
    return rc;
  }
  Tcl_Preserve((ClientData)tclInterp);


















  COPY_ARGV_TO_OBJV();

  rc = Tcl_EvalObjv(tclInterp, objc, objv, 0);




  FREE_ARGV_TO_OBJV();
  zResult = getTclResult(tclInterp, &nResult);
  Th_SetResult(interp, zResult, nResult);
  Tcl_Release((ClientData)tclInterp);
  rc = notifyPreOrPostEval(1, interp, ctx, argc, argv, argl, rc);
  return rc;
}
︙︙