Check-in [e10d117125]
Not logged in

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

Overview
Comment:Support the ability to determine at runtime if the private stubs mechanism was used for Tcl.
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: e10d1171252498a3cb68ccf92fb993cdfecdf236
User & Date: mistachkin 2013-09-16 23:38:39.162
Context
2013-09-17
09:16
New clean-zlib, clean-openssl, and clean-tcl targets in the MinGW makefiles. Cherrypick of [9112867c2d]. check-in: 249f6075d9 user: mistachkin tags: trunk
08:43
new clean-zlib, clean-openssl and clean-tcl targets in the mingw makefiles. check-in: 9112867c2d user: jan.nijtmans tags: pending-review
2013-09-16
23:38
Support the ability to determine at runtime if the private stubs mechanism was used for Tcl. check-in: e10d117125 user: mistachkin tags: trunk
23:17
Fix missing argument check for pxDeleteInterp in the Tcl integration module. check-in: ee9d2bfb31 user: mistachkin tags: trunk
Changes
Unified Diff Ignore Whitespace Patch
Changes to src/main.c.
819
820
821
822
823
824
825



826
827
828
829
830
831
832
    zRc = Th_ReturnCodeName(rc, 0);
    fossil_print("TCL (Tcl %s, loaded %s: %s)\n",
      TCL_PATCH_LEVEL, zRc, Th_GetResult(g.interp, 0)
    );
#endif
#if defined(FOSSIL_ENABLE_TCL_STUBS)
    fossil_print("TCL_STUBS\n");



#endif
#if defined(FOSSIL_ENABLE_JSON)
    fossil_print("JSON (API %s)\n", FOSSIL_JSON_API_VERSION);
#endif
  }
}








>
>
>







819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
    zRc = Th_ReturnCodeName(rc, 0);
    fossil_print("TCL (Tcl %s, loaded %s: %s)\n",
      TCL_PATCH_LEVEL, zRc, Th_GetResult(g.interp, 0)
    );
#endif
#if defined(FOSSIL_ENABLE_TCL_STUBS)
    fossil_print("TCL_STUBS\n");
#endif
#if defined(FOSSIL_ENABLE_TCL_PRIVATE_STUBS)
    fossil_print("TCL_PRIVATE_STUBS\n");
#endif
#if defined(FOSSIL_ENABLE_JSON)
    fossil_print("JSON (API %s)\n", FOSSIL_JSON_API_VERSION);
#endif
  }
}

Changes to src/th_main.c.
294
295
296
297
298
299
300
301
302
303

304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335





336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351

