Fossil SCM

Formally translate TH1 to Tcl return codes and vice-versa, where necessary, in the Tcl integration subsystem.

mistachkin 2015-04-05 00:24 trunk
Commit 4aba7584f7568b817ce33703808972ef15b10e35
Parent 7cba307895c0575…
1 file changed +61 -16
~ src/th_tcl.c
M src/th_tcl.c
+61 -16
--- src/th_tcl.c
+++ src/th_tcl.c
@@ -250,10 +250,44 @@
250250
 ** interpreter. Stores the created Tcl interpreter in the Tcl context supplied
251251
 ** by the caller. This must be declared here because quite a few functions in
252252
 ** this file need to use it before it can be defined.
253253
 */
254254
 static int createTclInterp(Th_Interp *interp, void *pContext);
255
+
256
+/*
257
+** Returns the TH1 return code corresponding to the specified Tcl
258
+** return code.
259
+*/
260
+static int getTh1ReturnCode(
261
+ int rc /* The Tcl return code value to convert. */
262
+){
263
+ switch( rc ){
264
+ case /*0*/ TCL_OK: return /*0*/ TH_OK;
265
+ case /*1*/ TCL_ERROR: return /*1*/ TH_ERROR;
266
+ case /*2*/ TCL_RETURN: return /*3*/ TH_RETURN;
267
+ case /*3*/ TCL_BREAK: return /*2*/ TH_BREAK;
268
+ case /*4*/ TCL_CONTINUE: return /*4*/ TH_CONTINUE;
269
+ default /*?*/: return /*?*/ rc;
270
+ }
271
+}
272
+
273
+/*
274
+** Returns the Tcl return code corresponding to the specified TH1
275
+** return code.
276
+*/
277
+static int getTclReturnCode(
278
+ int rc /* The TH1 return code value to convert. */
279
+){
280
+ switch( rc ){
281
+ case /*0*/ TH_OK: return /*0*/ TCL_OK;
282
+ case /*1*/ TH_ERROR: return /*1*/ TCL_ERROR;
283
+ case /*2*/ TH_BREAK: return /*3*/ TCL_BREAK;
284
+ case /*3*/ TH_RETURN: return /*2*/ TCL_RETURN;
285
+ case /*4*/ TH_CONTINUE: return /*4*/ TCL_CONTINUE;
286
+ default /*?*/: return /*?*/ rc;
287
+ }
288
+}
255289
256290
 /*
257291
 ** Returns a name for a Tcl return code.
258292
 */
259293
 static const char *getTclReturnCodeName(
@@ -263,12 +297,12 @@
263297
 static char zRc[32];
264298
265299
 switch( rc ){
266300
 case TCL_OK: return nullIfOk ? 0 : "TCL_OK";
267301
 case TCL_ERROR: return "TCL_ERROR";
268
- case TCL_BREAK: return "TCL_BREAK";
269302
 case TCL_RETURN: return "TCL_RETURN";
303
+ case TCL_BREAK: return "TCL_BREAK";
270304
 case TCL_CONTINUE: return "TCL_CONTINUE";
271305
 default: {
272306
 sqlite3_snprintf(sizeof(zRc), zRc, "Tcl return code %d", rc);
273307
 }
274308
 }
@@ -350,13 +384,15 @@
350384
 }
351385
 return rc;
352386
 }
353387
354388
 /*
355
-** Syntax:
389
+** TH1 command: tclEval arg ?arg ...?
356390
 **
357
-** tclEval arg ?arg ...?
391
+** Evaluates the Tcl script and returns its result verbatim. If a Tcl script
392
+** error is generated, it will be transformed into a TH1 script error. A Tcl
393
+** interpreter will be created automatically if it has not been already.
358394
 */
359395
 static int tclEval_command(
360396
 Th_Interp *interp,
361397
 void *ctx,
362398
 int argc,
@@ -400,18 +436,21 @@
400436
 FREE_ARGV_TO_OBJV();
401437
 }
