Fossil SCM

Add the 'array exists' and 'array names' sub-commands to TH1. Add tcl_platform(engine) and tcl_platform(platform) to TH1.

mistachkin 2016-01-18 17:41 trunk merge
Commit ea7813da5680dafa7a3c60ddd936fde582125312
Parent 786017890d282e4…
6 files changed +70 +2 +64 +85 -10 +6 +4
~ src/th.c ~ src/th.h ~ src/th_lang.c ~ test/th1.test ~ www/changes.wiki ~ www/th1.md
M src/th.c
+70
--- 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(TH_ENGINE)
17
+# define TH_ENGINE "TH1"
18
+#endif
19
+
20
+#if !defined(TH_PLATFORM)
21
+# if defined(_WIN32) || defined(WIN32)
22
+# define TH_PLATFORM "windows"
23
+# else
24
+# define TH_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;
@@ -1231,10 +1251,18 @@
12311251
 */
12321252
 int Th_ExistsVar(Th_Interp *interp, const char *zVar, int nVar){
12331253
 Th_Variable *pValue = thFindValue(interp, zVar, nVar, 0, 1, 1, 0);
12341254
 return pValue && (pValue->zData || pValue->pHash);
12351255
 }
1256
+
1257
+/*
1258
+** Return true if array variable (zVar, nVar) exists.
1259
+*/
1260
+int Th_ExistsArrayVar(Th_Interp *interp, const char *zVar, int nVar){
1261
+ Th_Variable *pValue = thFindValue(interp, zVar, nVar, 0, 1, 1, 0);
1262
+ return pValue && !pValue->zData && pValue->pHash;
1263
+}
12361264
12371265
 /*
12381266
 ** String (zVar, nVar) must contain the name of a scalar variable or
12391267
 ** array member. If the variable does not exist it is created. The
12401268
 ** variable is set to the value supplied in string (zValue, nValue).
@@ -1756,10 +1784,22 @@
17561784
 *pzStr = zNew;
17571785
 *pnStr = nNew;
17581786
17591787
 return TH_OK;
17601788
 }
1789
+
1790
+/*
1791
+** Initialize an interpreter.
1792
+*/
1793
+static int thInitialize(Th_Interp *interp){
1794
+ assert(interp->pFrame);
1795
+
1796
+ Th_SetVar(interp, (char *)"::tcl_platform(engine)", -1, TH_ENGINE, -1);
1797
+ Th_SetVar(interp, (char *)"::tcl_platform(platform)", -1, TH_PLATFORM, -1);
1798
+
1799
+ return TH_OK;
1800
+}
17611801
17621802
 /*
17631803
 ** Delete an interpreter.
17641804
 */
17651805
 void Th_DeleteInterp(Th_Interp *interp){
@@ -1790,10 +1830,11 @@
17901830
 p = pVtab->xMalloc(sizeof(Th_Interp) + sizeof(Th_Frame));
17911831
 memset(p, 0, sizeof(Th_Interp));
17921832
 p->pVtab = pVtab;
17931833
 p->paCmd = Th_HashNew(p);
17941834
 thPushFrame(p, (Th_Frame *)&p[1]);
1835
+ thInitialize(p);
17951836
17961837
 return p;
17971838
 }
