diff options
author | Steve Bennett <steveb@workware.net.au> | 2010-01-24 12:03:40 +1000 |
---|---|---|
committer | Steve Bennett <steveb@workware.net.au> | 2010-10-15 11:02:44 +1000 |
commit | a17425e476861fde1e1ad824181f97e081740659 (patch) | |
tree | fce3d80fb5c271dddf1ab005ecdfd039ec52ebb4 | |
parent | b9835f11e31b7e021da6b0831eac659425735ba2 (diff) | |
download | jimtcl-a17425e476861fde1e1ad824181f97e081740659.zip jimtcl-a17425e476861fde1e1ad824181f97e081740659.tar.gz jimtcl-a17425e476861fde1e1ad824181f97e081740659.tar.bz2 |
New features, docs
Implement lsearch in C with options
*: lsearch -exact, -glob, -regexp, -not, -bool, -all, -inline
Add tests for lsearch and expand
expr operators: in and ni (Tcl 8.6)
-rw-r--r-- | doc/jim_tcl.txt | 258 | ||||
-rw-r--r-- | jim.c | 201 | ||||
-rw-r--r-- | tcl6.tcl | 12 | ||||
-rw-r--r-- | tests/expand.test | 29 | ||||
-rw-r--r-- | tests/expr.test | 45 | ||||
-rw-r--r-- | tests/lsearch.test | 179 |
6 files changed, 657 insertions, 67 deletions
diff --git a/doc/jim_tcl.txt b/doc/jim_tcl.txt index ae28724..e39f9db 100644 --- a/doc/jim_tcl.txt +++ b/doc/jim_tcl.txt @@ -3,7 +3,7 @@ Jim Tcl(n) NAME ---- -Jim Tcl - overview of the Jim tool command language facilities +Jim Tcl v0.62 - overview of the Jim tool command language facilities SYNOPSIS -------- @@ -56,6 +56,21 @@ The major differences are: 19. Variable traces are not supported 20. The history command is not supported +CHANGES +------- +Since v0.61: +1. Add support to 'exec' for '>&', '>>&', '|&' +2. Fix 'exec' error messages when special token (e.g. '>') is the last token +3. Fix 'subst' handling of backslash escapes. +4. Allow abbreviated options for 'subst' +5. Add support for 'return', 'break', 'continue' in subst +6. Many 'expr' bug fixes +7. Add support for functions in 'expr' (e.g. int(), abs()), and also 'in', 'ni' list operations +8. The variable name argument to 'regsub' is now optional +9. Add support for 'unset -nocomplain' +10. Add support for list commands: 'lassign', 'lrepeat' +11. Fully-functional 'lsearch' is now implemented + TCL INTRODUCTION ----------------- Tcl stands for 'tool command language' and is pronounced 'tickle.' @@ -593,13 +608,20 @@ on the right side of the line: The valid operators are listed below, grouped in decreasing order of precedence: [[OperatorPrecedence]] -`- ~ !`:: - Unary minus, bit-wise NOT, logical NOT. None of these operands +`int() double() round() abs()`:: + Unary functions. + int() converts the numeric argument to an integer by truncating down. + double() converts the numeric argument to floating point. + round() converts the numeric argument to the closest integer value. + abs() takes the absolute value of the numeric argument. + +`- + ~ !`:: + Unary minus, unary plus, bit-wise NOT, logical NOT. None of these operands may be applied to string operands, and bit-wise NOT may be applied only to integers. `**`:: - Power. e.g. pow(). Numbers only. + Power. e.g. pow(). Integers only. `* / %`:: Multiply, divide, remainder. None of these operands may be @@ -609,8 +631,8 @@ of precedence: `+ -`:: Add and subtract. Valid for any numeric operands. -`<< >>`:: - Left and right shift. Valid for integer operands only. +`<< >> <<< >>>`:: + Left and right shift, left and right rotate. Valid for integer operands only. `< > \<= >=`:: Boolean less, greater, less than or equal, and greater than or equal. @@ -618,24 +640,30 @@ of precedence: These operators may be applied to strings as well as numeric operands, in which case string comparison is used. +`== !=`:: + Boolean equal and not equal. Each operator produces a zero/one result. + Valid for all operand types. *Note* that values will be converted to integers + if possible, then floating point types, and finally strings will be compared. + It is recommended that 'eq' and 'ne' should be used for string comparison. + `eq ne`:: String equal and not equal. Uses the string value directly without attempting to convert to a number first. -`== !=`:: - Boolean equal and not equal. Each operator produces a zero/one result. - Valid for all operand types. Note that values will be converted to integers - if possible, then floating point types, and finally strings will be compared. +`in ni`:: + String in list and not in list. For 'in', result is 1 the left operand (as a string) + is contained in the right operand (as a list), or 0 otherwise. The result for + '{$a ni $list}' is equivalent to '{!($a in $list)}'. `&`:: Bit-wise AND. Valid for integer operands only. -`^`:: - Bit-wise exclusive OR. Valid for integer operands only. - `|`:: Bit-wise OR. Valid for integer operands only. +`^`:: + Bit-wise exclusive OR. Valid for integer operands only. + `&&`:: Logical AND. Produces a 1 result if both operands are non-zero, 0 otherwise. Valid for numeric operands only (integers or floating-point). @@ -648,9 +676,8 @@ of precedence: If-then-else, as in C. If *x* evaluates to non-zero, then the result is the value of *y*. Otherwise the result is the value of *z*. - The *x* operand must have a numeric value. - Note that Jim currently evaluates *both* sides of the expression regardless - of the value of *x*. + The *x* operand must have a numeric value, while *y* and *z* can + be of any type. See the C manual for more details on the results produced by each operator. @@ -671,8 +698,6 @@ not needed to determine the outcome. For example, in only one of '[a]' or '[b]' will actually be evaluated, depending on the value of '$v'. -*NOTE* This is currently not true of the ?: operator for Jim. - All internal computations involving integers are done with the C type 'long long' if available, or 'long' otherwise, and all internal computations involving floating-point are done with the C type @@ -717,7 +742,6 @@ both evaluate to 1. The first comparison is done using integer comparison, and the second is done using string comparison after the second operand is converted to the string '18'. - In general it is safest to enclose an expression in braces when entering it in a command: otherwise, if the expression contains any white space then the Tcl interpreter will split it @@ -794,6 +818,8 @@ The Tcl commands 'concat', 'foreach', 'lappend', 'lindex', 'linsert', you to build lists, extract elements from them, search them, and perform other list-related functions. +Advanced list commands include 'lrepeat', 'lreverse', 'lmap', 'lassign', 'lset'. + LIST EXPANSION -------------- @@ -998,6 +1024,55 @@ will output: 1 one 2 two +DICTIONARY VALUES +----------------- +In Tcl 8.5 the dict command has been introduced. This provides +efficient access to key-value pairs, just like arrays, but dictionaries +are pure values. This means that you can pass them to a procedure +just as a list or a string. Tcl dictionaries are therefore much +more like Tcl lists, except that they represent a mapping from keys +to values, rather than an ordered sequence. + +You can nest dictionaries, so that the value for a particular key +consists of another dictionary. That way you can elegantly build +complicated data structures, such as hierarchical databases. You +can also combine dictionaries with other Tcl data structures. For +instance, you can build a list of dictionaries that themselves +contain lists. + +Dictionaries are values that contain an efficient, order-preserving +mapping from arbitrary keys to arbitrary values. Each key in the +dictionary maps to a single value. They have a textual format that +is exactly that of any list with an even number of elements, with +each mapping in the dictionary being represented as two items in +the list. When a command takes a dictionary and produces a new +dictionary based on it (either returning it or writing it back into +the variable that the starting dictionary was read from) the new +dictionary will have the same order of keys, modulo any deleted +keys and with new keys added on to the end. When a string is +interpreted as a dictionary and it would otherwise have duplicate +keys, only the last value for a particular key is used; the others +are ignored, meaning that, "apple banana" and "apple carrot apple +banana" are equivalent dictionaries (with different string +representations). + +Note that in Jim, arrays are implemented as dictionaries. +Thus automatic conversion between lists and dictionaries applies +as it does for arrays. + + jim> dict set a 1 one + 1 one + jim> dict set a 2 two + 1 one 2 two + jim> puts $a + 1 one 2 two + jim> puts $a(2) + two + jim> dict set a 3 T three + 1 one 2 two 3 {T three} + +See the 'dict' command for more details. + GARBAGE COLLECTION, REFERENCES, LAMBDA -------------------------------------- Unlike Tcl, Jim has some sophistocated support for functional programming. @@ -1357,6 +1432,56 @@ as 'for' or 'foreach' or 'while'. It returns a JIM_CONTINUE code to signal the innermost containing loop command to skip the remainder of the loop's body but continue with the next iteration of the loop. +dict +~~~~ ++*dict* 'option ?arg arg ...?'+ + +Performs one of several operations on dictionary values. + +The *option* argument determines what action is carried out by the +command. The legal *options* are: + ++dict create '?key value ...?'+:: + Create and return a new dictionary value that contains each of + the key/value mappings listed as arguments (keys and values + alternating, with each key being followed by its associated + value.) + ++dict exists 'dictionary key ?key ...?'+:: + Returns a boolean value indicating whether the given key (or path + of keys through a set of nested dictionaries) exists in the given + dictionary value. This returns a true value exactly when 'dict get' + on that path will succeed. + ++dict get 'dictionary ?key ...?'+:: + Given a dictionary value (first argument) and a key (second argument), + this will retrieve the value for that key. Where several keys are + supplied, the behaviour of the command shall be as if the result + of 'dict get $dictVal $key' was passed as the first argument to + dict get with the remaining arguments as second (and possibly + subsequent) arguments. This facilitates lookups in nested dictionaries. + If no keys are provided, dict would return a list containing pairs + of elements in a man- ner similar to array get. That is, the first + element of each pair would be the key and the second element would + be the value for that key. It is an error to attempt to retrieve + a value for a key that is not present in the dictionary. + ++dict set 'dictionaryName key ?key ...?' value+:: + This operation takes the *name* of a variable containing a dictionary + value and places an updated dictionary value in that variable + containing a mapping from the given key to the given value. When + multiple keys are present, this operation creates or updates a chain + of nested dictionaries. + ++dict unset 'dictionaryName key ?key ...?' value+:: + This operation (the companion to 'dict set') takes the name of a + variable containing a dictionary value and places an updated + dictionary value in that variable that does not contain a mapping + for the given key. Where multiple keys are present, this describes + a path through nested dictionaries to the mapping to remove. At + least one key must be specified, but the last key on the key-path + need not exist. All other components on the path must exist. + env ~~~ +*env* '?name? ?default?'+ @@ -1440,7 +1565,8 @@ of one or more UNIX commands to execute as subprocesses. The commands take the form of a standard shell pipeline; '|' arguments separate commands in the pipeline and cause standard output of the preceding command -to be piped into standard input of the next command. +to be piped into standard input of the next command (or '|&' for +both standard output and standard error). Under normal conditions the result of the 'exec' command consists of the standard output produced by the last command @@ -1489,6 +1615,13 @@ An *arg* may have one of the following special forms: The standard error of the last command in the pipeline is redirected to the given (writable) file descriptor. ++>&filename+:: + Both the standard output and standard error of the last command + in the pipeline is redirected to the file. + ++>>&filename+:: + As above, but append to the file. + +<filename+:: The standard input of the first command in the pipeline is taken from the file. @@ -2224,6 +2357,16 @@ the list. If no *element* arguments are specified, then the elements between *first* and *last* are simply deleted. +lrepeat +~~~~~~~~ ++*lrepeat* 'number element1 ?element2 ...?'+ + +Build a list by repeating elements *number* times (which must be +a positive integer). + + jim> lrepeat 3 a b + a b a b a b + lreverse ~~~~~~~~ +*lreverse* 'list'+ @@ -2235,18 +2378,52 @@ Returns the list in reverse order. lsearch ~~~~~~~ -+*lsearch* 'list value'+ ++*lsearch* '?options? list pattern'+ + +This command searches the elements *list* to see if one of them matches *pattern*. If so, the +command returns the index of the first matching element (unless the options -all, -inline or -bool are +specified.) If not, the command returns -1. The option arguments indicates how the elements of +the list are to be matched against pattern and must have one of the values below: + +*Note* that this command is different from Tcl in that default match type is '-exact' rather than '-glob'. -Search the elements of *list* to see if one of them matches -*value*. ++'-exact'+:: + *pattern* is a literal string that is compared for exact equality against each list element. + This is the default. -If so, the command returns the index of the first matching -element. ++'-glob'+:: + *pattern* is a glob-style pattern which is matched against each list element using the same + rules as the string match command. -If not, the command returns '-1'. ++'-regexp'+:: + *pattern* is treated as a regular expression and matched against each list element using + the rules described by 'regexp'. -*Note* that this command is different from Tcl in that an exact -match is done rather than a pattern match. ++'-all'+:: + Changes the result to be the list of all matching indices (or all matching values if + '-inline' is specified as well). If indices are returned, the indices will be in numeric + order. If values are returned, the order of the values will be the order of those values + within the input list. + ++'-inline'+:: + The matching value is returned instead of its index (or an empty string if no value + matches). If '-all' is also specified, then the result of the command is the list of all + values that matched. The '-inline' and '-bool' options are mutually exclusive. + ++'-bool'+:: + Changes the result to '1' if a match was found, or '0' otherwise. If '-all' is also specified, + the result will be a list of '0' and '1' for each element of the list depending upon whether + the corresponding element matches. The '-inline' and '-bool' options are mutually exclusive. + ++'-not'+:: + This negates the sense of the match, returning the index (or value + if '-inline' is specified) of the first non-matching value in the + list. If '-bool' is also specified, the '0' will be returned if a + match is found, or '1' otherwise. If '-all' is also specified, + non-matches will be returned rather than matches. + ++'-nocase'+:: + Causes comparisons to be handled in a case-insensitive manner. lsort ~~~~~ @@ -2534,16 +2711,19 @@ The following switches modify the behaviour of *regexp* regsub ~~~~~~ -+*regsub ?-all? ?-nocase?* 'exp string subSpec varName' ++*regsub ?-all? ?-nocase?* 'exp string subSpec ?varName?' This command matches the regular expression *exp* against *string* using the rules described in REGULAR EXPRESSIONS above. -If there is no match, then the command returns 0 and does nothing else. +If *varName* is specified, the commands stores *string* to *varName* +with the susbstitutions detailed below, and returns the number of +substitutions made (normally 1 unless '-all' is specified). +This is 0 if there were no matches. -If there is a match, then the command returns 1 and also copies -*string* to the variable whose name is given by *varName*. +If *varName* is not specified, the substituted string will be returned +instead. When copying *string*, the portion of *string* that matched *exp* is replaced with *subSpec*. @@ -2928,6 +3108,12 @@ as options. The following options are currently supported: expression matching (i.e. the same as implemented by the regexp command). + +-command 'commandname'+:: + When matching string to the patterns, use the given command, which + must be a single word. The command is invoked as + 'commandname pattern string', or 'commandname -nocase pattern string' + and must return 1 if matched, or 0 if not. + +--+:: Marks the end of options. The argument following this one will be treated as string even if it starts @@ -3039,9 +3225,9 @@ the original non-existent command. unset ~~~~~ -+*unset* 'name ?name name ...?'+ ++*unset* '?-nocomplain? ?--? ?name name ...?'+ -Remove one or more variables. +Remove variables. Each *name* is a variable name, specified in any of the ways acceptable to the 'set' command. @@ -3053,7 +3239,9 @@ index, then the entire array is deleted. The 'unset' command returns an empty string as result. -An error occurs if any of the variables doesn't exist. +An error occurs if any of the variables doesn't exist, unless '-nocomplain' +is specified. The '--' argument may be specified to stop option processing +in case the variable name may be '-nocomplain'. uplevel ~~~~~~~ @@ -6128,6 +6128,8 @@ enum { /* Binary operators (strings) */ JIM_EXPROP_STREQ, JIM_EXPROP_STRNE, + JIM_EXPROP_STRIN, + JIM_EXPROP_STRNI, /* Unary operators (numbers) */ JIM_EXPROP_NOT, @@ -6487,6 +6489,23 @@ static int JimExprOpBin(Jim_Interp *interp, struct expr_state *e) return rc; } +static int JimSearchList(Jim_Interp *interp, Jim_Obj *listObjPtr, Jim_Obj *valObj) +{ + int listlen; + int i; + + Jim_ListLength(interp, listObjPtr, &listlen); + for (i = 0; i < listlen; i++) { + Jim_Obj *objPtr; + Jim_ListIndex(interp, listObjPtr, i, &objPtr, JIM_NONE); + + if (Jim_StringEqObj(objPtr, valObj, 0)) { + return 1; + } + } + return 0; +} + static int JimExprOpStrBin(Jim_Interp *interp, struct expr_state *e) { Jim_Obj *B = expr_pop(e); @@ -6495,6 +6514,7 @@ static int JimExprOpStrBin(Jim_Interp *interp, struct expr_state *e) int Alen, Blen; jim_wide wC; + /* XXX: Not needed for IN, NI */ const char *sA = Jim_GetString(A, &Alen); const char *sB = Jim_GetString(B, &Blen); @@ -6503,6 +6523,10 @@ static int JimExprOpStrBin(Jim_Interp *interp, struct expr_state *e) wC = (Alen == Blen && memcmp(sA, sB, Alen) == 0); break; case JIM_EXPROP_STRNE: wC = (Alen != Blen || memcmp(sA, sB, Alen) != 0); break; + case JIM_EXPROP_STRIN: + wC = JimSearchList(interp, B, A); break; + case JIM_EXPROP_STRNI: + wC = !JimSearchList(interp, B, A); break; default: abort(); } expr_push(e, Jim_NewIntObj(interp, wC)); @@ -6699,6 +6723,9 @@ static const struct Jim_ExprOperator Jim_ExprOperators[] = { [JIM_EXPROP_STREQ] = {"eq", 60, 2, JimExprOpStrBin }, [JIM_EXPROP_STRNE] = {"ne", 60, 2, JimExprOpStrBin }, + [JIM_EXPROP_STRIN] = {"in", 55, 2, JimExprOpStrBin }, + [JIM_EXPROP_STRNI] = {"ni", 55, 2, JimExprOpStrBin }, + [JIM_EXPROP_BITAND] = {"&", 50, 2, JimExprOpIntBin }, [JIM_EXPROP_BITXOR] = {"^", 49, 2, JimExprOpIntBin }, [JIM_EXPROP_BITOR] = {"|", 48, 2, JimExprOpIntBin }, @@ -7182,7 +7209,8 @@ int SetExprFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr) int prevtt = parser.tt; if (JimParseExpression(&parser) != JIM_OK) { - Jim_SetResultString(interp, "Syntax error in expression", -1); + Jim_SetResultString(interp, "Syntax error in expression: ", -1); + Jim_AppendStrings(interp, Jim_GetResult(interp), exprText, NULL); goto err; } token = JimParserGetToken(&parser, &len, &type, NULL); @@ -9996,6 +10024,31 @@ err: return JIM_ERR; } + +/* Returns 1 if match, 0 if no match or -<error> on error (e.g. -JIM_ERR, -JIM_BREAK)*/ +int Jim_CommandMatchObj(Jim_Interp *interp, Jim_Obj *commandObj, Jim_Obj *patternObj, Jim_Obj *stringObj, int nocase) +{ + Jim_Obj *parms[4]; + int argc = 0; + long eq; + int rc; + + parms[argc++] = commandObj; + if (nocase) { + parms[argc++] = Jim_NewStringObj(interp, "-nocase", -1); + } + parms[argc++] = patternObj; + parms[argc++] = stringObj; + + rc = Jim_EvalObjVector(interp, argc, parms); + + if (rc != JIM_OK || Jim_GetLong(interp, Jim_GetResult(interp), &eq) != JIM_OK) { + eq = -rc; + } + + return eq; +} + enum {SWITCH_EXACT, SWITCH_GLOB, SWITCH_RE, SWITCH_CMD, SWITCH_UNKNOWN}; /* [switch] */ @@ -10051,9 +10104,7 @@ static int Jim_SwitchCoreCommand(Jim_Interp *interp, int argc, command = Jim_NewStringObj(interp, "regexp", -1); /* Fall thru intentionally */ case SWITCH_CMD: { - Jim_Obj *parms[] = {command, patObj, strObj}; - int rc = Jim_EvalObjVector(interp, 3, parms); - long matching; + int rc = Jim_CommandMatchObj(interp, command, patObj, strObj, 0); /* After the execution of a command we need to * make sure to reconvert the object into a list * again. Only for the single-list style [switch]. */ @@ -10064,16 +10115,11 @@ static int Jim_SwitchCoreCommand(Jim_Interp *interp, int argc, caseList = vector; } /* command is here already decref'd */ - if (rc != JIM_OK) { - retcode = rc; - goto err; - } - rc = Jim_GetLong(interp, Jim_GetResult(interp), &matching); - if (rc != JIM_OK) { - retcode = rc; + if (rc < 0) { + retcode = -rc; goto err; } - if (matching) + if (rc) script = caseList[i+1]; break; } @@ -10172,6 +10218,136 @@ static int Jim_LlengthCoreCommand(Jim_Interp *interp, int argc, return JIM_OK; } +/* [lsearch] */ +static int Jim_LsearchCoreCommand(Jim_Interp *interp, int argc, + Jim_Obj *const *argv) +{ + static const char *options[] = { + "-bool", "-not", "-nocase", "-exact", "-glob", "-regexp", "-all", "-inline", NULL + }; + enum {OPT_BOOL, OPT_NOT, OPT_NOCASE, OPT_EXACT, OPT_GLOB, OPT_REGEXP, OPT_ALL, OPT_INLINE, OPT_INTEGER}; + int i; + int opt_bool = 0; + int opt_not = 0; + int opt_nocase = 0; + int opt_all = 0; + int opt_inline = 0; + int opt_match = OPT_EXACT; + int listlen; + int rc = JIM_OK; + Jim_Obj *listObjPtr = NULL; + Jim_Obj *regexpCommandObj = NULL; + + if (argc < 3) { + Jim_WrongNumArgs(interp, 1, argv, "?-exact|-glob|-regexp? ?-bool|-inline? ?-not? ?-nocase? ?-all? list value"); + return JIM_ERR; + } + + for (i = 1; i < argc - 2; i++) { + int option; + + if (Jim_GetEnum(interp, argv[i], options, &option, "option", JIM_ERRMSG) != JIM_OK) { + return JIM_ERR; + } + switch(option) { + case OPT_BOOL: opt_bool = 1; opt_inline = 0; break; + case OPT_NOT: opt_not = 1; break; + case OPT_NOCASE: opt_nocase = 1; break; + case OPT_INLINE: opt_inline = 1; opt_bool = 0; break; + case OPT_ALL: opt_all = 1; break; + case OPT_EXACT: + case OPT_GLOB: + case OPT_REGEXP: + opt_match = option; + break; + } + } + + argv += i; + + if (opt_all) { + listObjPtr = Jim_NewListObj(interp, NULL, 0); + } + if (opt_match == OPT_REGEXP) { + regexpCommandObj = Jim_NewStringObj(interp, "regexp", -1); + Jim_IncrRefCount(regexpCommandObj); + } + + Jim_ListLength(interp, argv[0], &listlen); + for (i = 0; i < listlen; i++) { + Jim_Obj *objPtr; + Jim_ListIndex(interp, argv[0], i, &objPtr, JIM_NONE); + int eq = 0; + switch (opt_match) { + case OPT_EXACT: + eq = Jim_StringEqObj(objPtr, argv[1], opt_nocase); + break; + + case OPT_GLOB: + eq = Jim_StringMatchObj(argv[1], objPtr, opt_nocase); + break; + + case OPT_REGEXP: + eq = Jim_CommandMatchObj(interp, regexpCommandObj, argv[1], objPtr, opt_nocase); + if (eq < 0) { + if (listObjPtr) { + Jim_FreeNewObj(interp, listObjPtr); + } + rc = JIM_ERR; + goto done; + } + break; + } + + /* If we have a non-match with opt_bool, opt_not, !opt_all, can't exit early */ + if (!eq && opt_bool && opt_not && !opt_all) { + continue; + } + + if ((!opt_bool && eq == !opt_not) || (opt_bool && (eq || opt_all))) { + /* Got a match (or non-match for opt_not), or (opt_bool && opt_all) */ + Jim_Obj *resultObj; + + if (opt_bool) { + resultObj = Jim_NewIntObj(interp, eq ^ opt_not); + } + else if (!opt_inline) { + resultObj = Jim_NewIntObj(interp, i); + } + else { + resultObj = objPtr; + } + + if (opt_all) { + Jim_ListAppendElement(interp, listObjPtr, resultObj); + } + else { + Jim_SetResult(interp, resultObj); + goto done; + } + } + } + + if (opt_all) { + Jim_SetResult(interp, listObjPtr); + } + else { + /* No match */ + if (opt_bool) { + Jim_SetResultInt(interp, opt_not); + } + else if (!opt_inline) { + Jim_SetResultInt(interp, -1); + } + } + +done: + if (regexpCommandObj) { + Jim_DecrRefCount(interp, regexpCommandObj); + } + return rc; +} + /* [lappend] */ static int Jim_LappendCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) @@ -12042,6 +12218,7 @@ static const struct { {"list", Jim_ListCoreCommand}, {"lindex", Jim_LindexCoreCommand}, {"lset", Jim_LsetCoreCommand}, + {"lsearch", Jim_LsearchCoreCommand}, {"llength", Jim_LlengthCoreCommand}, {"lappend", Jim_LappendCoreCommand}, {"linsert", Jim_LinsertCoreCommand}, @@ -8,18 +8,6 @@ package provide tcl6 1.0 # Set up the ::env array set env [env] -# Very basic lsearch -exact with no options -proc lsearch {list value} { - set i 0 - foreach elem $list { - if {$elem eq $value} { - return $i - } - incr i - } - return -1 -} - # Tcl 8.5 lassign proc lassign {list args} { uplevel 1 [list foreach $args [concat $list {}] break] diff --git a/tests/expand.test b/tests/expand.test new file mode 100644 index 0000000..1527cd9 --- /dev/null +++ b/tests/expand.test @@ -0,0 +1,29 @@ +source testing.tcl + +section "Expand Testing" + +test expand-1.1 "Basic tests" { + set a {1 2 3} + set b {4 5 6} + lappend a {*}$b +} {1 2 3 4 5 6} + +test expand-1.2 "Basic tests" { + set a {1 2 3} + set b {4 5 6} + lappend a {expand}$b +} {1 2 3 4 5 6} + +test expand-1.3 "Basic tests" { + set a {1 2 3} + set b {4 5 6} + lappend a *$b +} {1 2 3 {*4 5 6}} + +test expand-1.4 "Basic tests" { + set a {1 2 3} + set b {4 5 6} + lappend a expand$b +} {1 2 3 {expand4 5 6}} + +testreport diff --git a/tests/expr.test b/tests/expr.test index b15ee36..d7c7b5e 100644 --- a/tests/expr.test +++ b/tests/expr.test @@ -86,19 +86,48 @@ test expr-1.17 "Rotate left" { # This crashes older jim test expr-2.1 "bogus unarymin" { - expr {unarymin 1} -} {-1} + catch {expr {unarymin 1}} + return 1 +} {1} test expr-2.2 "Ternary operator - missing colon" { - list [catch {expr {1 ? 2 3}} msg] $msg -} {1 {Invalid expression: 1 ? 2 3}} + list [catch {expr {1 ? 2 3}} msg] +} {1} test expr-2.3 "Ternary operator - missing third term" { - list [catch {expr {1 ? 2}} msg] $msg -} {1 {Invalid expression: 1 ? 2}} + list [catch {expr {1 ? 2}} msg] +} {1} test expr-2.4 "Ternary operator - missing question" { - list [catch {expr {1 : 2}} msg] $msg -} {1 {Invalid expression: 1 : 2}} + list [catch {expr {1 : 2}} msg] +} {1} + +test expr-3.1 "in, ni operators" { + set l {a b c d} + set c C + list [expr {"a" in $l}] [expr {$c in $l}] [expr {"b" ni $l}] [expr {$c ni $l}] +} {1 0 0 1} + +test expr-3.2 "if: in, ni operators" { + set l {a b c d} + set a a + set c C + set result {} + if {$a in $l} { + lappend result 1 + } + if {$c in $l} { + lappend result 2 + } + if {$a ni $l} { + lappend result 3 + } + if {$c ni $l} { + lappend result 4 + } + if {"d" in $l} { + lappend result 5 + } +} {1 4 5} testreport diff --git a/tests/lsearch.test b/tests/lsearch.test new file mode 100644 index 0000000..d1453b6 --- /dev/null +++ b/tests/lsearch.test @@ -0,0 +1,179 @@ +# Commands covered: lsearch +# +# This file contains a collection of tests for one or more of the Tcl +# built-in commands. Sourcing this file into Tcl runs the tests and +# generates output for errors. No output means no errors were found. +# +# Copyright (c) 1991-1993 The Regents of the University of California. +# Copyright (c) 1994 Sun Microsystems, Inc. +# Copyright (c) 1998-1999 by Scriptics Corporation. +# +# See the file "license.terms" for information on usage and redistribution +# of this file, and for a DISCLAIMER OF ALL WARRANTIES. +# +# RCS: @(#) $Id: lsearch.test,v 1.5 2000/04/10 17:19:01 ericm Exp $ + +source testing.tcl + +set x {abcd bbcd 123 234 345} +test lsearch-1.1 {lsearch command} { + lsearch $x 123 +} 2 +test lsearch-1.2 {lsearch command} { + lsearch $x 3456 +} -1 +test lsearch-1.3 {lsearch command} { + lsearch -glob $x *5 +} 4 +test lsearch-1.4 {lsearch command} { + lsearch -glob $x *bc* +} 0 + +test lsearch-2.1 {search modes} { + lsearch -exact {xyz bbcc *bc*} *bc* +} 2 +test lsearch-2.2 {search modes} { + lsearch -exact {b.x ^bc xy bcx} ^bc +} 1 +test lsearch-2.3 {search modes} { + lsearch -exact {foo bar cat} ba +} -1 +test lsearch-2.4 {search modes} { + lsearch -exact {foo bar cat} bart +} -1 +test lsearch-2.5 {search modes} { + lsearch -exact {foo bar cat} bar +} 1 +test lsearch-2.6 {search modes} { + list [catch {lsearch -regexp {xyz bbcc *bc*} *bc*} msg] +} {1} +test lsearch-2.7 {search modes} { + lsearch -regexp {b.x ^bc xy bcx} ^bc +} 3 +test lsearch-2.8 {search modes} { + lsearch -glob {xyz bbcc *bc*} *bc* +} 1 +test lsearch-2.9 {search modes} { + lsearch -glob {b.x ^bc xy bcx} ^bc +} 1 +test lsearch-2.10 {search modes} { + list [catch {lsearch -glib {b.x bx xy bcx} b.x} msg] +} {1} +test lsearch-2.7 {search modes, -nocase} { + lsearch -nocase -regexp {b.x ^bc xy bcx} ^BC +} 3 +test lsearch-2.8 {search modes, -nocase} { + lsearch -nocase -exact {b.x ^bc xy bcx} ^BC +} 1 +test lsearch-2.9 {search modes, -nocase} { + lsearch -nocase -glob {b.x ^bc xy bcx} B* +} 0 + +test lsearch-3.1 {lsearch errors} { + list [catch lsearch msg] +} {1} +test lsearch-3.2 {lsearch errors} { + list [catch {lsearch a} msg] +} {1} +test lsearch-3.3 {lsearch errors} { + list [catch {lsearch a b c} msg] +} {1} +test lsearch-3.4 {lsearch errors} { + list [catch {lsearch a b c d} msg] +} {1} + +test lsearch-4.1 {binary data} { + lsearch -exact [list foo one\000two bar] bar +} 2 +test lsearch-4.2 {binary data} { + set x one + append x \x00 + append x two + lsearch -exact [list foo one\000two bar] $x +} 1 + +test lsearch-5.1 {lsearch -all} { + lsearch -glob -all {a1 a2 b1 b2 a3 b3} a* +} {0 1 4} + +test lsearch-5.2 {lsearch -all no match} { + lsearch -glob -all {a1 a2 b1 b2 a3 b3} B* +} {} + +test lsearch-5.3 {lsearch -all -nocase} { + lsearch -glob -all -nocase {a1 a2 b1 b2 a3 b3} B* +} {2 3 5} + +test lsearch-5.4 {lsearch -all -inline} { + lsearch -glob -all -inline -nocase {a1 a2 b1 b2 a3 b3} A* +} {a1 a2 a3} + +test lsearch-5.5 {lsearch -inline} { + lsearch -glob -inline {a1 a2 b1 b2 a3 b3} b* +} {b1} + +test lsearch-5.6 {lsearch -not -all} { + lsearch -not -glob -all {a1 a2 b1 b2 a3 b3} a* +} {2 3 5} + +test lsearch-5.7 {lsearch -not -all no match} { + lsearch -not -glob -all {a1 a2 b1 b2 a3 b3} B* +} {0 1 2 3 4 5} + +test lsearch-5.8 {lsearch -not -all -nocase} { + lsearch -not -glob -all -nocase {a1 a2 b1 b2 a3 b3} B* +} {0 1 4} + +test lsearch-5.9 {lsearch -not -all -inline} { + lsearch -not -glob -all -inline -nocase {a1 a2 b1 b2 a3 b3} A* +} {b1 b2 b3} + +test lsearch-5.10 {lsearch -not -inline} { + lsearch -not -glob -inline {a1 a2 b1 b2 a3 b3} b* +} {a1} + +test lsearch-5.11 {lsearch -inline, no match} { + lsearch -glob -inline {a1 a2 b1 b2 a3 b3} C* +} {} + +test lsearch-6.1 {lsearch -bool, found} { + lsearch -bool {a1 a2 b1 b2 a3 b3} b1 +} {1} + +test lsearch-6.2 {lsearch -bool, not found} { + lsearch -bool {a1 a2 b1 b2 a3 b3} c1 +} {0} + +test lsearch-6.3 {lsearch -not -bool, found} { + lsearch -not -bool {a1 a2 b1 b2 a3 b3} b1 +} {0} + +test lsearch-6.4 {lsearch -not -bool, not found} { + lsearch -not -bool {a1 a2 b1 b2 a3 b3} c1 +} {1} + +test lsearch-6.5 {lsearch -bool -all} { + lsearch -bool -glob -all {a1 a2 b1 b2 a3 b3} a* +} {1 1 0 0 1 0} + +test lsearch-6.6 {lsearch -bool -all no match} { + lsearch -bool -glob -all {a1 a2 b1 b2 a3 b3} B* +} {0 0 0 0 0 0} + +test lsearch-6.7 {lsearch -bool -all -nocase} { + lsearch -bool -glob -all -nocase {a1 a2 b1 b2 a3 b3} B* +} {0 0 1 1 0 1} + +test lsearch-6.8 {lsearch -not -bool -all} { + lsearch -not -bool -glob -all {a1 a2 b1 b2 a3 b3} a* +} {0 0 1 1 0 1} + +test lsearch-6.9 {lsearch -not -bool -all no match} { + lsearch -not -bool -glob -all {a1 a2 b1 b2 a3 b3} B* +} {1 1 1 1 1 1} + +test lsearch-6.10 {lsearch -not -bool -all -nocase} { + lsearch -not -bool -glob -all -nocase {a1 a2 b1 b2 a3 b3} B* +} {1 1 0 0 1 0} + +testreport |