402438
 zResult = getTclResult(tclInterp, &nResult);
403439
 Th_SetResult(interp, zResult, nResult);
404440
 Tcl_Release((ClientData)tclInterp);
405
- rc = notifyPreOrPostEval(1, interp, ctx, argc, argv, argl, rc);
441
+ rc = notifyPreOrPostEval(1, interp, ctx, argc, argv, argl,
442
+ getTh1ReturnCode(rc));
406443
 return rc;
407444
 }
408445
409446
 /*
410
-** Syntax:
447
+** TH1 command: tclExpr arg ?arg ...?
411448
 **
412
-** tclExpr arg ?arg ...?
449
+** Evaluates the Tcl expression and returns its result verbatim. If a Tcl
450
+** script error is generated, it will be transformed into a TH1 script error.
451
+** A Tcl interpreter will be created automatically if it has not been already.
413452
 */
414453
 static int tclExpr_command(
415454
 Th_Interp *interp,
416455
 void *ctx,
417456
 int argc,
@@ -461,18 +500,21 @@
461500
 zResult = getTclResult(tclInterp, &nResult);
462501
 }
463502
 Th_SetResult(interp, zResult, nResult);
464503
 if( rc==TCL_OK ) Tcl_DecrRefCount(resultObjPtr);
465504
 Tcl_Release((ClientData)tclInterp);
466
- rc = notifyPreOrPostEval(1, interp, ctx, argc, argv, argl, rc);
505
+ rc = notifyPreOrPostEval(1, interp, ctx, argc, argv, argl,
506
+ getTh1ReturnCode(rc));
467507
 return rc;
468508
 }
469509
470510
 /*
471
-** Syntax:
511
+** TH1 command: tclInvoke command ?arg ...?
472512
 **
473
-** tclInvoke command ?arg ...?
513
+** Invokes the Tcl command using the supplied arguments. No additional
514
+** substitutions are performed on the arguments. A Tcl interpreter will
515
+** be created automatically if it has not been already.
474516
 */
475517
 static int tclInvoke_command(
476518
 Th_Interp *interp,
477519
 void *ctx,
478520
 int argc,
@@ -533,18 +575,20 @@
533575
 FREE_ARGV_TO_OBJV();
534576
 }
535577
 zResult = getTclResult(tclInterp, &nResult);
536578
 Th_SetResult(interp, zResult, nResult);
537579
 Tcl_Release((ClientData)tclInterp);
538
- rc = notifyPreOrPostEval(1, interp, ctx, argc, argv, argl, rc);
580
+ rc = notifyPreOrPostEval(1, interp, ctx, argc, argv, argl,
581
+ getTh1ReturnCode(rc));
539582
 return rc;
540583
 }
541584
542585
 /*
543
-** Syntax:
586
+** Tcl command: th1Eval arg
544587
 **
545
-** th1Eval arg
588
+** Evaluates the TH1 script and returns its result verbatim. If a TH1 script
589
+** error is generated, it will be transformed into a Tcl script error.
546590
 */
547591
 static int Th1EvalObjCmd(
548592
 ClientData clientData,
549593
 Tcl_Interp *interp,
550594
 int objc,
@@ -566,17 +610,18 @@
566610
 }
567611
 arg = Tcl_GetStringFromObj(objv[1], &nArg);
568612
 rc = Th_Eval(th1Interp, 0, arg, nArg);
569613
 arg = Th_GetResult(th1Interp, &nArg);
570614
 Tcl_SetObjResult(interp, Tcl_NewStringObj(arg, nArg));
571
- return rc;
615
+ return getTclReturnCode(rc);
572616
 }
573617
574618
 /*
575
-** Syntax:
619
+** Tcl command: th1Expr arg
576620
 **
577
-** th1Expr arg
621
+** Evaluates the TH1 expression and returns its result verbatim. If a TH1
622
+** script error is generated, it will be transformed into a Tcl script error.
578623
 */