17981839
17991840
 /*
@@ -2898,5 +2939,34 @@
28982939
 return TH_OK;
28992940
 }else{
29002941
 return TH_ERROR;
29012942
 }
29022943
 }
2944
+
2945
+/*
2946
+** Appends all array element names for the specified array variable to the
2947
+** specified list and returns TH_OK upon success. Any other return value
2948
+** indicates an error.
2949
+*/
2950
+int Th_ListAppendArray(
2951
+ Th_Interp *interp,
2952
+ const char *zVar, /* Pointer to variable name */
2953
+ int nVar, /* Number of bytes at nVar */
2954
+ char **pzList, /* OUT: List of array element names */
2955
+ int *pnList /* OUT: Number of array element names */
2956
+){
2957
+ Th_Variable *pValue = thFindValue(interp, zVar, nVar, 0, 1, 1, 0);
2958
+ if( pValue && !pValue->zData && pValue->pHash ){
2959
+ Th_InterpAndList *p = (Th_InterpAndList *)Th_Malloc(
2960
+ interp, sizeof(Th_InterpAndList)
2961
+ );
2962
+ p->interp = interp;
2963
+ p->pzList = pzList;
2964
+ p->pnList = pnList;
2965
+ Th_HashIterate(interp, pValue->pHash, thListAppendHashKey, p);
2966
+ Th_Free(interp, p);
2967
+ }else{
2968
+ *pzList = 0;
2969
+ *pnList = 0;
2970
+ }
2971
+ return TH_OK;
2972
+}
29032973
--- 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;
@@ -1231,10 +1251,18 @@
1231 */
1232 int Th_ExistsVar(Th_Interp *interp, const char *zVar, int nVar){
1233 Th_Variable *pValue = thFindValue(interp, zVar, nVar, 0, 1, 1, 0);
1234 return pValue && (pValue->zData || pValue->pHash);
1235 }
 
 
 
 
 
 
 
 
1236
1237 /*
1238 ** String (zVar, nVar) must contain the name of a scalar variable or
1239 ** array member. If the variable does not exist it is created. The
1240 ** variable is set to the value supplied in string (zValue, nValue).
@@ -1756,10 +1784,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 +1830,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 /*
@@ -2898,5 +2939,34 @@
2898 return TH_OK;
2899 }else{
2900 return TH_ERROR;
2901 }
2902 }
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
2903
--- 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(TH_ENGINE)
17 # define TH_ENGINE "TH1"
18 #endif
19
20 #if !defined(TH_PLATFORM)
21 # if defined(_WIN32) || defined(WIN32)
22 # define TH_PLATFORM "windows"
23 # else
24 # define TH_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;
@@ -1231,10 +1251,18 @@
1251 */
1252 int Th_ExistsVar(Th_Interp *interp, const char *zVar, int nVar){
1253 Th_Variable *pValue = thFindValue(interp, zVar, nVar, 0, 1, 1, 0);
1254 return pValue && (pValue->zData || pValue->pHash);
1255 }
1256
1257 /*
1258 ** Return true if array variable (zVar, nVar) exists.
1259 */
1260 int Th_ExistsArrayVar(Th_Interp *interp, const char *zVar, int nVar){
1261 Th_Variable *pValue = thFindValue(interp, zVar, nVar, 0, 1, 1, 0);
1262 return pValue && !pValue->zData && pValue->pHash;
1263 }
1264
1265 /*
1266 ** String (zVar, nVar) must contain the name of a scalar variable or
1267 ** array member. If the variable does not exist it is created. The
1268 ** variable is set to the value supplied in string (zValue, nValue).
@@ -1756,10 +1784,22 @@
1784 *pzStr = zNew;
1785 *pnStr = nNew;
1786
1787 return TH_OK;
1788 }
1789
1790 /*
1791 ** Initialize an interpreter.
1792 */
1793 static int thInitialize(Th_Interp *interp){
1794 assert(interp->pFrame);
1795
1796 Th_SetVar(interp, (char *)"::tcl_platform(engine)", -1, TH_ENGINE, -1);
1797 Th_SetVar(interp, (char *)"::tcl_platform(platform)", -1, TH_PLATFORM, -1);
1798
1799 return TH_OK;
1800 }
1801
1802 /*
1803 ** Delete an interpreter.
1804 */
1805 void Th_DeleteInterp(Th_Interp *interp){
@@ -1790,10 +1830,11 @@
1830 p = pVtab->xMalloc(sizeof(Th_Interp) + sizeof(Th_Frame));
1831 memset(p, 0, sizeof(Th_Interp));
1832 p->pVtab = pVtab;
1833 p->paCmd = Th_HashNew(p);
1834 thPushFrame(p, (Th_Frame *)&p[1]);
1835 thInitialize(p);
1836
1837 return p;
1838 }
1839
1840 /*
@@ -2898,5 +2939,34 @@
2939 return TH_OK;
2940 }else{
2941 return TH_ERROR;
2942 }
2943 }
2944
2945 /*
2946 ** Appends all array element names for the specified array variable to the
2947 ** specified list and returns TH_OK upon success. Any other return value
2948 ** indicates an error.
2949 */
2950 int Th_ListAppendArray(
2951 Th_Interp *interp,
2952 const char *zVar, /* Pointer to variable name */
2953 int nVar, /* Number of bytes at nVar */
2954 char **pzList, /* OUT: List of array element names */
2955 int *pnList /* OUT: Number of array element names */
2956 ){
2957 Th_Variable *pValue = thFindValue(interp, zVar, nVar, 0, 1, 1, 0);
2958 if( pValue && !pValue->zData && pValue->pHash ){
2959 Th_InterpAndList *p = (Th_InterpAndList *)Th_Malloc(
2960 interp, sizeof(Th_InterpAndList)
2961 );
2962 p->interp = interp;
2963 p->pzList = pzList;
2964 p->pnList = pnList;
2965 Th_HashIterate(interp, pValue->pHash, thListAppendHashKey, p);
2966 Th_Free(interp, p);
2967 }else{
2968 *pzList = 0;
2969 *pnList = 0;
2970 }
2971 return TH_OK;
2972 }
2973
M src/th.h
+2
--- src/th.h
+++ src/th.h
@@ -50,10 +50,11 @@
5050
 /*
5151
 ** Access TH variables in the current stack frame. If the variable name
5252
 ** begins with "::", the lookup is in the top level (global) frame.
5353
 */
