Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
Comment: | Add the 'array exists' and 'array names' sub-commands to TH1. |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | tclPlatform |
Files: | files | file ages | folders |
SHA1: |
fd4ada4a11dfb399f6995fcef5390ab4 |
User & Date: | mistachkin 2016-01-18 02:21:20.179 |
Context
2016-01-18
| ||
02:22 | Fix comment. ... (check-in: 1a3f326b user: mistachkin tags: tclPlatform) | |
02:21 | Add the 'array exists' and 'array names' sub-commands to TH1. ... (check-in: fd4ada4a user: mistachkin tags: tclPlatform) | |
01:43 | Merge trunk. ... (check-in: 58466e7f user: mistachkin tags: tclPlatform) | |
Changes
Changes to src/th.c.
︙ | ︙ | |||
1249 1250 1251 1252 1253 1254 1255 1256 1257 1258 1259 1260 1261 1262 | /* ** Return true if variable (zVar, nVar) exists. */ int Th_ExistsVar(Th_Interp *interp, const char *zVar, int nVar){ Th_Variable *pValue = thFindValue(interp, zVar, nVar, 0, 1, 1, 0); return pValue && (pValue->zData || pValue->pHash); } /* ** String (zVar, nVar) must contain the name of a scalar variable or ** array member. If the variable does not exist it is created. The ** variable is set to the value supplied in string (zValue, nValue). ** ** If (zVar, nVar) refers to an existing array, TH_ERROR is returned | > > > > > > > > | 1249 1250 1251 1252 1253 1254 1255 1256 1257 1258 1259 1260 1261 1262 1263 1264 1265 1266 1267 1268 1269 1270 | /* ** Return true if variable (zVar, nVar) exists. */ int Th_ExistsVar(Th_Interp *interp, const char *zVar, int nVar){ Th_Variable *pValue = thFindValue(interp, zVar, nVar, 0, 1, 1, 0); return pValue && (pValue->zData || pValue->pHash); } /* ** Return true if array variable (zVar, nVar) exists. */ int Th_ExistsArrayVar(Th_Interp *interp, const char *zVar, int nVar){ Th_Variable *pValue = thFindValue(interp, zVar, nVar, 0, 1, 1, 0); return pValue && !pValue->zData && pValue->pHash; } /* ** String (zVar, nVar) must contain the name of a scalar variable or ** array member. If the variable does not exist it is created. The ** variable is set to the value supplied in string (zValue, nValue). ** ** If (zVar, nVar) refers to an existing array, TH_ERROR is returned |
︙ | ︙ | |||
2929 2930 2931 2932 2933 2934 2935 | Th_HashIterate(interp, pFrame->paVar, thListAppendHashKey, p); Th_Free(interp, p); return TH_OK; }else{ return TH_ERROR; } } | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 2937 2938 2939 2940 2941 2942 2943 2944 2945 2946 2947 2948 2949 2950 2951 2952 2953 2954 2955 2956 2957 2958 2959 2960 2961 2962 2963 2964 2965 2966 2967 2968 2969 2970 2971 2972 2973 | Th_HashIterate(interp, pFrame->paVar, thListAppendHashKey, p); Th_Free(interp, p); return TH_OK; }else{ return TH_ERROR; } } /* ** Appends all array element names for the specified array variable to the ** specified list and returns TH_OK upon success. Any other return value ** indicates an error. If the current frame cannot be obtained, TH_ERROR ** is returned. */ int Th_ListAppendArray( Th_Interp *interp, const char *zVar, /* Pointer to variable name */ int nVar, /* Number of bytes at nVar */ char **pzList, /* OUT: List of array element names */ int *pnList /* OUT: Number of array element names */ ){ Th_Variable *pValue = thFindValue(interp, zVar, nVar, 0, 1, 1, 0); if( pValue && !pValue->zData && pValue->pHash ){ Th_InterpAndList *p = (Th_InterpAndList *)Th_Malloc( interp, sizeof(Th_InterpAndList) ); p->interp = interp; p->pzList = pzList; p->pnList = pnList; Th_HashIterate(interp, pValue->pHash, thListAppendHashKey, p); Th_Free(interp, p); }else{ *pzList = 0; *pnList = 0; } return TH_OK; } |
Changes to src/th.h.
︙ | ︙ | |||
48 49 50 51 52 53 54 55 56 57 58 59 60 61 | int Th_Expr(Th_Interp *interp, const char *, int); /* ** Access TH variables in the current stack frame. If the variable name ** begins with "::", the lookup is in the top level (global) frame. */ int Th_ExistsVar(Th_Interp *, const char *, int); int Th_GetVar(Th_Interp *, const char *, int); int Th_SetVar(Th_Interp *, const char *, int, const char *, int); int Th_LinkVar(Th_Interp *, const char *, int, int, const char *, int); int Th_UnsetVar(Th_Interp *, const char *, int); typedef int (*Th_CommandProc)(Th_Interp *, void *, int, const char **, int *); | > | 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 | int Th_Expr(Th_Interp *interp, const char *, int); /* ** Access TH variables in the current stack frame. If the variable name ** begins with "::", the lookup is in the top level (global) frame. */ int Th_ExistsVar(Th_Interp *, const char *, int); int Th_ExistsArrayVar(Th_Interp *, const char *, int); int Th_GetVar(Th_Interp *, const char *, int); int Th_SetVar(Th_Interp *, const char *, int, const char *, int); int Th_LinkVar(Th_Interp *, const char *, int, int, const char *, int); int Th_UnsetVar(Th_Interp *, const char *, int); typedef int (*Th_CommandProc)(Th_Interp *, void *, int, const char **, int *); |
︙ | ︙ | |||
141 142 143 144 145 146 147 148 149 150 151 152 153 154 | int Th_SetResultDouble(Th_Interp *, double); /* ** Functions for handling command and variable introspection. */ int Th_ListAppendCommands(Th_Interp *, char **, int *); int Th_ListAppendVariables(Th_Interp *, char **, int *); /* ** Drop in replacements for the corresponding standard library functions. */ int th_strlen(const char *); int th_isdigit(char); int th_isspace(char); | > | 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 | int Th_SetResultDouble(Th_Interp *, double); /* ** Functions for handling command and variable introspection. */ int Th_ListAppendCommands(Th_Interp *, char **, int *); int Th_ListAppendVariables(Th_Interp *, char **, int *); int Th_ListAppendArray(Th_Interp *, const char *, int, char **, int *); /* ** Drop in replacements for the corresponding standard library functions. */ int th_strlen(const char *); int th_isdigit(char); int th_isspace(char); |
︙ | ︙ |
Changes to src/th_lang.c.
︙ | ︙ | |||
969 970 971 972 973 974 975 976 977 978 979 980 981 982 | Th_SetResult(interp, zElem, nElem); if( zElem ) Th_Free(interp, zElem); return TH_OK; } /* ** TH Syntax: ** ** unset VAR */ static int unset_command( Th_Interp *interp, void *ctx, int argc, | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 969 970 971 972 973 974 975 976 977 978 979 980 981 982 983 984 985 986 987 988 989 990 991 992 993 994 995 996 997 998 999 1000 1001 1002 1003 1004 1005 1006 1007 1008 1009 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 | Th_SetResult(interp, zElem, nElem); if( zElem ) Th_Free(interp, zElem); return TH_OK; } /* ** TH Syntax: ** ** array exists VARNAME */ static int array_exists_command( Th_Interp *interp, void *ctx, int argc, const char **argv, int *argl ){ int rc; if( argc!=3 ){ return Th_WrongNumArgs(interp, "array exists var"); } rc = Th_ExistsArrayVar(interp, argv[2], argl[2]); Th_SetResultInt(interp, rc); return TH_OK; } /* ** TH Syntax: ** ** array names */ static int array_names_command( Th_Interp *interp, void *ctx, int argc, const char **argv, int *argl ){ int rc; char *zElem = 0; int nElem = 0; if( argc!=3 ){ return Th_WrongNumArgs(interp, "array names varname"); } rc = Th_ListAppendArray(interp, argv[2], argl[2], &zElem, &nElem); if( rc!=TH_OK ){ return rc; } Th_SetResult(interp, zElem, nElem); if( zElem ) Th_Free(interp, zElem); return TH_OK; } /* ** TH Syntax: ** ** unset VAR */ static int unset_command( Th_Interp *interp, void *ctx, int argc, |
︙ | ︙ | |||
1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 | int *argl ){ static const Th_SubCommand aSub[] = { { "commands", info_commands_command }, { "exists", info_exists_command }, { "vars", info_vars_command }, { 0, 0 } }; return Th_CallSubCommand(interp, ctx, argc, argv, argl, aSub); } /* ** Convert the script level frame specification (used by the commands ** [uplevel] and [upvar]) in (zFrame, nFrame) to an integer frame as | > > > > > > > > > > > > > > > > > > > > > | 1105 1106 1107 1108 1109 1110 1111 1112 1113 1114 1115 1116 1117 1118 1119 1120 1121 1122 1123 1124 1125 1126 1127 1128 1129 1130 1131 1132 1133 1134 1135 1136 1137 1138 1139 | int *argl ){ static const Th_SubCommand aSub[] = { { "commands", info_commands_command }, { "exists", info_exists_command }, { "vars", info_vars_command }, { 0, 0 } }; return Th_CallSubCommand(interp, ctx, argc, argv, argl, aSub); } /* ** TH Syntax: ** ** array exists VARNAME ** array names VARNAME */ static int array_command( Th_Interp *interp, void *ctx, int argc, const char **argv, int *argl ){ static const Th_SubCommand aSub[] = { { "exists", array_exists_command }, { "names", array_names_command }, { 0, 0 } }; return Th_CallSubCommand(interp, ctx, argc, argv, argl, aSub); } /* ** Convert the script level frame specification (used by the commands ** [uplevel] and [upvar]) in (zFrame, nFrame) to an integer frame as |
︙ | ︙ | |||
1180 1181 1182 1183 1184 1185 1186 1187 1188 1189 1190 1191 1192 1193 | int th_register_language(Th_Interp *interp){ /* Array of built-in commands. */ struct _Command { const char *zName; Th_CommandProc xProc; void *pContext; } aCommand[] = { {"catch", catch_command, 0}, {"expr", expr_command, 0}, {"for", for_command, 0}, {"if", if_command, 0}, {"info", info_command, 0}, {"lindex", lindex_command, 0}, {"list", list_command, 0}, | > | 1243 1244 1245 1246 1247 1248 1249 1250 1251 1252 1253 1254 1255 1256 1257 | int th_register_language(Th_Interp *interp){ /* Array of built-in commands. */ struct _Command { const char *zName; Th_CommandProc xProc; void *pContext; } aCommand[] = { {"array", array_command, 0}, {"catch", catch_command, 0}, {"expr", expr_command, 0}, {"for", for_command, 0}, {"if", if_command, 0}, {"info", info_command, 0}, {"lindex", lindex_command, 0}, {"list", list_command, 0}, |
︙ | ︙ |
Changes to test/th1.test.
︙ | ︙ | |||
924 925 926 927 928 929 930 | test th1-info-commands-1 {$RESULT eq {linecount htmlize date stime\ enable_output uplevel dir http expr glob_match utime styleFooter encode64\ catch if tclReady searchable reinitialize combobox lindex tclIsSafe query\ html anoncap randhex llength for set break regexp markdown styleHeader\ puts return checkout decorate artifact trace wiki proc tclInvoke hascap\ globalState continue getParameter hasfeature setting lsearch breakpoint\ upvar render repository string unset setParameter list error info rename\ | | | | 924 925 926 927 928 929 930 931 932 933 934 935 936 937 938 939 940 941 942 943 944 945 946 | test th1-info-commands-1 {$RESULT eq {linecount htmlize date stime\ enable_output uplevel dir http expr glob_match utime styleFooter encode64\ catch if tclReady searchable reinitialize combobox lindex tclIsSafe query\ html anoncap randhex llength for set break regexp markdown styleHeader\ puts return checkout decorate artifact trace wiki proc tclInvoke hascap\ globalState continue getParameter hasfeature setting lsearch breakpoint\ upvar render repository string unset setParameter list error info rename\ tclExpr array anycap tclEval httpize tclMakeSafe}} } else { test th1-info-commands-1 {$RESULT eq {linecount htmlize date stime\ enable_output uplevel dir http expr glob_match utime styleFooter encode64\ catch if tclReady searchable reinitialize combobox lindex query html\ anoncap randhex llength for set break regexp markdown styleHeader puts\ return checkout decorate artifact trace wiki proc hascap globalState\ continue getParameter hasfeature setting lsearch breakpoint upvar render\ repository string unset setParameter list error info rename array anycap\ httpize}} } ############################################################################### fossil test-th-eval "info vars" |
︙ | ︙ | |||
984 985 986 987 988 989 990 991 992 993 994 995 996 997 | if {$th1Hooks} { test th1-info-vars-5 {$RESULT eq \ "th_stack_trace y cmd_flags tcl_platform cmd_name cmd_args"} } else { test th1-info-vars-5 {$RESULT eq "y tcl_platform"} } ############################################################################### fossil test-th-eval "lsearch" test th1-lsearch-1 {$RESULT eq \ {TH_ERROR: wrong # args: should be "lsearch list string"}} | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 984 985 986 987 988 989 990 991 992 993 994 995 996 997 998 999 1000 1001 1002 1003 1004 1005 1006 1007 1008 1009 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 | if {$th1Hooks} { test th1-info-vars-5 {$RESULT eq \ "th_stack_trace y cmd_flags tcl_platform cmd_name cmd_args"} } else { test th1-info-vars-5 {$RESULT eq "y tcl_platform"} } ############################################################################### fossil test-th-eval "array exists foo" test th1-array-exists-1 {$RESULT eq "0"} ############################################################################### fossil test-th-eval "set foo(x) 1; array exists foo" test th1-array-exists-2 {$RESULT eq "1"} ############################################################################### fossil test-th-eval "set foo(x) 1; unset foo(x); array exists foo" test th1-array-exists-3 {$RESULT eq "1"} ############################################################################### fossil test-th-eval "set foo(x) 1; unset foo; array exists foo" test th1-array-exists-4 {$RESULT eq "0"} ############################################################################### fossil test-th-eval "set foo 1; array exists foo" test th1-array-exists-5 {$RESULT eq "0"} ############################################################################### fossil test-th-eval "array names foo" test th1-array-names-1 {$RESULT eq ""} ############################################################################### fossil test-th-eval "set foo 2; array names foo" test th1-array-names-2 {$RESULT eq ""} ############################################################################### fossil test-th-eval "set foo 2; unset foo; set foo(x) 2; array names foo" test th1-array-names-3 {$RESULT eq "x"} ############################################################################### fossil test-th-eval "set foo(x) 2; array names foo" test th1-array-names-4 {$RESULT eq "x"} ############################################################################### fossil test-th-eval "set foo(x) 2; set foo(y) 2; array names foo" test th1-array-names-5 {$RESULT eq "x y"} ############################################################################### fossil test-th-eval "set foo(x) 2; unset foo(x); array names foo" test th1-array-names-6 {$RESULT eq ""} ############################################################################### fossil test-th-eval "lsearch" test th1-lsearch-1 {$RESULT eq \ {TH_ERROR: wrong # args: should be "lsearch list string"}} |
︙ | ︙ | |||
1362 1363 1364 1365 1366 1367 1368 1369 | } test th1-encode64-3 {$RESULT eq \ "IyEvcGF0aC90by9mb3NzaWwvYmluYXJ5CnJlcG9zaXRvcnk6IC9wYXRoL3RvL3JlcG8uZnNsCg=="} ############################################################################### fossil test-th-eval {set tcl_platform(engine)} | > > > > > > > > > > | | | 1417 1418 1419 1420 1421 1422 1423 1424 1425 1426 1427 1428 1429 1430 1431 1432 1433 1434 1435 1436 1437 1438 1439 1440 | } test th1-encode64-3 {$RESULT eq \ "IyEvcGF0aC90by9mb3NzaWwvYmluYXJ5CnJlcG9zaXRvcnk6IC9wYXRoL3RvL3JlcG8uZnNsCg=="} ############################################################################### fossil test-th-eval {array exists tcl_platform} test th1-platform-1 {$RESULT eq "1"} ############################################################################### fossil test-th-eval {array names tcl_platform} test th1-platform-2 {$RESULT eq "engine platform"} ############################################################################### fossil test-th-eval {set tcl_platform(engine)} test th1-platform-3 {$RESULT eq "TH1"} ############################################################################### fossil test-th-eval {set tcl_platform(platform)} test th1-platform-4 {$RESULT eq "windows" || $RESULT eq "unix"} |
Changes to www/th1.md.
︙ | ︙ | |||
81 82 83 84 85 86 87 88 89 90 91 92 93 94 | ---------------------------- The original Tcl language after when TH1 is modeled has a very rich repertoire of commands. TH1, as it is designed to be minimalist and embedded has a greatly reduced command set. The following bullets summarize the commands available in TH1: * break * catch SCRIPT ?VARIABLE? * continue * error ?STRING? * expr EXPR * for INIT-SCRIPT TEST-EXPR NEXT-SCRIPT BODY-SCRIPT * if EXPR SCRIPT (elseif EXPR SCRIPT)* ?else SCRIPT? | > > | 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 | ---------------------------- The original Tcl language after when TH1 is modeled has a very rich repertoire of commands. TH1, as it is designed to be minimalist and embedded has a greatly reduced command set. The following bullets summarize the commands available in TH1: * array exists VARNAME * array names VARNAME * break * catch SCRIPT ?VARIABLE? * continue * error ?STRING? * expr EXPR * for INIT-SCRIPT TEST-EXPR NEXT-SCRIPT BODY-SCRIPT * if EXPR SCRIPT (elseif EXPR SCRIPT)* ?else SCRIPT? |
︙ | ︙ |