Fossil

Check-in [fd4ada4a]
Login

Check-in [fd4ada4a]

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: fd4ada4a11dfb399f6995fcef5390ab4531c7639
User & Date: mistachkin 2016-01-18 02:21:20
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
Unified Diff Ignore Whitespace Patch
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
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 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 anycap\
      httpize}}
}

###############################################################################

fossil test-th-eval "info vars"









|







|








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
1370
1371
1372
1373
1374
1375

}

test th1-encode64-3 {$RESULT eq \
"IyEvcGF0aC90by9mb3NzaWwvYmluYXJ5CnJlcG9zaXRvcnk6IC9wYXRoL3RvL3JlcG8uZnNsCg=="}

###############################################################################











fossil test-th-eval {set tcl_platform(engine)}
test th1-platform-1 {$RESULT eq "TH1"}

###############################################################################

fossil test-th-eval {set tcl_platform(platform)}
test th1-platform-2 {$RESULT eq "windows" || $RESULT eq "unix"}








>
>
>
>
>
>
>
>
>
>

|




|

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?
︙︙