579624
 static int Th1ExprObjCmd(
580625
 ClientData clientData,
581626
 Tcl_Interp *interp,
582627
 int objc,
@@ -598,11 +643,11 @@
598643
 }
599644
 arg = Tcl_GetStringFromObj(objv[1], &nArg);
600645
 rc = Th_Expr(th1Interp, arg, nArg);
601646
 arg = Th_GetResult(th1Interp, &nArg);
602647
 Tcl_SetObjResult(interp, Tcl_NewStringObj(arg, nArg));
603
- return rc;
648
+ return getTclReturnCode(rc);
604649
 }
605650
606651
 /*
607652
 ** Array of Tcl integration commands. Used when adding or removing the Tcl
608653
 ** integration commands from TH1.
609654
--- src/th_tcl.c
+++ src/th_tcl.c
@@ -250,10 +250,44 @@
250 ** interpreter. Stores the created Tcl interpreter in the Tcl context supplied
251 ** by the caller. This must be declared here because quite a few functions in
252 ** this file need to use it before it can be defined.
253 */
254 static int createTclInterp(Th_Interp *interp, void *pContext);
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
255
256 /*
257 ** Returns a name for a Tcl return code.
258 */
259 static const char *getTclReturnCodeName(
@@ -263,12 +297,12 @@
263 static char zRc[32];
264
265 switch( rc ){
266 case TCL_OK: return nullIfOk ? 0 : "TCL_OK";
267 case TCL_ERROR: return "TCL_ERROR";
268 case TCL_BREAK: return "TCL_BREAK";
269 case TCL_RETURN: return "TCL_RETURN";
 
270 case TCL_CONTINUE: return "TCL_CONTINUE";
271 default: {
272 sqlite3_snprintf(sizeof(zRc), zRc, "Tcl return code %d", rc);
273 }
274 }
@@ -350,13 +384,15 @@
350 }
351 return rc;
352 }
353
354 /*
355 ** Syntax:
356 **
357 ** tclEval arg ?arg ...?
 
 
358 */
359 static int tclEval_command(
360 Th_Interp *interp,
361 void *ctx,
362 int argc,
@@ -400,18 +436,21 @@
400 FREE_ARGV_TO_OBJV();
401 }
402 zResult = getTclResult(tclInterp, &nResult);
403 Th_SetResult(interp, zResult, nResult);
404 Tcl_Release((ClientData)tclInterp);
405 rc = notifyPreOrPostEval(1, interp, ctx, argc, argv, argl, rc);
 
406 return rc;
407 }
408
409 /*
410 ** Syntax:
411 **
412 ** tclExpr arg ?arg ...?
 
 
413 */
414 static int tclExpr_command(
415 Th_Interp *interp,
416 void *ctx,
417 int argc,
@@ -461,18 +500,21 @@
461 zResult = getTclResult(tclInterp, &nResult);
462 }
463 Th_SetResult(interp, zResult, nResult);
464 if( rc==TCL_OK ) Tcl_DecrRefCount(resultObjPtr);
465 Tcl_Release((ClientData)tclInterp);
466 rc = notifyPreOrPostEval(1, interp, ctx, argc, argv, argl, rc);
 
467 return rc;
468 }
469
470 /*
471 ** Syntax:
472 **
473 ** tclInvoke command ?arg ...?
 
 
474 */
475 static int tclInvoke_command(
476 Th_Interp *interp,
477 void *ctx,
478 int argc,
@@ -533,18 +575,20 @@
533 FREE_ARGV_TO_OBJV();
534 }
535 zResult = getTclResult(tclInterp, &nResult);
536 Th_SetResult(interp, zResult, nResult);
537 Tcl_Release((ClientData)tclInterp);
538 rc = notifyPreOrPostEval(1, interp, ctx, argc, argv, argl, rc);
 