5454
 int Th_ExistsVar(Th_Interp *, const char *, int);
55
+int Th_ExistsArrayVar(Th_Interp *, const char *, int);
5556
 int Th_GetVar(Th_Interp *, const char *, int);
5657
 int Th_SetVar(Th_Interp *, const char *, int, const char *, int);
5758
 int Th_LinkVar(Th_Interp *, const char *, int, int, const char *, int);
5859
 int Th_UnsetVar(Th_Interp *, const char *, int);
5960
@@ -143,10 +144,11 @@
143144
 /*
144145
 ** Functions for handling command and variable introspection.
145146
 */
146147
 int Th_ListAppendCommands(Th_Interp *, char **, int *);
147148
 int Th_ListAppendVariables(Th_Interp *, char **, int *);
149
+int Th_ListAppendArray(Th_Interp *, const char *, int, char **, int *);
148150
149151
 /*
150152
 ** Drop in replacements for the corresponding standard library functions.
151153
 */
152154
 int th_strlen(const char *);
153155
--- src/th.h
+++ src/th.h
@@ -50,10 +50,11 @@
50 /*
51 ** Access TH variables in the current stack frame. If the variable name
52 ** begins with "::", the lookup is in the top level (global) frame.
53 */
54 int Th_ExistsVar(Th_Interp *, const char *, int);
 
55 int Th_GetVar(Th_Interp *, const char *, int);
56 int Th_SetVar(Th_Interp *, const char *, int, const char *, int);
57 int Th_LinkVar(Th_Interp *, const char *, int, int, const char *, int);
58 int Th_UnsetVar(Th_Interp *, const char *, int);
59
@@ -143,10 +144,11 @@
143 /*
144 ** Functions for handling command and variable introspection.
145 */
146 int Th_ListAppendCommands(Th_Interp *, char **, int *);
147 int Th_ListAppendVariables(Th_Interp *, char **, int *);
 
148
149 /*
150 ** Drop in replacements for the corresponding standard library functions.
151 */
152 int th_strlen(const char *);
153
--- src/th.h
+++ src/th.h
@@ -50,10 +50,11 @@
50 /*
51 ** Access TH variables in the current stack frame. If the variable name
52 ** begins with "::", the lookup is in the top level (global) frame.
53 */
54 int Th_ExistsVar(Th_Interp *, const char *, int);
55 int Th_ExistsArrayVar(Th_Interp *, const char *, int);
56 int Th_GetVar(Th_Interp *, const char *, int);
57 int Th_SetVar(Th_Interp *, const char *, int, const char *, int);
58 int Th_LinkVar(Th_Interp *, const char *, int, int, const char *, int);
59 int Th_UnsetVar(Th_Interp *, const char *, int);
60
@@ -143,10 +144,11 @@
144 /*
145 ** Functions for handling command and variable introspection.
146 */
147 int Th_ListAppendCommands(Th_Interp *, char **, int *);
148 int Th_ListAppendVariables(Th_Interp *, char **, int *);
149 int Th_ListAppendArray(Th_Interp *, const char *, int, char **, int *);
150
151 /*
152 ** Drop in replacements for the corresponding standard library functions.
153 */
154 int th_strlen(const char *);
155
M src/th_lang.c
+64
--- src/th_lang.c
+++ src/th_lang.c
@@ -971,10 +971,52 @@
971971
 return TH_OK;
972972
 }
