Fossil SCM

Add support for the tcl_platform(platform) and tcl_platform(engine) array elements to TH1.

mistachkin 2016-01-17 22:17 trunk
Commit 663b722e270738addc55ec37f6d7b9a0fa0faf8a
Parent d8d2222b91854e2…
2 files changed +33 +18 -8
~ src/th.c ~ test/th1.test
M src/th.c
+33
--- src/th.c
+++ src/th.c
@@ -6,10 +6,30 @@
66
77
 #include "config.h"
88
 #include "th.h"
99
 #include <string.h>
1010
 #include <assert.h>
11
+
12
+/*
13
+** Values used for element values in the tcl_platform array.
14
+*/
15
+
16
+#if !defined(TH1_ENGINE)
17
+# define TH1_ENGINE "TH1"
18
+#endif
19
+
20
+#if !defined(TH1_PLATFORM)
21
+# if defined(_WIN32) || defined(WIN32)
22
+# define TH1_PLATFORM "windows"
23
+# else
24
+# define TH1_PLATFORM "unix"
25
+# endif
26
+#endif
27
+
28
+/*
29
+** Forward declarations for structures defined below.
30
+*/
1131
1232
 typedef struct Th_Command Th_Command;
1333
 typedef struct Th_Frame Th_Frame;
1434
 typedef struct Th_Variable Th_Variable;
1535
 typedef struct Th_InterpAndList Th_InterpAndList;
@@ -1756,10 +1776,22 @@
17561776
 *pzStr = zNew;
17571777
 *pnStr = nNew;
17581778
17591779
 return TH_OK;
17601780
 }
1781
+
1782
+/*
1783
+** Initialize an interpreter.
1784
+*/
1785
+static int thInitialize(Th_Interp *interp){
1786
+ assert(interp->pFrame);
1787
+
1788
+ Th_SetVar(interp, (char *)"::tcl_platform(engine)", -1, TH1_ENGINE, -1);
1789
+ Th_SetVar(interp, (char *)"::tcl_platform(platform)", -1, TH1_PLATFORM, -1);
1790
+
1791
+ return TH_OK;
1792
+}
17611793
17621794
 /*
17631795
 ** Delete an interpreter.
17641796
 */
17651797
 void Th_DeleteInterp(Th_Interp *interp){
@@ -1790,10 +1822,11 @@
17901822
 p = pVtab->xMalloc(sizeof(Th_Interp) + sizeof(Th_Frame));
17911823
 memset(p, 0, sizeof(Th_Interp));
17921824
 p->pVtab = pVtab;
17931825
 p->paCmd = Th_HashNew(p);
17941826
 thPushFrame(p, (Th_Frame *)&p[1]);
1827
+ thInitialize(p);
17951828
17961829
 return p;
17971830
 }