539 return rc;
540 }
541
542 /*
543 ** Syntax:
544 **
545 ** th1Eval arg
 
546 */
547 static int Th1EvalObjCmd(
548 ClientData clientData,
549 Tcl_Interp *interp,
550 int objc,
@@ -566,17 +610,18 @@
566 }
567 arg = Tcl_GetStringFromObj(objv[1], &nArg);
568 rc = Th_Eval(th1Interp, 0, arg, nArg);
569 arg = Th_GetResult(th1Interp, &nArg);
570 Tcl_SetObjResult(interp, Tcl_NewStringObj(arg, nArg));
571 return rc;
572 }
573
574 /*
575 ** Syntax:
576 **
577 ** th1Expr arg
 
578 */
579 static int Th1ExprObjCmd(
580 ClientData clientData,
581 Tcl_Interp *interp,
582 int objc,
@@ -598,11 +643,11 @@
598 }
599 arg = Tcl_GetStringFromObj(objv[1], &nArg);
600 rc = Th_Expr(th1Interp, arg, nArg);
601 arg = Th_GetResult(th1Interp, &nArg);
602 Tcl_SetObjResult(interp, Tcl_NewStringObj(arg, nArg));
603 return rc;
604 }
605
606 /*
607 ** Array of Tcl integration commands. Used when adding or removing the Tcl
608 ** integration commands from TH1.
609
--- src/th_tcl.c
+++ src/th_tcl.c
@@ -250,10 +250,44 @@
250 ** interpreter. Stores the created Tcl interpreter in the Tcl context supplied
251 ** by the caller. This must be declared here because quite a few functions in
252 ** this file need to use it before it can be defined.
253 */
254 static int createTclInterp(Th_Interp *interp, void *pContext);
255
256 /*
257 ** Returns the TH1 return code corresponding to the specified Tcl
258 ** return code.
259 */
260 static int getTh1ReturnCode(
261 int rc /* The Tcl return code value to convert. */
262 ){
263 switch( rc ){
264 case /*0*/ TCL_OK: return /*0*/ TH_OK;
265 case /*1*/ TCL_ERROR: return /*1*/ TH_ERROR;
266 case /*2*/ TCL_RETURN: return /*3*/ TH_RETURN;
267 case /*3*/ TCL_BREAK: return /*2*/ TH_BREAK;
268 case /*4*/ TCL_CONTINUE: return /*4*/ TH_CONTINUE;
269 default /*?*/: return /*?*/ rc;
270 }
271 }
272
273 /*
274 ** Returns the Tcl return code corresponding to the specified TH1
275 ** return code.
276 */
277 static int getTclReturnCode(
278 int rc /* The TH1 return code value to convert. */
279 ){
280 switch( rc ){
281 case /*0*/ TH_OK: return /*0*/ TCL_OK;
282 case /*1*/ TH_ERROR: return /*1*/ TCL_ERROR;
283 case /*2*/ TH_BREAK: return /*3*/ TCL_BREAK;
284 case /*3*/ TH_RETURN: return /*2*/ TCL_RETURN;
285 case /*4*/ TH_CONTINUE: return /*4*/ TCL_CONTINUE;
286 default /*?*/: return /*?*/ rc;
287 }
288 }
289
290 /*
291 ** Returns a name for a Tcl return code.
292 */
293 static const char *getTclReturnCodeName(
@@ -263,12 +297,12 @@
297 static char zRc[32];
298
299 switch( rc ){
300 case TCL_OK: return nullIfOk ? 0 : "TCL_OK";
301 case TCL_ERROR: return "TCL_ERROR";
 
302 case TCL_RETURN: return "TCL_RETURN";
303 case TCL_BREAK: return "TCL_BREAK";
304 case TCL_CONTINUE: return "TCL_CONTINUE";
305 default: {
306 sqlite3_snprintf(sizeof(zRc), zRc, "Tcl return code %d", rc);
307 }
308 }
@@ -350,13 +384,15 @@
384 }
385 return rc;
386 }
387
388 /*
389 ** TH1 command: tclEval arg ?arg ...?
390 **
391 ** Evaluates the Tcl script and returns its result verbatim. If a Tcl script
392 ** error is generated, it will be transformed into a TH1 script error. A Tcl
393 ** interpreter will be created automatically if it has not been already.
394 */
395 static int tclEval_command(
396 Th_Interp *interp,
397 void *ctx,
398 int argc,
@@ -400,18 +436,21 @@
436 FREE_ARGV_TO_OBJV();
437 }
438 zResult = getTclResult(tclInterp, &nResult);
439 Th_SetResult(interp, zResult, nResult);
440 Tcl_Release((ClientData)tclInterp);
441 rc = notifyPreOrPostEval(1, interp, ctx, argc, argv, argl,
442 getTh1ReturnCode(rc));
443 return rc;
444 }
445
446 /*
447 ** TH1 command: tclExpr arg ?arg ...?
448 **
449 ** Evaluates the Tcl expression and returns its result verbatim. If a Tcl
450 ** script error is generated, it will be transformed into a TH1 script error.
451 ** A Tcl interpreter will be created automatically if it has not been already.
452 */
453 static int tclExpr_command(
454 Th_Interp *interp,
455 void *ctx,
456 int argc,
@@ -461,18 +500,21 @@
500 zResult = getTclResult(tclInterp, &nResult);
501 }
502 Th_SetResult(interp, zResult, nResult);
503 if( rc==TCL_OK ) Tcl_DecrRefCount(resultObjPtr);
504 Tcl_Release((ClientData)tclInterp);
505 rc = notifyPreOrPostEval(1, interp, ctx, argc, argv, argl,
506 getTh1ReturnCode(rc));
507 return rc;
508 }
509
510 /*
511 ** TH1 command: tclInvoke command ?arg ...?
512 **
513 ** Invokes the Tcl command using the supplied arguments. No additional
514 ** substitutions are performed on the arguments. A Tcl interpreter will
515 ** be created automatically if it has not been already.
516 */
517 static int tclInvoke_command(
518 Th_Interp *interp,
519 void *ctx,
520 int argc,
@@ -533,18 +575,20 @@
575 FREE_ARGV_TO_OBJV();
576 }
577 zResult = getTclResult(tclInterp, &nResult);
578 Th_SetResult(interp, zResult, nResult);
579 Tcl_Release((ClientData)tclInterp);
580 rc = notifyPreOrPostEval(1, interp, ctx, argc, argv, argl,
581 getTh1ReturnCode(rc));
582 return rc;
583 }
584
585 /*
586 ** Tcl command: th1Eval arg
587 **
588 ** Evaluates the TH1 script and returns its result verbatim. If a TH1 script
589 ** error is generated, it will be transformed into a Tcl script error.
590 */
591 static int Th1EvalObjCmd(
592 ClientData clientData,
593 Tcl_Interp *interp,
594 int objc,
@@ -566,17 +610,18 @@
610 }
611 arg = Tcl_GetStringFromObj(objv[1], &nArg);
612 rc = Th_Eval(th1Interp, 0, arg, nArg);
613 arg = Th_GetResult(th1Interp, &nArg);
614 Tcl_SetObjResult(interp, Tcl_NewStringObj(arg, nArg));
615 return getTclReturnCode(rc);
616 }
617
618 /*
619 ** Tcl command: th1Expr arg
620 **
621 ** Evaluates the TH1 expression and returns its result verbatim. If a TH1
622 ** script error is generated, it will be transformed into a Tcl script error.
623 */
624 static int Th1ExprObjCmd(
625 ClientData clientData,
626 Tcl_Interp *interp,
627 int objc,
@@ -598,11 +643,11 @@
643 }
644 arg = Tcl_GetStringFromObj(objv[1], &nArg);
645 rc = Th_Expr(th1Interp, arg, nArg);
646 arg = Th_GetResult(th1Interp, &nArg);
647 Tcl_SetObjResult(interp, Tcl_NewStringObj(arg, nArg));
648 return getTclReturnCode(rc);
649 }
650
651 /*
652 ** Array of Tcl integration commands. Used when adding or removing the Tcl
653 ** integration commands from TH1.
654

Keyboard Shortcuts

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