973973
974974
 /*
975975
 ** TH Syntax:
976
+**
977
+** array exists VARNAME
978
+*/
979
+static int array_exists_command(
980
+ Th_Interp *interp, void *ctx, int argc, const char **argv, int *argl
981
+){
982
+ int rc;
983
+
984
+ if( argc!=3 ){
985
+ return Th_WrongNumArgs(interp, "array exists var");
986
+ }
987
+ rc = Th_ExistsArrayVar(interp, argv[2], argl[2]);
988
+ Th_SetResultInt(interp, rc);
989
+ return TH_OK;
990
+}
991
+
992
+/*
993
+** TH Syntax:
994
+**
995
+** array names
996
+*/
997
+static int array_names_command(
998
+ Th_Interp *interp, void *ctx, int argc, const char **argv, int *argl
999
+){
1000
+ int rc;
1001
+ char *zElem = 0;
1002
+ int nElem = 0;
1003
+
1004
+ if( argc!=3 ){
1005
+ return Th_WrongNumArgs(interp, "array names varname");
1006
+ }
1007
+ rc = Th_ListAppendArray(interp, argv[2], argl[2], &zElem, &nElem);
1008
+ if( rc!=TH_OK ){
1009
+ return rc;
1010
+ }
1011
+ Th_SetResult(interp, zElem, nElem);
1012
+ if( zElem ) Th_Free(interp, zElem);
1013
+ return TH_OK;
1014
+}
1015
+
1016
+/*
1017
+** TH Syntax:
9761018
 **
9771019
 ** unset VAR
9781020
 */
9791021
 static int unset_command(
9801022
 Th_Interp *interp,
@@ -1065,10 +1107,31 @@
10651107
 static const Th_SubCommand aSub[] = {
10661108
 { "commands", info_commands_command },
10671109
 { "exists", info_exists_command },
10681110
 { "vars", info_vars_command },
10691111
 { 0, 0 }
1112
+ };
1113
+ return Th_CallSubCommand(interp, ctx, argc, argv, argl, aSub);
1114
+}
1115
+
1116
+/*
1117
+** TH Syntax:
1118
+**
1119
+** array exists VARNAME
1120
+** array names VARNAME
1121
+*/
1122
+static int array_command(
1123
+ Th_Interp *interp,
1124
+ void *ctx,
1125
+ int argc,
1126
+ const char **argv,
1127
+ int *argl
1128
+){
1129
+ static const Th_SubCommand aSub[] = {
1130
+ { "exists", array_exists_command },
1131
+ { "names", array_names_command },
1132
+ { 0, 0 }
10701133
 };
10711134
 return Th_CallSubCommand(interp, ctx, argc, argv, argl, aSub);
10721135
 }