/*
** TH command:     hasfeature STRING
**
** Return true if the fossil binary has the given compile-time feature
** enabled. The set of features includes:
**
** "ssl"      = FOSSIL_ENABLE_SSL
** "tcl"      = FOSSIL_ENABLE_TCL
** "tclStubs" = FOSSIL_ENABLE_TCL_STUBS

** "json"     = FOSSIL_ENABLE_JSON
** "markdown" = FOSSIL_ENABLE_MARKDOWN
**
*/
static int hasfeatureCmd(
  Th_Interp *interp, 
  void *p, 
  int argc, 
  const char **argv, 
  int *argl
){
  int rc = 0;
  char const * zArg;
  if( argc!=2 ){
    return Th_WrongNumArgs(interp, "hasfeature STRING");
  }
  zArg = (char const*)argv[1];
  if(NULL==zArg){
    /* placeholder for following ifdefs... */
  }
#if defined(FOSSIL_ENABLE_SSL)
  else if( 0 == fossil_strnicmp( zArg, "ssl", 3 ) ){
    rc = 1;
  }
#endif
#if defined(FOSSIL_ENABLE_TCL)
  else if( 0 == fossil_strnicmp( zArg, "tcl", 3 ) ){
    rc = 1;
  }
#endif
#if defined(FOSSIL_ENABLE_TCL_STUBS)
  else if( 0 == fossil_strnicmp( zArg, "tclStubs", 8 ) ){





    rc = 1;
  }
#endif
#if defined(FOSSIL_ENABLE_JSON)
  else if( 0 == fossil_strnicmp( zArg, "json", 4 ) ){
    rc = 1;
  }
#endif
  else if( 0 == fossil_strnicmp( zArg, "markdown", 8 ) ){
    rc = 1;
  }
  if( g.thTrace ){
    Th_Trace("[hasfeature %#h] => %d<br />\n", argl[1], zArg, rc);
  }
  Th_SetResultInt(interp, rc);
  return TH_OK;







|
|
|
>
|
|



















|




|




|
>
>
>
>
>




|



|







294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357

/*
** TH command:     hasfeature STRING
**
** Return true if the fossil binary has the given compile-time feature
** enabled. The set of features includes:
**
** "ssl"             = FOSSIL_ENABLE_SSL
** "tcl"             = FOSSIL_ENABLE_TCL
** "tclStubs"        = FOSSIL_ENABLE_TCL_STUBS
** "tclPrivateStubs" = FOSSIL_ENABLE_TCL_PRIVATE_STUBS
** "json"            = FOSSIL_ENABLE_JSON
** "markdown"        = FOSSIL_ENABLE_MARKDOWN
**
*/
static int hasfeatureCmd(
  Th_Interp *interp, 
  void *p, 
  int argc, 
  const char **argv, 
  int *argl
){
  int rc = 0;
  char const * zArg;
  if( argc!=2 ){
    return Th_WrongNumArgs(interp, "hasfeature STRING");
  }
  zArg = (char const*)argv[1];
  if(NULL==zArg){
    /* placeholder for following ifdefs... */
  }
#if defined(FOSSIL_ENABLE_SSL)
  else if( 0 == fossil_strnicmp( zArg, "ssl\0", 4 ) ){
    rc = 1;
  }
#endif
#if defined(FOSSIL_ENABLE_TCL)
  else if( 0 == fossil_strnicmp( zArg, "tcl\0", 4 ) ){
    rc = 1;
  }
#endif
#if defined(FOSSIL_ENABLE_TCL_STUBS)
  else if( 0 == fossil_strnicmp( zArg, "tclStubs\0", 9 ) ){
    rc = 1;
  }
#endif
#if defined(FOSSIL_ENABLE_TCL_PRIVATE_STUBS)
  else if( 0 == fossil_strnicmp( zArg, "tclPrivateStubs\0", 16 ) ){
    rc = 1;
  }
#endif
#if defined(FOSSIL_ENABLE_JSON)
  else if( 0 == fossil_strnicmp( zArg, "json\0", 5 ) ){
    rc = 1;
  }
#endif
  else if( 0 == fossil_strnicmp( zArg, "markdown\0", 9 ) ){
    rc = 1;
  }
  if( g.thTrace ){
    Th_Trace("[hasfeature %#h] => %d<br />\n", argl[1], zArg, rc);
  }
  Th_SetResultInt(interp, rc);
  return TH_OK;
Changes to src/th_tcl.c.
226
227
228
229
230
231
232

233
234
235
236
237
238
239
** If the length pointer is NULL, the length will not be stored.
 */
static char *getTclResult(
  Tcl_Interp *pInterp,
  int *pN
){
  Tcl_Obj *resultPtr;

  if( !pInterp ){ /* This should not happen. */
    if( pN ) *pN = 0;
    return 0;
  }
  resultPtr = Tcl_GetObjResult(pInterp);
  if( !resultPtr ){ /* This should not happen either? */
    if( pN ) *pN = 0;







>







226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
** If the length pointer is NULL, the length will not be stored.
 */
static char *getTclResult(
  Tcl_Interp *pInterp,
  int *pN
){
  Tcl_Obj *resultPtr;

  if( !pInterp ){ /* This should not happen. */
    if( pN ) *pN = 0;
    return 0;
  }
  resultPtr = Tcl_GetObjResult(pInterp);
  if( !resultPtr ){ /* This should not happen either? */
    if( pN ) *pN = 0;
568
569
570
571
572
573
574

575
576
577
578
579
580
581
 */
static void Th1DeleteProc(
  ClientData clientData,
  Tcl_Interp *interp
){
  int i;
  Th_Interp *th1Interp = (Th_Interp *)clientData;

  if( !th1Interp ) return;
  /* Remove the Tcl integration commands. */
  for(i=0; i<(sizeof(aCommand)/sizeof(aCommand[0])); i++){
    Th_RenameCommand(th1Interp, aCommand[i].zName, -1, NULL, 0);
  }
}








>







569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
 */
static void Th1DeleteProc(
  ClientData clientData,
  Tcl_Interp *interp
){
  int i;
  Th_Interp *th1Interp = (Th_Interp *)clientData;

  if( !th1Interp ) return;
  /* Remove the Tcl integration commands. */
  for(i=0; i<(sizeof(aCommand)/sizeof(aCommand[0])); i++){
    Th_RenameCommand(th1Interp, aCommand[i].zName, -1, NULL, 0);
  }
}

592
593
594
595
596
597
598

599
600
601
602
603
604
605
  tcl_FindExecutableProc **pxFindExecutable,
  tcl_CreateInterpProc **pxCreateInterp,
  tcl_DeleteInterpProc **pxDeleteInterp
){
#if defined(USE_TCL_STUBS)
  char fileName[] = TCL_LIBRARY_NAME;
#endif /* defined(USE_TCL_STUBS) */

  if( !pLibrary || !pxFindExecutable || !pxCreateInterp || !pxDeleteInterp ){
    Th_ErrorMessage(interp,
        "invalid Tcl loader argument(s)", (const char *)"", 0);
    return TH_ERROR;
  }
#if defined(USE_TCL_STUBS)
  do {







>







594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
  tcl_FindExecutableProc **pxFindExecutable,
  tcl_CreateInterpProc **pxCreateInterp,
  tcl_DeleteInterpProc **pxDeleteInterp
){
#if defined(USE_TCL_STUBS)
  char fileName[] = TCL_LIBRARY_NAME;
#endif /* defined(USE_TCL_STUBS) */

  if( !pLibrary || !pxFindExecutable || !pxCreateInterp || !pxDeleteInterp ){
    Th_ErrorMessage(interp,
        "invalid Tcl loader argument(s)", (const char *)"", 0);
    return TH_ERROR;
  }
#if defined(USE_TCL_STUBS)
  do {
670
671
672
673
674
675
676

677
678
679
680
681
682
683
  int argc,
  char **argv
){
  Tcl_Obj *objPtr;
  Tcl_Obj *resultObjPtr;
  Tcl_Obj *listPtr;
  int rc = TCL_OK;

  if( argc<=0 || !argv ){
    return TCL_OK;
  }
  objPtr = Tcl_NewStringObj(argv[0], -1);
  Tcl_IncrRefCount(objPtr);
  resultObjPtr = Tcl_SetVar2Ex(pInterp, "argv0", NULL, objPtr,
      TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG);







>







673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
  int argc,
  char **argv
){
  Tcl_Obj *objPtr;
  Tcl_Obj *resultObjPtr;
  Tcl_Obj *listPtr;
  int rc = TCL_OK;

  if( argc<=0 || !argv ){
    return TCL_OK;
  }
  objPtr = Tcl_NewStringObj(argv[0], -1);
  Tcl_IncrRefCount(objPtr);
  resultObjPtr = Tcl_SetVar2Ex(pInterp, "argv0", NULL, objPtr,
      TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG);
814
815
816
817
818
819
820

821
822
823
824
825
826
827
828
829
830
831
832
833
** Usually this is called soon after interpreter creation.
*/
int th_register_tcl(
  Th_Interp *interp,
  void *pContext
){
  int i;

  /* Add the Tcl integration commands to TH1. */
  for(i=0; i<(sizeof(aCommand)/sizeof(aCommand[0])); i++){
    void *ctx;
    if ( !aCommand[i].zName || !aCommand[i].xProc ) continue;
    ctx = aCommand[i].pContext;
    /* Use Tcl interpreter for context? */
    if( !ctx ) ctx = pContext;
    Th_CreateCommand(interp, aCommand[i].zName, aCommand[i].xProc, ctx, 0);
  }
  return TH_OK;
}

#endif /* FOSSIL_ENABLE_TCL */







>













818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
** Usually this is called soon after interpreter creation.
*/
int th_register_tcl(
  Th_Interp *interp,
  void *pContext
){
  int i;

  /* Add the Tcl integration commands to TH1. */
  for(i=0; i<(sizeof(aCommand)/sizeof(aCommand[0])); i++){
    void *ctx;
    if ( !aCommand[i].zName || !aCommand[i].xProc ) continue;
    ctx = aCommand[i].pContext;
    /* Use Tcl interpreter for context? */
    if( !ctx ) ctx = pContext;
    Th_CreateCommand(interp, aCommand[i].zName, aCommand[i].xProc, ctx, 0);
  }
  return TH_OK;
}

#endif /* FOSSIL_ENABLE_TCL */
Changes to win/fossil.rc.
106
107
108
109
110
111
112





113
114
115
116
117
118
119
#if defined(FOSSIL_ENABLE_TCL)
      VALUE "TclEnabled", "Yes, Tcl " TCL_PATCH_LEVEL "\0"
#if defined(FOSSIL_ENABLE_TCL_STUBS)
      VALUE "TclStubsEnabled", "Yes\0"
#else
      VALUE "TclStubsEnabled", "No\0"
#endif /* defined(FOSSIL_ENABLE_TCL_STUBS) */





#endif /* defined(FOSSIL_ENABLE_TCL) */
#if defined(FOSSIL_ENABLE_JSON)
      VALUE "JsonEnabled", "Yes, cson " FOSSIL_JSON_API_VERSION "\0"
#endif /* defined(FOSSIL_ENABLE_JSON) */
      VALUE "MarkdownEnabled", "Yes\0"
    END
  END







>
>
>
>
>







106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
#if defined(FOSSIL_ENABLE_TCL)
      VALUE "TclEnabled", "Yes, Tcl " TCL_PATCH_LEVEL "\0"
#if defined(FOSSIL_ENABLE_TCL_STUBS)
      VALUE "TclStubsEnabled", "Yes\0"
#else
      VALUE "TclStubsEnabled", "No\0"
#endif /* defined(FOSSIL_ENABLE_TCL_STUBS) */
#if defined(FOSSIL_ENABLE_TCL_PRIVATE_STUBS)
      VALUE "TclPrivateStubsEnabled", "Yes\0"
#else
      VALUE "TclPrivateStubsEnabled", "No\0"
#endif /* defined(FOSSIL_ENABLE_TCL_PRIVATE_STUBS) */
#endif /* defined(FOSSIL_ENABLE_TCL) */
#if defined(FOSSIL_ENABLE_JSON)
      VALUE "JsonEnabled", "Yes, cson " FOSSIL_JSON_API_VERSION "\0"
#endif /* defined(FOSSIL_ENABLE_JSON) */
      VALUE "MarkdownEnabled", "Yes\0"
    END
  END