17981831
17991832
 /*
18001833
--- src/th.c
+++ src/th.c
@@ -6,10 +6,30 @@
6
7 #include "config.h"
8 #include "th.h"
9 #include <string.h>
10 #include <assert.h>
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
11
12 typedef struct Th_Command Th_Command;
13 typedef struct Th_Frame Th_Frame;
14 typedef struct Th_Variable Th_Variable;
15 typedef struct Th_InterpAndList Th_InterpAndList;
@@ -1756,10 +1776,22 @@
1756 *pzStr = zNew;
1757 *pnStr = nNew;
1758
1759 return TH_OK;
1760 }
 
 
 
 
 
 
 
 
 
 
 
 
1761
1762 /*
1763 ** Delete an interpreter.
1764 */
1765 void Th_DeleteInterp(Th_Interp *interp){
@@ -1790,10 +1822,11 @@
1790 p = pVtab->xMalloc(sizeof(Th_Interp) + sizeof(Th_Frame));
1791 memset(p, 0, sizeof(Th_Interp));
1792 p->pVtab = pVtab;
1793 p->paCmd = Th_HashNew(p);
1794 thPushFrame(p, (Th_Frame *)&p[1]);
 
1795
1796 return p;
1797 }
1798
1799 /*
1800
--- src/th.c
+++ src/th.c
@@ -6,10 +6,30 @@
6
7 #include "config.h"
8 #include "th.h"
9 #include <string.h>
10 #include <assert.h>
11
12 /*
13 ** Values used for element values in the tcl_platform array.
14 */
15
16 #if !defined(TH1_ENGINE)
17 # define TH1_ENGINE "TH1"
18 #endif
19
20 #if !defined(TH1_PLATFORM)
21 # if defined(_WIN32) || defined(WIN32)
22 # define TH1_PLATFORM "windows"
23 # else
24 # define TH1_PLATFORM "unix"
25 # endif
26 #endif
27
28 /*
29 ** Forward declarations for structures defined below.
30 */
31
32 typedef struct Th_Command Th_Command;
33 typedef struct Th_Frame Th_Frame;
34 typedef struct Th_Variable Th_Variable;
35 typedef struct Th_InterpAndList Th_InterpAndList;
@@ -1756,10 +1776,22 @@
1776 *pzStr = zNew;
1777 *pnStr = nNew;
1778
1779 return TH_OK;
1780 }
1781
1782 /*
1783 ** Initialize an interpreter.
1784 */
1785 static int thInitialize(Th_Interp *interp){
1786 assert(interp->pFrame);
1787
1788 Th_SetVar(interp, (char *)"::tcl_platform(engine)", -1, TH1_ENGINE, -1);
1789 Th_SetVar(interp, (char *)"::tcl_platform(platform)", -1, TH1_PLATFORM, -1);
1790
1791 return TH_OK;
1792 }
1793
1794 /*
1795 ** Delete an interpreter.
1796 */
1797 void Th_DeleteInterp(Th_Interp *interp){
@@ -1790,10 +1822,11 @@
1822 p = pVtab->xMalloc(sizeof(Th_Interp) + sizeof(Th_Frame));
1823 memset(p, 0, sizeof(Th_Interp));
1824 p->pVtab = pVtab;
1825 p->paCmd = Th_HashNew(p);
1826 thPushFrame(p, (Th_Frame *)&p[1]);
1827 thInitialize(p);
1828
1829 return p;
1830 }
1831
1832 /*
1833
M test/th1.test
+18 -8
--- test/th1.test
+++ test/th1.test
@@ -944,35 +944,35 @@
944944
945945
 fossil test-th-eval "info vars"
946946
947947
 if {$th1Hooks} {
948948
 test th1-info-vars-1 {$RESULT eq \
949
- "th_stack_trace cmd_flags cmd_name cmd_args"}
949
+ "th_stack_trace cmd_flags tcl_platform cmd_name cmd_args"}
950950
 } else {
951
- test th1-info-vars-1 {$RESULT eq ""}
951
+ test th1-info-vars-1 {$RESULT eq "tcl_platform"}
952952
 }
953953
954954
 ###############################################################################
955955
956956
 fossil test-th-eval "set x 1; info vars"
957957
958958
 if {$th1Hooks} {
959959
 test th1-info-vars-2 {$RESULT eq \
960
- "x th_stack_trace cmd_flags cmd_name cmd_args"}
960
+ "x th_stack_trace cmd_flags tcl_platform cmd_name cmd_args"}
961961
 } else {
962
- test th1-info-vars-2 {$RESULT eq "x"}
962
+ test th1-info-vars-2 {$RESULT eq "x tcl_platform"}
963963
 }
964964
965965
 ###############################################################################
966966
967967
 fossil test-th-eval "set x 1; unset x; info vars"
968968
969969
 if {$th1Hooks} {
970970
 test th1-info-vars-3 {$RESULT eq \
971
- "th_stack_trace cmd_flags cmd_name cmd_args"}
971
+ "th_stack_trace cmd_flags tcl_platform cmd_name cmd_args"}
972972
 } else {
973
- test th1-info-vars-3 {$RESULT eq ""}
973
+ test th1-info-vars-3 {$RESULT eq "tcl_platform"}
974974
 }
975975
976976
 ###############################################################################
977977
978978
 fossil test-th-eval "proc foo {} {set x 1; info vars}; foo"
@@ -982,13 +982,13 @@
982982
983983
 fossil test-th-eval "set y 1; proc foo {} {set x 1; uplevel 1 {info vars}}; foo"
984984
985985
 if {$th1Hooks} {
986986
 test th1-info-vars-5 {$RESULT eq \
987
- "th_stack_trace y cmd_flags cmd_name cmd_args"}
987
+ "th_stack_trace y cmd_flags tcl_platform cmd_name cmd_args"}
988988
 } else {
989
- test th1-info-vars-5 {$RESULT eq "y"}
989
+ test th1-info-vars-5 {$RESULT eq "y tcl_platform"}
990990
 }
991991
992992
 ###############################################################################
993993
994994
 fossil test-th-eval "lsearch"
@@ -1361,5 +1361,15 @@
13611361
 {encode64 [artifact trunk ajax/cgi-bin/fossil-json.cgi.example]}
13621362
 }
13631363
13641364
 test th1-encode64-3 {$RESULT eq \
13651365
 "IyEvcGF0aC90by9mb3NzaWwvYmluYXJ5CnJlcG9zaXRvcnk6IC9wYXRoL3RvL3JlcG8uZnNsCg=="}
1366
+
1367
+###############################################################################
1368
+
1369
+fossil test-th-eval {set tcl_platform(engine)}
1370
+test th1-platform-1 {$RESULT eq "TH1"}
1371
+
1372
+###############################################################################
1373
+
1374
+fossil test-th-eval {set tcl_platform(platform)}
1375
+test th1-platform-2 {$RESULT eq "windows" || $RESULT eq "unix"}
13661376
--- test/th1.test
+++ test/th1.test
@@ -944,35 +944,35 @@
944
945 fossil test-th-eval "info vars"
946
947 if {$th1Hooks} {
948 test th1-info-vars-1 {$RESULT eq \
949 "th_stack_trace cmd_flags cmd_name cmd_args"}
950 } else {
951 test th1-info-vars-1 {$RESULT eq ""}
952 }
953
954 ###############################################################################
955
956 fossil test-th-eval "set x 1; info vars"
957
958 if {$th1Hooks} {
959 test th1-info-vars-2 {$RESULT eq \
960 "x th_stack_trace cmd_flags cmd_name cmd_args"}
961 } else {
962 test th1-info-vars-2 {$RESULT eq "x"}
963 }
964
965 ###############################################################################
966
967 fossil test-th-eval "set x 1; unset x; info vars"
968
969 if {$th1Hooks} {
970 test th1-info-vars-3 {$RESULT eq \
971 "th_stack_trace cmd_flags cmd_name cmd_args"}
972 } else {
973 test th1-info-vars-3 {$RESULT eq ""}
974 }
975
976 ###############################################################################
977
978 fossil test-th-eval "proc foo {} {set x 1; info vars}; foo"
@@ -982,13 +982,13 @@
982
983 fossil test-th-eval "set y 1; proc foo {} {set x 1; uplevel 1 {info vars}}; foo"
984
985 if {$th1Hooks} {
986 test th1-info-vars-5 {$RESULT eq \
987 "th_stack_trace y cmd_flags cmd_name cmd_args"}
988 } else {
989 test th1-info-vars-5 {$RESULT eq "y"}
990 }
991
992 ###############################################################################
993
994 fossil test-th-eval "lsearch"
@@ -1361,5 +1361,15 @@
1361 {encode64 [artifact trunk ajax/cgi-bin/fossil-json.cgi.example]}
1362 }
1363
1364 test th1-encode64-3 {$RESULT eq \
1365 "IyEvcGF0aC90by9mb3NzaWwvYmluYXJ5CnJlcG9zaXRvcnk6IC9wYXRoL3RvL3JlcG8uZnNsCg=="}
 
 
 
 
 
 
 
 
 
 
1366
--- test/th1.test
+++ test/th1.test
@@ -944,35 +944,35 @@
944
945 fossil test-th-eval "info vars"
946
947 if {$th1Hooks} {
948 test th1-info-vars-1 {$RESULT eq \
949 "th_stack_trace cmd_flags tcl_platform cmd_name cmd_args"}
950 } else {
951 test th1-info-vars-1 {$RESULT eq "tcl_platform"}
952 }
953
954 ###############################################################################
955
956 fossil test-th-eval "set x 1; info vars"
957
958 if {$th1Hooks} {
959 test th1-info-vars-2 {$RESULT eq \
960 "x th_stack_trace cmd_flags tcl_platform cmd_name cmd_args"}
961 } else {
962 test th1-info-vars-2 {$RESULT eq "x tcl_platform"}
963 }
964
965 ###############################################################################
966
967 fossil test-th-eval "set x 1; unset x; info vars"
968
969 if {$th1Hooks} {
970 test th1-info-vars-3 {$RESULT eq \
971 "th_stack_trace cmd_flags tcl_platform cmd_name cmd_args"}
972 } else {
973 test th1-info-vars-3 {$RESULT eq "tcl_platform"}
974 }
975
976 ###############################################################################
977
978 fossil test-th-eval "proc foo {} {set x 1; info vars}; foo"
@@ -982,13 +982,13 @@
982
983 fossil test-th-eval "set y 1; proc foo {} {set x 1; uplevel 1 {info vars}}; foo"
984
985 if {$th1Hooks} {
986 test th1-info-vars-5 {$RESULT eq \
987 "th_stack_trace y cmd_flags tcl_platform cmd_name cmd_args"}
988 } else {
989 test th1-info-vars-5 {$RESULT eq "y tcl_platform"}
990 }
991
992 ###############################################################################
993
994 fossil test-th-eval "lsearch"
@@ -1361,5 +1361,15 @@
1361 {encode64 [artifact trunk ajax/cgi-bin/fossil-json.cgi.example]}
1362 }
1363
1364 test th1-encode64-3 {$RESULT eq \
1365 "IyEvcGF0aC90by9mb3NzaWwvYmluYXJ5CnJlcG9zaXRvcnk6IC9wYXRoL3RvL3JlcG8uZnNsCg=="}
1366
1367 ###############################################################################
1368
1369 fossil test-th-eval {set tcl_platform(engine)}
1370 test th1-platform-1 {$RESULT eq "TH1"}
1371
1372 ###############################################################################
1373
1374 fossil test-th-eval {set tcl_platform(platform)}
1375 test th1-platform-2 {$RESULT eq "windows" || $RESULT eq "unix"}
1376

Keyboard Shortcuts

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