10731136
10741137
 /*
@@ -1182,10 +1245,11 @@
11821245
 struct _Command {
11831246
 const char *zName;
11841247
 Th_CommandProc xProc;
11851248
 void *pContext;
11861249
 } aCommand[] = {
1250
+ {"array", array_command, 0},
11871251
 {"catch", catch_command, 0},
11881252
 {"expr", expr_command, 0},
11891253
 {"for", for_command, 0},
11901254
 {"if", if_command, 0},
11911255
 {"info", info_command, 0},
11921256
--- src/th_lang.c
+++ src/th_lang.c
@@ -971,10 +971,52 @@
971 return TH_OK;
972 }
973
974 /*
975 ** TH Syntax:
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
976 **
977 ** unset VAR
978 */
979 static int unset_command(
980 Th_Interp *interp,
@@ -1065,10 +1107,31 @@
1065 static const Th_SubCommand aSub[] = {
1066 { "commands", info_commands_command },
1067 { "exists", info_exists_command },
1068 { "vars", info_vars_command },
1069 { 0, 0 }
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
1070 };
1071 return Th_CallSubCommand(interp, ctx, argc, argv, argl, aSub);
1072 }
1073
1074 /*
@@ -1182,10 +1245,11 @@
1182 struct _Command {
1183 const char *zName;
1184 Th_CommandProc xProc;
1185 void *pContext;
1186 } aCommand[] = {
 
1187 {"catch", catch_command, 0},
1188 {"expr", expr_command, 0},
1189 {"for", for_command, 0},
1190 {"if", if_command, 0},
1191 {"info", info_command, 0},
1192
--- src/th_lang.c
+++ src/th_lang.c
@@ -971,10 +971,52 @@
971 return TH_OK;
972 }
973
974 /*
975 ** TH Syntax:
976 **
977 ** array exists VARNAME
978 */
979 static int array_exists_command(
980 Th_Interp *interp, void *ctx, int argc, const char **argv, int *argl
981 ){
982 int rc;
983
984 if( argc!=3 ){
985 return Th_WrongNumArgs(interp, "array exists var");
986 }
987 rc = Th_ExistsArrayVar(interp, argv[2], argl[2]);
988 Th_SetResultInt(interp, rc);
989 return TH_OK;
990 }
991
992 /*
993 ** TH Syntax:
994 **
995 ** array names
996 */
997 static int array_names_command(
998 Th_Interp *interp, void *ctx, int argc, const char **argv, int *argl
999 ){
1000 int rc;
1001 char *zElem = 0;
1002 int nElem = 0;
1003
1004 if( argc!=3 ){
1005 return Th_WrongNumArgs(interp, "array names varname");
1006 }
1007 rc = Th_ListAppendArray(interp, argv[2], argl[2], &zElem, &nElem);
1008 if( rc!=TH_OK ){
1009 return rc;
1010 }
1011 Th_SetResult(interp, zElem, nElem);
1012 if( zElem ) Th_Free(interp, zElem);
1013 return TH_OK;
1014 }
1015
1016 /*
1017 ** TH Syntax:
1018 **
1019 ** unset VAR
1020 */
1021 static int unset_command(
1022 Th_Interp *interp,
@@ -1065,10 +1107,31 @@
1107 static const Th_SubCommand aSub[] = {
1108 { "commands", info_commands_command },
1109 { "exists", info_exists_command },
1110 { "vars", info_vars_command },
1111 { 0, 0 }
1112 };
1113 return Th_CallSubCommand(interp, ctx, argc, argv, argl, aSub);
1114 }
1115
1116 /*
1117 ** TH Syntax:
1118 **
1119 ** array exists VARNAME
1120 ** array names VARNAME
1121 */
1122 static int array_command(
1123 Th_Interp *interp,
1124 void *ctx,
1125 int argc,
1126 const char **argv,
1127 int *argl
1128 ){
1129 static const Th_SubCommand aSub[] = {
1130 { "exists", array_exists_command },
1131 { "names", array_names_command },
1132 { 0, 0 }
1133 };
1134 return Th_CallSubCommand(interp, ctx, argc, argv, argl, aSub);
1135 }
1136
1137 /*
@@ -1182,10 +1245,11 @@
1245 struct _Command {
1246 const char *zName;
1247 Th_CommandProc xProc;
1248 void *pContext;
1249 } aCommand[] = {
1250 {"array", array_command, 0},
1251 {"catch", catch_command, 0},
1252 {"expr", expr_command, 0},
1253 {"for", for_command, 0},
1254 {"if", if_command, 0},
1255 {"info", info_command, 0},
1256
M test/th1.test
+85 -10
--- test/th1.test
+++ test/th1.test
@@ -926,53 +926,53 @@
926926
 catch if tclReady searchable reinitialize combobox lindex tclIsSafe query\
927927
 html anoncap randhex llength for set break regexp markdown styleHeader\
928928
 puts return checkout decorate artifact trace wiki proc tclInvoke hascap\
929929
 globalState continue getParameter hasfeature setting lsearch breakpoint\
930930
 upvar render repository string unset setParameter list error info rename\
931
- tclExpr anycap tclEval httpize tclMakeSafe}}
931
+ tclExpr array anycap tclEval httpize tclMakeSafe}}
932932
 } else {
933933
 test th1-info-commands-1 {$RESULT eq {linecount htmlize date stime\
934934
 enable_output uplevel dir http expr glob_match utime styleFooter encode64\
935935
 catch if tclReady searchable reinitialize combobox lindex query html\
936936
 anoncap randhex llength for set break regexp markdown styleHeader puts\
937937
 return checkout decorate artifact trace wiki proc hascap globalState\
938938
 continue getParameter hasfeature setting lsearch breakpoint upvar render\
939
- repository string unset setParameter list error info rename anycap\
939
+ repository string unset setParameter list error info rename array anycap\
940940
 httpize}}
941941
 }
942942
943943
 ###############################################################################
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,14 +982,69 @@
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
 }
991
+
992
+###############################################################################
993
+
994
+fossil test-th-eval "array exists foo"
995
+test th1-array-exists-1 {$RESULT eq "0"}
996
+
997
+###############################################################################
998
+
999
+fossil test-th-eval "set foo(x) 1; array exists foo"
1000
+test th1-array-exists-2 {$RESULT eq "1"}
1001
+
1002
+###############################################################################
1003
+
1004
+fossil test-th-eval "set foo(x) 1; unset foo(x); array exists foo"
1005
+test th1-array-exists-3 {$RESULT eq "1"}
1006
+
1007
+###############################################################################
1008
+
1009
+fossil test-th-eval "set foo(x) 1; unset foo; array exists foo"
1010
+test th1-array-exists-4 {$RESULT eq "0"}
1011
+
1012
+###############################################################################
1013
+
1014
+fossil test-th-eval "set foo 1; array exists foo"
1015
+test th1-array-exists-5 {$RESULT eq "0"}
1016
+
1017
+###############################################################################
1018
+
1019
+fossil test-th-eval "array names foo"
1020
+test th1-array-names-1 {$RESULT eq ""}
1021
+
1022
+###############################################################################
1023
+
1024
+fossil test-th-eval "set foo 2; array names foo"
1025
+test th1-array-names-2 {$RESULT eq ""}
1026
+
1027
+###############################################################################
1028
+
1029
+fossil test-th-eval "set foo 2; unset foo; set foo(x) 2; array names foo"
1030
+test th1-array-names-3 {$RESULT eq "x"}
1031
+
1032
+###############################################################################
1033
+
1034
+fossil test-th-eval "set foo(x) 2; array names foo"
1035
+test th1-array-names-4 {$RESULT eq "x"}
1036
+
1037
+###############################################################################
1038
+
1039
+fossil test-th-eval "set foo(x) 2; set foo(y) 2; array names foo"
1040
+test th1-array-names-5 {$RESULT eq "x y"}
1041
+
1042
+###############################################################################
1043
+
1044
+fossil test-th-eval "set foo(x) 2; unset foo(x); array names foo"
1045
+test th1-array-names-6 {$RESULT eq ""}
9911046
9921047
 ###############################################################################
9931048
9941049
 fossil test-th-eval "lsearch"
9951050
 test th1-lsearch-1 {$RESULT eq \
@@ -1361,5 +1416,25 @@
13611416
 {encode64 [artifact trunk ajax/cgi-bin/fossil-json.cgi.example]}
13621417
 }
13631418
13641419
 test th1-encode64-3 {$RESULT eq \
13651420
 "IyEvcGF0aC90by9mb3NzaWwvYmluYXJ5CnJlcG9zaXRvcnk6IC9wYXRoL3RvL3JlcG8uZnNsCg=="}
1421
+
1422
+###############################################################################
1423
+
1424
+fossil test-th-eval {array exists tcl_platform}
1425
+test th1-platform-1 {$RESULT eq "1"}
1426
+
1427
+###############################################################################
1428
+
1429
+fossil test-th-eval {array names tcl_platform}
1430
+test th1-platform-2 {$RESULT eq "engine platform"}
1431
+
1432
+###############################################################################
1433
+
1434
+fossil test-th-eval {set tcl_platform(engine)}
1435
+test th1-platform-3 {$RESULT eq "TH1"}
1436
+
1437
+###############################################################################
1438
+
1439
+fossil test-th-eval {set tcl_platform(platform)}
1440
+test th1-platform-4 {$RESULT eq "windows" || $RESULT eq "unix"}
13661441
--- test/th1.test
+++ test/th1.test
@@ -926,53 +926,53 @@
926 catch if tclReady searchable reinitialize combobox lindex tclIsSafe query\
927 html anoncap randhex llength for set break regexp markdown styleHeader\
928 puts return checkout decorate artifact trace wiki proc tclInvoke hascap\
929 globalState continue getParameter hasfeature setting lsearch breakpoint\
930 upvar render repository string unset setParameter list error info rename\
931 tclExpr anycap tclEval httpize tclMakeSafe}}
932 } else {
933 test th1-info-commands-1 {$RESULT eq {linecount htmlize date stime\
934 enable_output uplevel dir http expr glob_match utime styleFooter encode64\
935 catch if tclReady searchable reinitialize combobox lindex query html\
936 anoncap randhex llength for set break regexp markdown styleHeader puts\
937 return checkout decorate artifact trace wiki proc hascap globalState\
938 continue getParameter hasfeature setting lsearch breakpoint upvar render\
939 repository string unset setParameter list error info rename anycap\
940 httpize}}
941 }
942
943 ###############################################################################
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,14 +982,69 @@
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"
995 test th1-lsearch-1 {$RESULT eq \
@@ -1361,5 +1416,25 @@
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
@@ -926,53 +926,53 @@
926 catch if tclReady searchable reinitialize combobox lindex tclIsSafe query\
927 html anoncap randhex llength for set break regexp markdown styleHeader\
928 puts return checkout decorate artifact trace wiki proc tclInvoke hascap\
929 globalState continue getParameter hasfeature setting lsearch breakpoint\
930 upvar render repository string unset setParameter list error info rename\
931 tclExpr array anycap tclEval httpize tclMakeSafe}}
932 } else {
933 test th1-info-commands-1 {$RESULT eq {linecount htmlize date stime\
934 enable_output uplevel dir http expr glob_match utime styleFooter encode64\
935 catch if tclReady searchable reinitialize combobox lindex query html\
936 anoncap randhex llength for set break regexp markdown styleHeader puts\
937 return checkout decorate artifact trace wiki proc hascap globalState\
938 continue getParameter hasfeature setting lsearch breakpoint upvar render\
939 repository string unset setParameter list error info rename array anycap\
940 httpize}}
941 }
942
943 ###############################################################################
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,14 +982,69 @@
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 "array exists foo"
995 test th1-array-exists-1 {$RESULT eq "0"}
996
997 ###############################################################################
998
999 fossil test-th-eval "set foo(x) 1; array exists foo"
1000 test th1-array-exists-2 {$RESULT eq "1"}
1001
1002 ###############################################################################
1003
1004 fossil test-th-eval "set foo(x) 1; unset foo(x); array exists foo"
1005 test th1-array-exists-3 {$RESULT eq "1"}
1006
1007 ###############################################################################
1008
1009 fossil test-th-eval "set foo(x) 1; unset foo; array exists foo"
1010 test th1-array-exists-4 {$RESULT eq "0"}
1011
1012 ###############################################################################
1013
1014 fossil test-th-eval "set foo 1; array exists foo"
1015 test th1-array-exists-5 {$RESULT eq "0"}
1016
1017 ###############################################################################
1018
1019 fossil test-th-eval "array names foo"
1020 test th1-array-names-1 {$RESULT eq ""}
1021
1022 ###############################################################################
1023
1024 fossil test-th-eval "set foo 2; array names foo"
1025 test th1-array-names-2 {$RESULT eq ""}
1026
1027 ###############################################################################
1028
1029 fossil test-th-eval "set foo 2; unset foo; set foo(x) 2; array names foo"
1030 test th1-array-names-3 {$RESULT eq "x"}
1031
1032 ###############################################################################
1033
1034 fossil test-th-eval "set foo(x) 2; array names foo"
1035 test th1-array-names-4 {$RESULT eq "x"}
1036
1037 ###############################################################################
1038
1039 fossil test-th-eval "set foo(x) 2; set foo(y) 2; array names foo"
1040 test th1-array-names-5 {$RESULT eq "x y"}
1041
1042 ###############################################################################
1043
1044 fossil test-th-eval "set foo(x) 2; unset foo(x); array names foo"
1045 test th1-array-names-6 {$RESULT eq ""}
1046
1047 ###############################################################################
1048
1049 fossil test-th-eval "lsearch"
1050 test th1-lsearch-1 {$RESULT eq \
@@ -1361,5 +1416,25 @@
1416 {encode64 [artifact trunk ajax/cgi-bin/fossil-json.cgi.example]}
1417 }
1418
1419 test th1-encode64-3 {$RESULT eq \
1420 "IyEvcGF0aC90by9mb3NzaWwvYmluYXJ5CnJlcG9zaXRvcnk6IC9wYXRoL3RvL3JlcG8uZnNsCg=="}
1421
1422 ###############################################################################
1423
1424 fossil test-th-eval {array exists tcl_platform}
1425 test th1-platform-1 {$RESULT eq "1"}
1426
1427 ###############################################################################
1428
1429 fossil test-th-eval {array names tcl_platform}
1430 test th1-platform-2 {$RESULT eq "engine platform"}
1431
1432 ###############################################################################
1433
1434 fossil test-th-eval {set tcl_platform(engine)}
1435 test th1-platform-3 {$RESULT eq "TH1"}
1436
1437 ###############################################################################
1438
1439 fossil test-th-eval {set tcl_platform(platform)}
1440 test th1-platform-4 {$RESULT eq "windows" || $RESULT eq "unix"}
1441
M www/changes.wiki
+6
--- www/changes.wiki
+++ www/changes.wiki
@@ -19,10 +19,16 @@
1919
 * Enhanced the [/help?cmd=diff|fossil diff] command so that it accepts
2020
 directory names as arguments and computes diffs on all files contained
2121
 within those directories.
2222
 * Fix the [/help?cmd=add|fossil add] command so that it shows "SKIP" for
2323
 files added that were already under management.
24
+ * TH1 enhancements:
25
+ <ul><li>Add <nowiki>[array exists]</nowiki> command.</li>
26
+ <li>Add minimal <nowiki>[array names]</nowiki> command.</li>
27
+ <li>Add tcl_platform(engine) and tcl_platform(platform) array
28
+ elements.</li>
29
+ </ul>
2430
2531
 <h2>Changes for Version 1.34 (2015-11-02)</h2>
2632
2733
 * Make the [/help?cmd=clean|fossil clean] command undoable for files less
2834
 than 10MiB.
2935
--- www/changes.wiki
+++ www/changes.wiki
@@ -19,10 +19,16 @@
19 * Enhanced the [/help?cmd=diff|fossil diff] command so that it accepts
20 directory names as arguments and computes diffs on all files contained
21 within those directories.
22 * Fix the [/help?cmd=add|fossil add] command so that it shows "SKIP" for
23 files added that were already under management.
 
 
 
 
 
 
24
25 <h2>Changes for Version 1.34 (2015-11-02)</h2>
26
27 * Make the [/help?cmd=clean|fossil clean] command undoable for files less
28 than 10MiB.
29
--- www/changes.wiki
+++ www/changes.wiki
@@ -19,10 +19,16 @@
19 * Enhanced the [/help?cmd=diff|fossil diff] command so that it accepts
20 directory names as arguments and computes diffs on all files contained
21 within those directories.
22 * Fix the [/help?cmd=add|fossil add] command so that it shows "SKIP" for
23 files added that were already under management.
24 * TH1 enhancements:
25 <ul><li>Add <nowiki>[array exists]</nowiki> command.</li>
26 <li>Add minimal <nowiki>[array names]</nowiki> command.</li>
27 <li>Add tcl_platform(engine) and tcl_platform(platform) array
28 elements.</li>
29 </ul>
30
31 <h2>Changes for Version 1.34 (2015-11-02)</h2>
32
33 * Make the [/help?cmd=clean|fossil clean] command undoable for files less
34 than 10MiB.
35
M www/th1.md
+4
--- www/th1.md
+++ www/th1.md
@@ -83,10 +83,12 @@
8383
 The original Tcl language after when TH1 is modeled has a very rich
8484
 repertoire of commands. TH1, as it is designed to be minimalist and
8585
 embedded has a greatly reduced command set. The following bullets
8686
 summarize the commands available in TH1:
8787
88
+ * array exists VARNAME
89
+ * array names VARNAME
8890
 * break
8991
 * catch SCRIPT ?VARIABLE?
9092
 * continue
9193
 * error ?STRING?
9294
 * expr EXPR
@@ -119,10 +121,12 @@
119121
 for details.
120122
121123
 Summary of Core TH1 Variables
122124
 -----------------------------
123125
126
+ * tcl\_platform(engine) -- _This will always have the value "TH1"._
127
+ * tcl\_platform(platform) -- _This will have the value "windows" or "unix"._
124128
 * th\_stack\_trace -- _This will contain error stack information._
125129
126130
 TH1 Extended Commands
127131
 ---------------------
128132
129133
--- www/th1.md
+++ www/th1.md
@@ -83,10 +83,12 @@
83 The original Tcl language after when TH1 is modeled has a very rich
84 repertoire of commands. TH1, as it is designed to be minimalist and
85 embedded has a greatly reduced command set. The following bullets
86 summarize the commands available in TH1:
87
 
 
88 * break
89 * catch SCRIPT ?VARIABLE?
90 * continue
91 * error ?STRING?
92 * expr EXPR
@@ -119,10 +121,12 @@
119 for details.
120
121 Summary of Core TH1 Variables
122 -----------------------------
123
 
 
124 * th\_stack\_trace -- _This will contain error stack information._
125
126 TH1 Extended Commands
127 ---------------------
128
129
--- www/th1.md
+++ www/th1.md
@@ -83,10 +83,12 @@
83 The original Tcl language after when TH1 is modeled has a very rich
84 repertoire of commands. TH1, as it is designed to be minimalist and
85 embedded has a greatly reduced command set. The following bullets
86 summarize the commands available in TH1:
87
88 * array exists VARNAME
89 * array names VARNAME
90 * break
91 * catch SCRIPT ?VARIABLE?
92 * continue
93 * error ?STRING?
94 * expr EXPR
@@ -119,10 +121,12 @@
121 for details.
122
123 Summary of Core TH1 Variables
124 -----------------------------
125
126 * tcl\_platform(engine) -- _This will always have the value "TH1"._
127 * tcl\_platform(platform) -- _This will have the value "windows" or "unix"._
128 * th\_stack\_trace -- _This will contain error stack information._
129
130 TH1 Extended Commands
131 ---------------------
132
133

Keyboard Shortcuts

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