aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--BUGS3
-rw-r--r--Makefile.in6
-rw-r--r--TODO19
-rwxr-xr-xconfigure20
-rw-r--r--configure.ac16
-rw-r--r--doc/jim_tcl.txt361
-rw-r--r--glob.tcl78
-rw-r--r--jim-array.c31
-rw-r--r--jim-interactive.c3
-rw-r--r--jim-package.c2
-rw-r--r--jim-subcmd.c33
-rw-r--r--jim.c898
-rw-r--r--jim.h15
-rw-r--r--jimsh.c24
-rw-r--r--make-c-ext.sh7
-rw-r--r--test.tcl100
-rw-r--r--tests/Makefile3
-rw-r--r--tests/array.test7
-rw-r--r--tests/break.tcl1
-rw-r--r--tests/error.test2
-rw-r--r--tests/misc.test79
-rw-r--r--tests/return-break.tcl1
-rw-r--r--tests/return.test16
-rw-r--r--tests/string.test651
-rw-r--r--tests/testing.tcl18
25 files changed, 1692 insertions, 702 deletions
diff --git a/BUGS b/BUGS
index 927770d..b515fa5 100644
--- a/BUGS
+++ b/BUGS
@@ -6,6 +6,3 @@ expr
right-to-left associativity of ?: is not 100% correct.
1?2:0?3:4 should be 2, not 3.
-
-Math functions like sin(), cos(), are not implemented
-to avoid requiring libm. Could be a configuration option.
diff --git a/Makefile.in b/Makefile.in
index f82ee4b..3964452 100644
--- a/Makefile.in
+++ b/Makefile.in
@@ -1,4 +1,5 @@
RANLIB ?= ranlib
+SIZE ?= size
# Configuration
@@ -13,7 +14,7 @@ EXTENSIONS := @JIM_EXTENSIONS@
# Set an initial, default library and auto_path
CFLAGS += -DTCL_LIBRARY=\"/lib/tcl6\"
-CFLAGS += -DJIM_TCL_COMPAT
+CFLAGS += -DJIM_TCL_COMPAT -DJIM_REFERENCES
CFLAGS += -Wall -g -Os $(OPTIM) -I@SRCDIR@ @EXTRA_CFLAGS@
VPATH := @SRCDIR@
@@ -54,7 +55,8 @@ all: $(TARGETS)
if [ -d doc ]; then $(MAKE) -C doc all; fi
jimsh: $(LIBJIM) jimsh.o
- $(CC) $(LDFLAGS) -o $@ jimsh.o $(LIBJIM) $(LDLIBS) $(LIBDL)
+ $(CC) $(LDFLAGS) -o $@ jimsh.o $(LIBJIM) $(LDLIBS) @LIBDL@ -lm
+ $(SIZE) $@
ifeq ($(jim_libtype),static)
$(LIBJIM): $(OBJS) $(EXTENSIONS_OBJS)
diff --git a/TODO b/TODO
index 853ad96..e2ef146 100644
--- a/TODO
+++ b/TODO
@@ -2,8 +2,6 @@ CORE LANGUAGE FEATURES
CORE COMMANDS
-- All the missing standard core commands not related to I/O, namespaces, ...
-- More math functions in expr?
- [onleave] command, executing something as soon as the current procedure
returns. With no arguments it returns the script set, with one appends
the onleave script. There should be a way to reset.
@@ -26,28 +24,33 @@ SPEED OPTIMIZATIONS
- Find a way to avoid interpolation/reparsing in "foo($bar)" tokens.
See the "sieve" and "ary" bench performances, result of this problem.
(to compare with sieve_dict is also useful.)
+
+ * This is difficult considering the way tokens are parsed
+
- Experiment with better ways to do literal sharing.
+
+ * Currently literal sharing is completely removed. Can it be made
+ efficient? What is the cost vs. benefit?
+
- Organize the 'script' object so that a single data structure is
used for a full command, and interpolation is done using an
'interpolation token type' like JIM_TT_VAR and so on.
This way there is no need to run the array of integer objects
with the command structure. Also should help for better cache usage.
-- Generate .c from Jim programs, as calls to the Jim API to avoid
- the performance penality of Jim_EvalObj() overhead. In the future
- try to generate the calls like a JIT emitting assembler from
- Jim directly.
IMPLEMENTATION ISSUES
- Objects lazy free.
+
- Rewrite all the commands accepting a set of options to use Jim_GetEnum().
+
- Every time an extension is loaded Jim should put the dlopen() (or win32
equivalent) handle in a list inside the interpreter structure. When
the interpreter is freed all this handles should be closed with dlclose().
+
- *AssocData() function should allow to specify a delProc C function like
- in the Tcl API. When the interpreter is destroied all the delProc functions
+ in the Tcl API. When the interpreter is destroyed all the delProc functions
should be called to free the memory before to free the interpreter.
-- Convert dicts from lists directly without to pass from the string repr.
REFERENCES SYSTEM
diff --git a/configure b/configure
index 8196147..d0ae17f 100755
--- a/configure
+++ b/configure
@@ -621,6 +621,7 @@ ac_subst_files=''
ac_user_opts='
enable_option_checking
enable_fork
+enable_math
with_jim_ext
with_jim_shared
'
@@ -1246,13 +1247,14 @@ Optional Features:
--disable-option-checking ignore unrecognized --enable/--with options
--disable-FEATURE do not include FEATURE (same as --enable-FEATURE=no)
--enable-FEATURE[=ARG] include FEATURE [ARG=yes]
- --disable-fork Do not use fork (no exec, etc.)
+ --disable-fork do not use fork (no exec, etc.)
+ --enable-math include support for math functions
Optional Packages:
--with-PACKAGE[=ARG] use PACKAGE [ARG=yes]
--without-PACKAGE do not use PACKAGE (same as --with-PACKAGE=no)
- --with-jim-ext Specify jim extensions to build (or all, which is the default)
- --with-jim-shared Build a shared library instead of a static library
+ --with-jim-ext specify jim extensions to build (or all, which is the default)
+ --with-jim-shared build a shared library instead of a static library
Some influential environment variables:
CC C compiler command
@@ -2766,8 +2768,18 @@ fi
JIM_NOFORK=$JIM_NOFORK
+# Check whether --enable-math was given.
+if test "${enable_math+set}" = set; then :
+ enableval=$enable_math;
+ if test "x$enableval" = "xyes" ; then
+ EXTRA_CFLAGS="$EXTRA_CFLAGS -DJIM_MATH_FUNCTIONS"
+ fi
+
+
+fi
+
-jim_extensions="package readdir glob array clock exec file posix regexp signal tclcompat aio bio eventloop syslog"
+jim_extensions="load package readdir glob array clock exec file posix regexp signal tclcompat aio bio eventloop syslog"
# Check whether --with-jim-ext was given.
if test "${with_jim_ext+set}" = set; then :
diff --git a/configure.ac b/configure.ac
index 8960438..bb2d251 100644
--- a/configure.ac
+++ b/configure.ac
@@ -20,7 +20,7 @@ case $host in
esac
AC_ARG_ENABLE(fork,
- [ --disable-fork Do not use fork (no exec, etc.)],
+ [ --disable-fork do not use fork (no exec, etc.)],
[
if test "x$enableval" = "xno" ; then
AC_MSG_RESULT(* disabling fork)
@@ -29,10 +29,18 @@ AC_ARG_ENABLE(fork,
],
)
AC_SUBST(JIM_NOFORK,$JIM_NOFORK)
+AC_ARG_ENABLE(math,
+ [ --enable-math include support for math functions],
+ [
+ if test "x$enableval" = "xyes" ; then
+ EXTRA_CFLAGS="$EXTRA_CFLAGS -DJIM_MATH_FUNCTIONS"
+ fi
+ ]
+)
-jim_extensions="package readdir glob array clock exec file posix regexp signal tclcompat aio bio eventloop syslog"
+jim_extensions="load package readdir glob array clock exec file posix regexp signal tclcompat aio bio eventloop syslog"
AC_ARG_WITH(jim-ext,
- [ --with-jim-ext Specify jim extensions to build (or all, which is the default)],
+ [ --with-jim-ext specify jim extensions to build (or all, which is the default)],
[
if test "x$withval" != "xno" ; then
if test "x$withval" != "xall" ; then
@@ -50,7 +58,7 @@ done
JIM_LIBTYPE=static
AC_ARG_WITH(jim-shared,
- [ --with-jim-shared Build a shared library instead of a static library],
+ [ --with-jim-shared build a shared library instead of a static library],
[
if test "x$withval" = "xyes" ; then
JIM_LIBTYPE=shared
diff --git a/doc/jim_tcl.txt b/doc/jim_tcl.txt
index e39f9db..0a03234 100644
--- a/doc/jim_tcl.txt
+++ b/doc/jim_tcl.txt
@@ -39,17 +39,17 @@ The major differences are:
2. I/O: Support for sockets (client and server)
3. I/O: Support for readable/writable event handlers
4. Integers are 64bit
-5. Support for references (ref/getref/setref) and garbage collection
-6. Builtin dictionary type (dict)
-7. file mkdir, file rename, file tempfile (Tcl 7.x, 8.x)
-8. env command to access environment variables
-9. List: lmap, lset, lreverse, lassign (Tcl 8.x)
-10. os.fork, os.wait, rand
-11. \{*\}/\{expand\}
-12. string map (Tcl 7.x)
-13. subst (Tcl 7.x)
-14. switch (Tcl 7.x) (note that case is provided for compatibility)
-15. Must better error reporting. info stacktrace as a replacement for errorInfo, errorCode
+5. Support for references ('ref'/'getref'/'setref') and garbage collection
+6. Builtin dictionary type ('dict')
+7. 'file mkdir', 'file rename', 'file tempfile' (Tcl 7.x, 8.x)
+8. 'env' command to access environment variables
+9. List: 'lmap', 'lset', 'lreverse', 'lassign' (Tcl 8.x)
+10. 'os.fork', 'os.wait', 'rand'
+11. '\{*\}'/'\{expand\}'
+12. 'string map' (Tcl 7.x)
+13. 'subst' (Tcl 7.x)
+14. 'switch' (Tcl 7.x) (note that 'case' is provided for compatibility)
+15. Must better error reporting. 'info stacktrace' as a replacement for 'errorInfo', 'errorCode'
16. Support for "static" variables in procedures
17. Significantly faster for many scripts/operations
18. Command pipelines via open "|..." are not supported (but see 'exec' and 'socket pipe')
@@ -59,6 +59,7 @@ The major differences are:
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.
@@ -489,6 +490,30 @@ most common cases. To produce particularly complicated arguments
it is probably easiest to use the 'format' command along with
command substitution.
+STRING AND LIST INDEX SPECIFICATIONS
+------------------------------------
+
+Many string and list commands take one or more 'index' parameters which
+specify a position in the string relative to the start or end of the string/list.
+
+The index may be one of the following forms:
+
+`integer`::
+ A simple integer, where '0' refers to the first element of the string
+ or list.
+
+`integer+integer` or::
+`integer-integer`::
+ The sum or difference of the two integers. e.g. +2+3+ refers to the 5th element.
+ This is useful when used with (e.g.) +$i+1+ rather than the more verbose
+ +[expr {$i+1\}]+
+
+`end`::
+ The last element of the string or list.
+
+`end-integer`::
+ The 'nth-from-last' element of the string or list.
+
COMMAND SUMMARY
---------------
1. A command is just a string.
@@ -615,13 +640,18 @@ of precedence:
round() converts the numeric argument to the closest integer value.
abs() takes the absolute value of the numeric argument.
+`sin() cos() tan() asin() acos() atan() sinh() cosh() tanh() ceil() floor() exp() log() log10() sqrt()`::
+ Unary math functions.
+ If Jim is compiled with math support, these functions are available.
+
`- + ~ !`::
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(). Integers only.
+ Power. e.g. pow(). If Jim is compiled with math support, supports doubles and
+ integers. Otherwise supports integers only.
`* / %`::
Multiply, divide, remainder. None of these operands may be
@@ -651,7 +681,7 @@ of precedence:
attempting to convert to a number first.
`in ni`::
- String in list and not in list. For 'in', result is 1 the left operand (as a string)
+ String in list and not in list. For 'in', result is 1 if 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)}'.
@@ -862,41 +892,41 @@ code indicates whether the command completed successfully or not,
and the string gives additional information. The valid codes are
defined in jim.h, and are:
-JIM_OK::
++JIM_OK(0)+::
This is the normal return code, and indicates that the command completed
successfully. The string gives the command's return value.
-JIM_ERROR::
++JIM_ERR(1)+::
Indicates that an error occurred; the string gives a message describing
the error.
-JIM_RETURN::
++JIM_RETURN(2)+::
Indicates that the 'return' command has been invoked, and that the
current procedure (or top-level command or 'source' command)
should return immediately. The
string gives the return value for the procedure or command.
-JIM_BREAK::
++JIM_BREAK(3)+::
Indicates that the 'break' command has been invoked, so the
innermost loop should abort immediately. The string should always
be empty.
-JIM_CONTINUE::
++JIM_CONTINUE(4)+::
Indicates that the 'continue' command has been invoked, so the
innermost loop should go on to the next iteration. The string
should always be empty.
-JIM_EXIT::
- Indicates that the command called the 'exit' command.
- The string contains the exit code.
-
-JIM_SIGNAL::
++JIM_SIGNAL(5)+::
Indicates that a signal was caught while executing a commands.
The string contains the name of the signal caught.
See the 'signal' and 'catch' commands.
++JIM_EXIT(6)+::
+ Indicates that the command called the 'exit' command.
+ The string contains the exit code.
+
Tcl programmers do not normally need to think about return codes,
-since JIM_OK is almost always returned. If anything else is returned
+since +JIM_OK+ is almost always returned. If anything else is returned
by a command, then the Tcl interpreter immediately stops processing
commands and returns to its caller. If there are several nested
invocations of the Tcl interpreter in progress, then each nested
@@ -906,10 +936,10 @@ application will then display the error message for the user.
In a few cases, some commands will handle certain 'error' conditions
themselves and not return them upwards. For example, the 'for'
-command checks for the JIM_BREAK code; if it occurs, then 'for'
-stops executing the body of the loop and returns JIM_OK to its
-caller. The 'for' command also handles JIM_CONTINUE codes and the
-procedure interpreter handles JIM_RETURN codes. The 'catch'
+command checks for the +JIM_BREAK+ code; if it occurs, then 'for'
+stops executing the body of the loop and returns +JIM_OK+ to its
+caller. The 'for' command also handles +JIM_CONTINUE+ codes and the
+procedure interpreter handles +JIM_RETURN+ codes. The 'catch'
command allows Tcl programs to catch errors and handle them without
aborting command interpretation any further.
@@ -1220,12 +1250,12 @@ as though the array exists but is empty.
The *option* argument determines what action is carried out by the
command. The legal *options* (which may be abbreviated) are:
-+array exists arrayName+::
++*array exists* 'arrayName'+::
Returns 1 if arrayName is an array variable, 0 if there is
no variable by that name. This command is essentially
identical to 'info exists'
-+array get arrayName ?pattern?+::
++*array get* 'arrayName ?pattern?'+::
Returns a list containing pairs of elements. The first
element in each pair is the name of an element in arrayName
and the second element of each pair is the value of the
@@ -1237,7 +1267,7 @@ command. The legal *options* (which may be abbreviated) are:
isn't the name of an array variable, or if the array contains
no elements, then an empty list is returned.
-+array names arrayName ?pattern?+::
++*array names* 'arrayName ?pattern?'+::
Returns a list containing the names of all of the elements
in the array that match pattern. If pattern is omitted then
the command returns all of the element names in the array.
@@ -1247,7 +1277,7 @@ command. The legal *options* (which may be abbreviated) are:
in the array, or if arrayName isn't the name of an array
variable, then an empty string is returned.
-+array set arrayName list+::
++*array set* 'arrayName list'+::
Sets the values of one or more elements in arrayName. list
must have a form like that returned by array get, consisting
of an even number of elements. Each odd-numbered element
@@ -1257,11 +1287,11 @@ command. The legal *options* (which may be abbreviated) are:
already exist and list is empty, arrayName is created with
an empty array value.
-+array size arrayName+::
++*array size* 'arrayName'+::
Returns the number of elements in the array. If arrayName
isn't the name of an array then 0 is returned.
-+array unset arrayName ?pattern?+::
++*array unset* 'arrayName ?pattern?'+::
Unsets all of the elements in the array that match pattern
(using the matching rules of string match). If arrayName
isn't the name of an array variable or there are no matching
@@ -1275,7 +1305,7 @@ break
+*break*+
This command may be invoked only inside the body of a loop command
-such as 'for' or 'foreach' or 'while'. It returns a JIM_BREAK code
+such as 'for' or 'foreach' or 'while'. It returns a +JIM_BREAK+ code
to signal the innermost containing loop command to return immediately.
case
@@ -1349,13 +1379,13 @@ catch
The 'catch' command may be used to prevent errors from aborting
command interpretation. 'Catch' evalues *command*, and
-returns a JIM_OK code, regardless of any errors that might occur
-while executing *command* (with the possible exception of JIM_SIGNAL
+returns a +JIM_OK+ code, regardless of any errors that might occur
+while executing *command* (with the possible exception of +JIM_SIGNAL+
- see below).
The return value from 'catch' is a decimal string giving the code returned
by the Tcl interpreter after executing *command*. This will be '0'
-(JIM_OK) if there were no errors in *command*; otherwise it will have
+(+JIM_OK+) if there were no errors in *command*; otherwise it will have
a non-zero value corresponding to one of the exceptional return codes
(see jim.h for the definitions of code values).
@@ -1365,7 +1395,7 @@ If the *varName* argument is given, then it gives the name of a variable;
Normally 'catch' will *not* catch any signal. However if *-signal* is specified,
any signals marked as *handle* by 'signal' will be caught and 'catch' will return
-JIM_SIGNAL (5). In this case, the return values is the name of the signal caught.
++JIM_SIGNAL+ (5). In this case, the return values is the name of the signal caught.
cd
~~
@@ -1380,21 +1410,17 @@ be removed in some applications.
clock
~~~~~
-+*clock seconds*+
-
-Returns the current time as seconds since the epoch.
-
-+*clock format* 'seconds ?-format format?'*+
-
-Format the given time (seconds since the epoch) according to the given
-format. See strftime(3) for supported formats.
++*clock seconds*+::
+ Returns the current time as seconds since the epoch.
-If no format is supplied, "%c" is used.
++*clock format* 'seconds' ?*-format* 'format?'+::
+ Format the given time (seconds since the epoch) according to the given
+ format. See strftime(3) for supported formats.
+ If no format is supplied, "%c" is used.
-+*clock scan* 'str -format format'+
-
-Scan the given time string using the given format string.
-See strptime(3) for supported formats.
++*clock scan* 'str' *-format* 'format'+::
+ Scan the given time string using the given format string.
+ See strptime(3) for supported formats.
close
~~~~~
@@ -1428,7 +1454,7 @@ continue
+*continue*+
This command may be invoked only inside the body of a loop command such
-as 'for' or 'foreach' or 'while'. It returns a JIM_CONTINUE code to
+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.
@@ -1441,19 +1467,19 @@ 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 ...?'+::
+*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 ...?'+::
+*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 ...?'+::
+*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
@@ -1466,14 +1492,14 @@ command. The legal *options* are:
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+::
+*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+::
+*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
@@ -1513,7 +1539,7 @@ error
~~~~~
+*error* 'message ?stacktrace?'+
-Returns a JIM_ERROR code, which causes command interpretation to be
+Returns a +JIM_ERR+ code, which causes command interpretation to be
unwound. *message* is a string that is returned to the application
to indicate what went wrong.
@@ -1543,7 +1569,7 @@ Typical usage is:
exit 1
}
-See 'error' for typical usage.
+See also 'error'.
eval
~~~~
@@ -1859,27 +1885,27 @@ statements in C.
foreach
~~~~~~~
-+*foreach* 'varname list body'+
++*foreach* 'varName list body'+
-+*foreach* 'varlist list ?varlist2 list2 ...? body'+
++*foreach* 'varList list ?varList2 list2 ...? body'+
-In this command, *varname* is the name of a variable, *list*
-is a list of values to assign to *varname*, and *body* is a
+In this command, *varName* is the name of a variable, *list*
+is a list of values to assign to *varName*, and *body* is a
collection of Tcl commands.
For each field in *list* (in order from left to right),'foreach' assigns
-the contents of the field to *varname* (as if the 'lindex' command
+the contents of the field to *varName* (as if the 'lindex' command
had been used to extract the field), then calls the Tcl interpreter to
execute *body*.
-If instead of being a simple name, *varlist* is used, multiple assignments
-are made each time through the loop, one for each element of *varlist*.
+If instead of being a simple name, *varList* is used, multiple assignments
+are made each time through the loop, one for each element of *varList*.
-For example, if there are two elements in *varlist* and six elements in
+For example, if there are two elements in *varList* and six elements in
the list, the loop will be executed three times.
If the length of the list doesn't evenly divide by the number of elements
-in *varlist*, the value of the remaining variables in the last iteration
+in *varList*, the value of the remaining variables in the last iteration
of the loop are undefined.
The 'break' and 'continue' statements may be invoked inside *body*,
@@ -1961,13 +1987,13 @@ exactly: an abbreviation will not be accepted.
global
~~~~~~
-+*global* 'varname ?varname ...?'+
++*global* 'varName ?varName ...?'+
This command is ignored unless a Tcl procedure is being interpreted.
-If so, then it declares each given *varname* to be a global variable
+If so, then it declares each given *varName* to be a global variable
rather than a local one. For the duration of the current procedure
(and only while executing in the current procedure), any reference to
-*varname* will be bound to a global variable instead
+*varName* will be bound to a global variable instead
of a local one.
An alternative to using 'global' is to use the '::' prefix
@@ -1977,20 +2003,20 @@ if
~~
+*if* 'expr1' ?*then*? 'body1' *elseif* 'expr2' ?*then*? 'body2' *elseif* ... ?*else*? ?'bodyN'?+
-The *if* command evaluates *expr1* as an expression (in the same way
+The 'if' command evaluates *expr1* as an expression (in the same way
that 'expr' evaluates its argument). The value of the expression must
be numeric; if it is non-zero then *body1* is executed by passing it to
the Tcl interpreter.
Otherwise *expr2* is evaluated as an expression and if it is non-zero
-then 'body2' is executed, and so on.
+then *body2* is executed, and so on.
If none of the expressions evaluates to non-zero then *bodyN* is executed.
The 'then' and 'else' arguments are optional 'noise words' to make the
command easier to read.
-There may be any number of 'elseif' clauses, including zero. *BodyN*
+There may be any number of 'elseif' clauses, including zero. *bodyN*
may also be omitted as long as 'else' is omitted too.
The return value from the command is the result of the body script that
@@ -1999,7 +2025,7 @@ and there was no *bodyN*.
incr
~~~~
-+*incr* 'varName ?increment?'
++*incr* 'varName ?increment?'+
Increment the value stored in the variable whose name is *varName*.
The value of the variable must be integral.
@@ -2015,8 +2041,9 @@ info
~~~~
+*info* 'option ?arg arg ...?'+::
- Provide information about various internals to the Tcl interpreter.
- The legal **option**'s (which may be abbreviated) are:
+
+Provide information about various internals to the Tcl interpreter.
+The legal *option*'s (which may be abbreviated) are:
+*info args* 'procname'+::
Returns a list containing the names of the arguments to procedure
@@ -2094,7 +2121,7 @@ info
of the innermost file being processed. Otherwise the command returns an
empty string.
-+*info source 'script'*+::
++*info source* 'script'+::
Returns the original source location of the given script as a list of
+{filename linenumber}+. If the source location can't be determined, the
list +{{} 0}+ is returned.
@@ -2126,7 +2153,7 @@ The *joinString* argument defaults to a space character.
kill
~~~~
-+*kill* '?SIG|-0? pid'+
++*kill* ?'SIG'|*-0*? 'pid'+
Sends the given signal to the process identified by *pid*.
@@ -2182,10 +2209,9 @@ lindex
~~~~~~
+*lindex* 'list index'+
-Treats *list* as a Tcl list and returns element 'index' from it
-(0 refers to the first element of the list). *Index* may be 'end' or
-'end-<n>' (where '<n>' is an integer) to refer to the last element of
-the list or the 'nth-from-last' element of the list.
+Treats *list* as a Tcl list and returns element *index* from it
+(0 refers to the first element of the list).
+See STRING AND LIST INDEX SPECIFICATIONS for all allowed forms for *index*.
In extracting the element, *lindex* observes the same rules concerning
braces and quotes and backslashes as the Tcl command interpreter; however,
@@ -2207,7 +2233,7 @@ beginning of the list. If *index* is greater than or equal
to the number of elements in the list, then the new elements are
appended to the list.
-*index* may also be 'end' or 'end-<n>' -- see 'lindex'
+See STRING AND LIST INDEX SPECIFICATIONS for all allowed forms for *index*.
list
~~~~
@@ -2272,9 +2298,7 @@ the 'lset' command.
If index is negative or greater than or equal to the number of
elements in $varName, then an error occurs.
-If index has the value end, it refers to the last element in the
-list, and end-integer refers to the last element in the list minus
-the specified integer offset.
+See STRING AND LIST INDEX SPECIFICATIONS for all allowed forms for *index*.
If additional index arguments are supplied, then each argument is
used in turn to address an element within a sublist designated by
@@ -2294,9 +2318,9 @@ index is outside the permitted range, an error is reported.
lmap
~~~~
-+*lmap* 'varname list body'+
++*lmap* 'varName list body'+
-+*lmap* 'varlist list ?varlist2 list2 ...? body'+
++*lmap* 'varList list ?varList2 list2 ...? body'+
'lmap' is a "collecting 'foreach'" which returns a list of its results.
@@ -2307,6 +2331,9 @@ For example:
jim> lmap a {1 2 3} b {A B C} {list $a $b}
{1 A} {2 B} {3 C}
+If the body invokes 'continue', no value is added for this iteration.
+If the body invokes 'break', the loop ends and no more values are added.
+
lrange
~~~~~~
+*lrange* 'list first last'+
@@ -2315,7 +2342,7 @@ lrange
return a new list consisting of elements
*first* through *last*, inclusive.
-*first* or *last* may also be 'end' or 'end-<n>' -- see 'lindex'
+See STRING AND LIST INDEX SPECIFICATIONS for all allowed forms for *first* and *last*.
If *last* is greater than or equal to the number of elements
in the list, then it is treated as if it were 'end'.
@@ -2346,7 +2373,7 @@ must exist in the list.
*Last* gives the index in *list* of the last element
to be replaced; it must be greater than or equal to *first*.
-*first* or *last* may also be 'end' or 'end-<n>' -- see 'lindex'
+See STRING AND LIST INDEX SPECIFICATIONS for all allowed forms for *first* and *last*.
The *element* arguments specify zero or more new arguments to
be added to the list in place of those that were deleted.
@@ -2711,7 +2738,7 @@ 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
@@ -2771,7 +2798,7 @@ returns an empty string as result.
return
~~~~~~
-+*return* ?-code *code*? ?'value'?+
++*return* ?*-code* 'code'? ?'value'?+
Return immediately from the current procedure (or top-level command
or 'source' command), with *value* as the return value. If *value*
@@ -2779,23 +2806,23 @@ is not specified, an empty string will be returned as result.
If *code* is specified (as either a number or ok, error, break,
continue, signal, return or exit), this code will be used instead
-of JIM_OK. This is generally useful when implementing flow of control
+of +JIM_OK+. This is generally useful when implementing flow of control
commands.
scan
~~~~
-+*scan* 'string format varname1 ?varname2 ...?'+
++*scan* 'string format varName1 ?varName2 ...?'+
This command parses fields from an input string in the same fashion
as the C 'sscanf' procedure. *String* gives the input to be parsed
and *format* indicates how to parse it, using '%' fields as in
'sscanf'. All of the 'sscanf' options are valid; see the 'sscanf'
-man page for details. Each *varname* gives the name of a variable;
+man page for details. Each *varName* gives the name of a variable;
when a field is scanned from *string*, the result is converted back
-into a string and assigned to the corresponding *varname*. The
+into a string and assigned to the corresponding *varName*. The
only unusual conversion is for '%c'. For '%c' conversions a single
character value is converted to a decimal string, which is then
-assigned to the corresponding *varname*; no field width may be
+assigned to the corresponding *varName*; no field width may be
specified for this conversion.
seek
@@ -2835,11 +2862,11 @@ This command returns an empty string.
set
~~~
-+*set* 'varname ?value?'+
++*set* 'varName ?value?'+
-Returns the value of variable *varname*.
+Returns the value of variable *varName*.
-If *value* is specified, then set the value of *varname* to *value*,
+If *value* is specified, then set the value of *varName* to *value*,
creating a new variable if one doesn't already exist, and return
its value.
@@ -2849,12 +2876,12 @@ before the open parenthesis are the name of the array, and the characters
between the parentheses are the index within the array.
Otherwise *varName* refers to a scalar variable.
-If no procedure is active, then *varname* refers to a global
+If no procedure is active, then *varName* refers to a global
variable.
-If a procedure is active, then *varname* refers to a parameter
+If a procedure is active, then *varName* refers to a parameter
or local variable of the procedure, unless the *global* command
-has been invoked to declare *varname* to be global.
+has been invoked to declare *varName* to be global.
The '::' prefix may also be used to explicitly reference a variable
in the global scope.
@@ -2867,7 +2894,7 @@ Command for signal handling.
See 'kill' for the different forms which may be used to specify signals.
Commands which return a list of signal names do so using the canonical form:
-"SIGINT SIGTERM".
+"+SIGINT SIGTERM+".
+*signal handle* ?'signals ...'?+::
If no signals are given, returns a list of all signals which are currently
@@ -2888,7 +2915,7 @@ Commands which return a list of signal names do so using the canonical form:
the default behaviour.
+*signal throw* ?'signal'?+::
- Raises the given signal, which defaults to SIGINT if not specified.
+ Raises the given signal, which defaults to +SIGINT+ if not specified.
The behaviour is identical to:
kill signal [pid]
@@ -2952,21 +2979,25 @@ string
Perform one of several string operations, depending on *option*.
The legal options (which may be abbreviated) are:
-+*string compare* 'string1 string2'+::
++*string compare ?-nocase?* 'string1 string2'+::
Perform a character-by-character comparison of strings *string1* and
*string2* in the same way as the C 'strcmp' procedure. Return
-1, 0, or 1, depending on whether *string1* is lexicographically
less than, equal to, or greater than *string2*.
+ Performs a case-insensitive comparison if '-nocase' is specified.
+*string equal ?-nocase?* 'string1 string2'+::
Returns 1 if the strings are equal, or 0 otherwise.
Performs a case-insensitive comparison if '-nocase' is specified.
-+*string first* 'string1 string2'+::
++*string first* 'string1 string2 ?firstIndex?'+::
Search *string2* for a sequence of characters that exactly match
the characters in *string1*. If found, return the index of the
first character in the first such match within *string2*. If not
- found, return -1.
+ found, return -1. If *firstIndex* is specified, matching will start
+ from *firstIndex* of *string1*.
+ ::
+ See STRING AND LIST INDEX SPECIFICATIONS for all allowed forms for *firstIndex*.
+*string index* 'string charIndex'+::
Returns the *charIndex*'th character of the *string*
@@ -2975,17 +3006,22 @@ The legal options (which may be abbreviated) are:
If *charIndex* is less than 0 or greater than
or equal to the length of the string then an empty string is
returned.
+ ::
+ See STRING AND LIST INDEX SPECIFICATIONS for all allowed forms for *charIndex*.
-+*string last* 'string1 string2'+::
++*string last* 'string1 string2 ?lastIndex?'+::
Search *string2* for a sequence of characters that exactly match
the characters in *string1*. If found, return the index of the
first character in the last such match within *string2*. If there
- is no match, then return -1.
+ is no match, then return -1. If *lastIndex* is specified, only characters
+ up to *lastIndex* of *string2* will be considered in the match.
+ ::
+ See STRING AND LIST INDEX SPECIFICATIONS for all allowed forms for *lastIndex*.
+*string length* 'string'+::
Returns a decimal string giving the number of characters in *string*.
-+*string match* 'pattern string'+::
++*string match ?-nocase?* 'pattern string'+::
See if *pattern* matches *string*; return 1 if it does, 0
if it doesn't. Matching is done in a fashion similar to that
used by the C-shell. For the two strings to match, their contents
@@ -3007,16 +3043,19 @@ The legal options (which may be abbreviated) are:
+\x+;;
Matches the single character *x*. This provides a way of
- avoiding the special interpretation of the characters `\*?[]\`
+ avoiding the special interpretation of the characters \`\*?[]\`
in **pattern**.
+ ::
+ Performs a case-insensitive comparison if '-nocase' is specified.
+*string range* 'string first last'+::
Returns a range of consecutive characters from *string*, starting
with the character whose index is *first* and ending with the
character whose index is *last*. An index of 0 refers to the
- first character of the string. Either *first* or *last* may be 'end'
- or 'end-<n>' (where '<n>' is an integer) to refer to the last character of
- the string or the 'nth-from-last' character of the string.
+ first character of the string.
+ ::
+ See STRING AND LIST INDEX SPECIFICATIONS for all allowed forms for *first* and *last*.
+ ::
If *first* is less than zero then it is treated as if it were zero, and
if *last* is greater than or equal to the length of the string then
it is treated as if it were 'end'. If *first* is greater than
@@ -3025,6 +3064,10 @@ The legal options (which may be abbreviated) are:
+*string repeat* 'string count'+::
Returns a new string consisting of *string* repeated *count* times.
++*string reverse* 'string'+::
+ Returns a string that is the same length as *string* but
+ with its characters in the reverse order.
+
+*string tolower* 'string'+::
Returns a value equal to *string* except that all upper case
letters have been converted to lower case.
@@ -3056,7 +3099,7 @@ The legal options (which may be abbreviated) are:
subst
~~~~~
-+*subst* '?-nobackslashes? ?-nocommands? ?-novariables? string'+
++*subst ?-nobackslashes? ?-nocommands? ?-novariables?* 'string'+
This command performs variable substitutions, command substitutions,
and backslash substitutions on its string argument and returns the
@@ -3146,23 +3189,19 @@ Below are some examples of switch commands:
will return 2,
switch -regexp aaab {
- ^a.*b$ -
- b {format 1}
- a* {format 2}
- default {format 3}
+ ^a.*b$ -
+ b {format 1}
+ a* {format 2}
+ default {format 3}
}
will return 1, and
switch xyz {
- a
- -
- b
- {format 1}
- a*
- {format 2}
- default
- {format 3}
+ a -
+ b {format 1}
+ a* {format 2}
+ default {format 3}
}
will return 3.
@@ -3225,7 +3264,7 @@ the original non-existent command.
unset
~~~~~
-+*unset* '?-nocomplain? ?--? ?name name ...?'+
++*unset ?-nocomplain? ?--?* '?name name ...?'+
Remove variables.
Each *name* is a variable name, specified in any of the
@@ -3362,12 +3401,12 @@ from within Tcl. Note that since Jim supports binary strings, the
main use of this command is 'bio copy' to easily copy between file
descriptors.
-+*bio read* '?-hex? fd var numbytes'+::
++*bio read ?-hex?* 'fd var numbytes'+::
Read bytes from a file descriptor. By default the data is not encoded.
Using *-hex* encodes the data as ascii hex instead. Returns
the number of bytes actually read.
-+*bio write* '?-hex? fd buf'+::
++*bio write ?-hex?* 'fd buf'+::
Write a string to a file descriptor. If *-hex* is specified, the
string is expected to be in ascii hexx format. Returns the number
of bytes actually written.
@@ -3383,7 +3422,7 @@ posix: os.fork, os.wait, os.gethostname, os.getids, os.uptime
+*os.fork*+::
Invokes 'fork(2)' and returns the result.
-+*os.wait* -nohang 'pid'+::
++*os.wait -nohang* 'pid'+::
Invokes waitpid(2), with WNOHANG if *-nohang* is specified.
Returns a list of 3 elements.
@@ -3417,36 +3456,36 @@ See '<<_open,open>>' and '<<_socket,socket>>' for commands which return an I/O h
aio
~~~
-+*$handle read* '?-nonewline? ?len?'+::
++$handle *read ?-nonewline?* '?len?'+::
Read and return bytes from the stream. To eof if no len.
-+*$handle gets* '?var?'+::
++$handle *gets* '?var?'+::
Read one line and return it or store it in the var
-+*$handle puts* '?-nonewline? str'+::
++$handle *puts ?-nonewline?* 'str'+::
Write the string, with newline unless -nonewline
-+*$handle flush*+::
++$handle *flush*+::
Flush the stream
-+*$handle eof*+::
++$handle *eof*+::
Returns 1 if stream is at eof
-+*$handle close*+::
++$handle *close*+::
Closes the stream
-+*$handle seek* 'offset ?start|current|end'+::
++$handle *seek* 'offset' *?start|current|end?*+::
Seeks in the stream (default 'current')
-+*$handle tell*+::
++$handle *tell*+::
Returns the current seek position
-+*$handle ndelay* '?0|1?'+::
++$handle *ndelay ?0|1?*+::
Set O_NDELAY (if arg). Returns current/new setting.
Note that in general ANSI I/O interacts badly with non-blocking I/O.
Use with care.
-+*$handle accept*+::
++$handle *accept*+::
Server socket only: Accept a connection and return stream
eventloop: after, vwait
@@ -3454,13 +3493,13 @@ eventloop: after, vwait
The following commands allow a script to be invoked when the given condition occurs.
-+*$handle readable* '?readable-script ?eof-script??'+::
++$handle *readable* '?readable-script ?eof-script??'+::
Returns script, or invoke readable-script when readable, eof-script on eof, {} to remove
-+*$handle writable* '?writable-script?'+::
++$handle *writable* '?writable-script?'+::
Returns script, or invoke writable-script when writable, {} to remove
-+*$handle onexception* '?exception-script?'+::
++$handle *onexception* '?exception-script?'+::
Returns script, or invoke exception-script when oob data, {} to remove
Time-based execution is also available via the eventloop API.
@@ -3469,7 +3508,7 @@ Time-based execution is also available via the eventloop API.
The script is executed after the given number of milliseconds have elapsed.
Returns an event id.
-+*after* cancel 'id'+::
++*after cancel* 'id'+::
Cancels an after event with the given event id.
+*vwait* 'variable'+::
@@ -3480,22 +3519,22 @@ socket
~~~~~~
Various socket types may be created.
-+*socket* unix 'path'+::
++*socket unix* 'path'+::
A unix domain socket client.
-+*socket* unix.server 'path'+::
++*socket unix.server* 'path'+::
A unix domain socket server.
-+*socket* stream 'hostname:port'+::
++*socket stream* 'hostname:port'+::
A TCP socket client.
-+*socket* stream.server '?hostname:?port'+::
++*socket stream.server* '?hostname:?port'+::
A TCP socket server (*hostname* defaults to 0.0.0.0).
-+*socket* dgram 'hostname:port'+::
++*socket dgram* 'hostname:port'+::
A UDP socket client.
-+*socket* pipe+::
++*socket pipe*+::
A pipe. Note that unlike all other socket types, this command returns
a list of two channels: {read write}
@@ -3552,8 +3591,8 @@ argv0 is used as ident string. However, any of the following options
may be specified before priority to control these parameters:
+*-facility* 'value'+::
- Use specified facility instead of user. Following
- facility are recognized:
+ Use specified facility instead of user. The following
+ values for facility are recognized:
authpriv, cron, daemon, kernel, lpr, mail, news, syslog, user,
uucp, local0-local7
@@ -3574,28 +3613,28 @@ BUILT-IN VARIABLES
The following global variables are created automatically
by the Tcl library.
-+env+::
++*env*+::
This variable is set by Jim as an array
whose elements are the environment variables for the process.
Reading an element will return the value of the corresponding
environment variable.
This array is initialised at startup from the 'env' command.
-+auto_path+::
++*auto_path*+::
This variable contains a list of paths to search for packages.
It contains {. /lib/jim} by default.
The following global variables are set by jimsh.
-+tcl_interactive+::
++*tcl_interactive*+::
This variable is set to 1 if jimsh is started in interactive mode
or 0 otherwise.
-+argv0+::
++*argv0*+::
If jimsh is invoked to run a script, this variable contains the name
of the script.
-+argv+::
++*argv*+::
If jimsh is invoked to run a script, this variable contains a list
of any arguments supplied to the script.
diff --git a/glob.tcl b/glob.tcl
index 9eb37d0..64323fb 100644
--- a/glob.tcl
+++ b/glob.tcl
@@ -2,37 +2,9 @@
#
# Implements a Tcl-compatible glob command based on readdir
#
-# The FreeBSD license
-#
-# Redistribution and use in source and binary forms, with or without
-# modification, are permitted provided that the following conditions
-# are met:
-#
-# 1. Redistributions of source code must retain the above copyright
-# notice, this list of conditions and the following disclaimer.
-# 2. Redistributions in binary form must reproduce the above
-# copyright notice, this list of conditions and the following
-# disclaimer in the documentation and/or other materials
-# provided with the distribution.
-#
-# THIS SOFTWARE IS PROVIDED BY THE JIM TCL PROJECT ``AS IS'' AND ANY
-# EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
-# THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
-# PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
-# JIM TCL PROJECT OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,
-# INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
-# (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
-# OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
-# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
-# STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
-# ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
-# ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-#
-# The views and conclusions contained in the software and documentation
-# are those of the authors and should not be interpreted as representing
-# official policies, either expressed or implied, of the Jim Tcl Project.
-
-package provide glob
+# This file is licenced under the FreeBSD license
+# See LICENCE in this directory for full details.
+
# If $dir is a directory, return a list of all entries
# it contains which match $pattern
@@ -41,12 +13,17 @@ proc _glob_readdir_pattern {dir pattern} {
set result {}
# readdir doesn't return . or .., so simulate it here
- if {$pattern eq "." || $pattern eq ".."} {
+ if {$pattern in {. ..}} {
return $pattern
}
+
# Use -nocomplain here to return nothing if $dir is not a directory
foreach name [readdir -nocomplain $dir] {
if {[string match $pattern $name]} {
+ # Only include entries starting with . if the pattern starts with .
+ if {[string index $name 0] eq "." && [string index $pattern 0] ne "."} {
+ continue
+ }
lappend result $name
}
}
@@ -64,11 +41,8 @@ proc _glob_do {dir rem} {
set pattern $rem
set rempattern ""
} else {
- set j $i
- incr j
- incr i -1
- set pattern [string range $rem 0 $i]
- set rempattern [string range $rem $j end]
+ set pattern [string range $rem 0 $i-1]
+ set rempattern [string range $rem $i+1 end]
}
# Determine the appropriate separator and globbing dir
@@ -83,6 +57,22 @@ proc _glob_do {dir rem} {
set result {}
+ # If the pattern contains a braced expression, recursively call _glob_do
+ # to expand the alternations. Avoid regexp for dependency reasons.
+ # XXX: Doesn't handle backslashed braces
+ if {[set fb [string first "\{" $pattern]] >= 0} {
+ if {[set nb [string first "\}" $pattern $fb]] >= 0} {
+ set before [string range $pattern 0 $fb-1]
+ set braced [string range $pattern $fb+1 $nb-1]
+ set after [string range $pattern $nb+1 end]
+
+ foreach part [split $braced ,] {
+ lappend result {*}[_glob_do $dir $before$part$after]
+ }
+ return $result
+ }
+ }
+
# Use readdir and select all files which match the pattern
foreach f [_glob_readdir_pattern $globdir $pattern] {
if {$rempattern eq ""} {
@@ -90,7 +80,7 @@ proc _glob_do {dir rem} {
lappend result $dir$sep$f
} else {
# Expany any entries at this level and add them
- lappend result {expand}[_glob_do $dir$sep$f $rempattern]
+ lappend result {*}[_glob_do $dir$sep$f $rempattern]
}
}
return $result
@@ -100,11 +90,13 @@ proc _glob_do {dir rem} {
#
# Usage: glob ?-nocomplain? pattern ...
#
-# Patterns use string match pattern matching for each
-# directory level.
+# Patterns use 'string match' (glob) pattern matching for each
+# directory level, plus support for braced alternations.
#
-# e.g. glob te[a-e]*/*.tcl
+# e.g. glob "te[a-e]*/*.{c,tcl}"
#
+# Note: files starting with . will only be returned if matching component
+# of the pattern starts with .
proc glob {args} {
set nocomplain 0
@@ -118,9 +110,9 @@ proc glob {args} {
if {$pattern eq "/"} {
lappend result /
} elseif {[string match "/*" $pattern]} {
- lappend result {expand}[_glob_do / [string range $pattern 1 end]]
+ lappend result {*}[_glob_do / [string range $pattern 1 end]]
} else {
- lappend result {expand}[_glob_do "" $pattern]
+ lappend result {*}[_glob_do "" $pattern]
}
}
diff --git a/jim-array.c b/jim-array.c
index 903b157..ee61af4 100644
--- a/jim-array.c
+++ b/jim-array.c
@@ -66,6 +66,7 @@ static int array_cmd_get(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
{
int i;
int len;
+ int all = 0;
Jim_Obj *resultObj;
Jim_Obj *objPtr = Jim_GetVariable(interp, argv[0], JIM_NONE);
Jim_Obj *dictObj;
@@ -75,6 +76,17 @@ static int array_cmd_get(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
return JIM_OK;
}
+ if (argc == 1 || Jim_CompareStringImmediate(interp, argv[1], "*")) {
+ all = 1;
+ }
+
+ /* If it is a dictionary or list, nothing else to do */
+ if (all && (Jim_IsDict(objPtr) || Jim_IsList(objPtr))) {
+ /* XXX If it is a odd-length list no error will be returned */
+ Jim_SetResult(interp, objPtr);
+ return JIM_OK;
+ }
+
if (Jim_DictKeysVector(interp, objPtr, NULL, 0, &dictObj, JIM_ERRMSG) != JIM_OK) {
return JIM_ERR;
}
@@ -83,7 +95,7 @@ static int array_cmd_get(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
return JIM_ERR;
}
- if (argc == 1 || Jim_CompareStringImmediate(interp, argv[1], "*")) {
+ if (all) {
/* Return the whole array */
Jim_SetResult(interp, dictObj);
}
@@ -188,8 +200,7 @@ static int array_cmd_size(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
/* Not found means zero length */
objPtr = Jim_GetVariable(interp, argv[0], JIM_NONE);
if (objPtr) {
- Jim_ListLength(interp, objPtr, &len);
- len /= 2;
+ len = Jim_ListLength(interp, objPtr) / 2;
}
Jim_SetResultInt(interp, len);
@@ -201,23 +212,29 @@ static int array_cmd_set(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
{
int i;
int len;
+ int rc = JIM_OK;
Jim_Obj *listObj = argv[1];
- Jim_ListLength(interp, listObj, &len);
+ if (Jim_GetVariable(interp, argv[0], JIM_NONE) == NULL) {
+ /* Doesn't exist, so just set the list directly */
+ return Jim_SetVariable(interp, argv[0], listObj);
+ }
+
+ len = Jim_ListLength(interp, listObj);
if (len % 2) {
Jim_SetResultString(interp, "list must have an even number of elements", -1);
return JIM_ERR;
}
- for (i = 0; i < len; i += 2) {
+ for (i = 0; i < len && rc == JIM_OK; i += 2) {
Jim_Obj *nameObj;
Jim_Obj *valueObj;
Jim_ListIndex(interp, listObj, i, &nameObj, JIM_NONE);
Jim_ListIndex(interp, listObj, i + 1, &valueObj, JIM_NONE);
- Jim_SetDictKeysVector(interp, argv[0], &nameObj, 1, valueObj);
+ rc = Jim_SetDictKeysVector(interp, argv[0], &nameObj, 1, valueObj);
}
- return JIM_OK;
+ return rc;
}
static const jim_subcmd_type command_table[] = {
diff --git a/jim-interactive.c b/jim-interactive.c
index daa5aa9..9d78c9f 100644
--- a/jim-interactive.c
+++ b/jim-interactive.c
@@ -13,8 +13,9 @@ int Jim_InteractivePrompt(Jim_Interp *interp)
while (1) {
char buf[1024];
const char *result;
+ /* NOTE: These must be kept in the same order as JIM_OK, JIM_ERR, ... */
const char *retcodestr[] = {
- "ok", "error", "return", "break", "continue", "signal", "eval", "exit"
+ "ok", "error", "return", "break", "continue", "signal", "exit", "eval"
};
int reslen;
diff --git a/jim-package.c b/jim-package.c
index 52818b8..360a267 100644
--- a/jim-package.c
+++ b/jim-package.c
@@ -68,7 +68,7 @@ static int JimLoadPackage(Jim_Interp *interp, const char *name, int flags)
libPathObjPtr = NULL;
} else {
Jim_IncrRefCount(libPathObjPtr);
- Jim_ListLength(interp, libPathObjPtr, &prefixc);
+ prefixc = Jim_ListLength(interp, libPathObjPtr);
}
prefixes = Jim_Alloc(sizeof(char*)*prefixc);
diff --git a/jim-subcmd.c b/jim-subcmd.c
index 24af265..e246941 100644
--- a/jim-subcmd.c
+++ b/jim-subcmd.c
@@ -70,6 +70,21 @@ static void show_full_usage(Jim_Interp *interp, const jim_subcmd_type *ct, int a
}
}
+static void add_cmd_usage(Jim_Interp *interp, const jim_subcmd_type *command_table, int argc, Jim_Obj *const *argv)
+{
+ Jim_AppendStrings(interp, Jim_GetResult(interp), Jim_GetString(argv[0], NULL), NULL);
+ if (command_table->args && *command_table->args) {
+ Jim_AppendStrings(interp, Jim_GetResult(interp), " ", command_table->args, NULL);
+ }
+}
+
+static void set_wrong_args(Jim_Interp *interp, const jim_subcmd_type *command_table, int argc, Jim_Obj *const *argv)
+{
+ Jim_SetResultString(interp, "wrong # args: must be \"", -1);
+ add_cmd_usage(interp, command_table, argc, argv);
+ Jim_AppendStrings(interp, Jim_GetResult(interp), "\"", NULL);
+}
+
const jim_subcmd_type *
Jim_ParseSubCmd(Jim_Interp *interp, const jim_subcmd_type *command_table, int argc, Jim_Obj *const *argv)
{
@@ -169,7 +184,7 @@ Jim_ParseSubCmd(Jim_Interp *interp, const jim_subcmd_type *command_table, int ar
/* Check the number of args */
if (argc - 2 < ct->minargs || (ct->maxargs >= 0 && argc - 2> ct->maxargs)) {
- Jim_SetResultString(interp, "wrong # args: should be \"", -1);
+ Jim_SetResultString(interp, "wrong # args: must be \"", -1);
add_subcmd_usage(interp, ct, argc, argv);
Jim_AppendStrings(interp, Jim_GetResult(interp), "\"", NULL);
@@ -192,9 +207,7 @@ int Jim_CallSubCmd(Jim_Interp *interp, const jim_subcmd_type *ct, int argc, Jim_
ret = ct->function(interp, argc - 2, argv + 2);
}
if (ret < 0) {
- Jim_SetResultString(interp, "wrong # args: should be \"", -1);
- add_subcmd_usage(interp, ct, argc, argv);
- Jim_AppendStrings(interp, Jim_GetResult(interp), "\"", NULL);
+ set_wrong_args(interp, ct, argc, argv);
ret = JIM_ERR;
}
}
@@ -209,14 +222,6 @@ int Jim_SubCmdProc(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
}
/* The following two functions are for normal commands */
-static void add_cmd_usage(Jim_Interp *interp, const jim_subcmd_type *command_table, int argc, Jim_Obj *const *argv)
-{
- Jim_AppendStrings(interp, Jim_GetResult(interp), Jim_GetString(argv[0], NULL), NULL);
- if (command_table->args && *command_table->args) {
- Jim_AppendStrings(interp, Jim_GetResult(interp), " ", command_table->args, NULL);
- }
-}
-
int
Jim_CheckCmdUsage(Jim_Interp *interp, const jim_subcmd_type *command_table, int argc, Jim_Obj *const *argv)
{
@@ -266,9 +271,7 @@ Jim_CheckCmdUsage(Jim_Interp *interp, const jim_subcmd_type *command_table, int
/* Check the number of args */
if (argc - 1 < command_table->minargs || (command_table->maxargs >= 0 && argc - 1> command_table->maxargs)) {
- Jim_SetResultString(interp, "wrong # args: should be \"", -1);
- add_cmd_usage(interp, command_table, argc, argv);
- Jim_AppendStrings(interp, Jim_GetResult(interp), "\"", NULL);
+ set_wrong_args(interp, command_table, argc, argv);
Jim_AppendStrings(interp, Jim_GetResult(interp), "\"\nUse \"", Jim_GetString(argv[0], NULL), " -help\" for help", NULL);
return JIM_ERR;
}
diff --git a/jim.c b/jim.c
index 3627d04..a5be022 100644
--- a/jim.c
+++ b/jim.c
@@ -95,9 +95,8 @@
#include <execinfo.h>
#endif
-#ifdef JIM_MATH_FUNCTIONS
+/* For INFINITY, even if math functions are not enabled */
#include <math.h>
-#endif
/* -----------------------------------------------------------------------------
* Global variables
@@ -250,24 +249,32 @@ int JimStringCompare(const char *s1, int l1, const char *s2, int l2,
int nocase)
{
unsigned char *u1 = (unsigned char*) s1, *u2 = (unsigned char*) s2;
+ int diff;
if (nocase == 0) {
while(l1 && l2) {
- if (*u1 != *u2)
- return (int)*u1-*u2;
+ diff = (int)*u1-*u2;
+ if (diff) {
+ goto done;
+ }
u1++; u2++; l1--; l2--;
}
- if (!l1 && !l2) return 0;
- return l1-l2;
+ diff = l1-l2;
} else {
while(l1 && l2) {
- if (tolower((int)*u1) != tolower((int)*u2))
- return tolower((int)*u1)-tolower((int)*u2);
+ diff = tolower((int)*u1)-tolower((int)*u2);
+ if (diff) {
+ goto done;
+ }
u1++; u2++; l1--; l2--;
}
- if (!l1 && !l2) return 0;
- return l1-l2;
+ diff = l1-l2;
+ }
+ if (diff == 0) {
+ return 0;
}
+done:
+ return diff < 0 ? -1 : 1;
}
/* Search 's1' inside 's2', starting to search from char 'index' of 's2'.
@@ -288,17 +295,12 @@ int JimStringFirst(const char *s1, int l1, const char *s2, int l2, int index)
return -1;
}
-int JimStringLast(const char *s1, int l1, const char *s2, int l2, int index)
+int JimStringLast(const char *s1, int l1, const char *s2, int l2)
{
const char *p;
if (!l1 || !l2 || l1 > l2) return -1;
- /* Possibly shorten the haystack */
- if (index > 0 && index < l2) {
- l2 = index;
- }
-
/* Now search for the needle */
for (p = s2 + l2 - 1; p != s2 - 1; p--) {
if (*p == *s1 && memcmp(s1, p, l1) == 0) {
@@ -324,8 +326,9 @@ int Jim_StringToWide(const char *str, jim_wide *widePtr, int base)
return JIM_ERR;
if (endptr[0] != '\0') {
while(*endptr) {
- if (!isspace(*endptr))
+ if (!isspace(*endptr)) {
return JIM_ERR;
+ }
endptr++;
}
}
@@ -337,6 +340,10 @@ int Jim_StringToIndex(const char *str, int *intPtr)
char *endptr;
*intPtr = strtol(str, &endptr, 10);
+ if (endptr != str && (*endptr == '+' || *endptr == '-')) {
+ /* Support num+num and num-num, and even num--num */
+ *intPtr += ((*endptr == '-') ? -1 : 1) * strtol(endptr + 1, &endptr, 10);
+ }
if ( (str[0] == '\0') || (str == endptr) )
return JIM_ERR;
if (endptr[0] != '\0') {
@@ -349,22 +356,6 @@ int Jim_StringToIndex(const char *str, int *intPtr)
return JIM_OK;
}
-/* The string representation of references has two features in order
- * to make the GC faster. The first is that every reference starts
- * with a non common character '~', in order to make the string matching
- * fater. The second is that the reference string rep his 32 characters
- * in length, this allows to avoid to check every object with a string
- * repr < 32, and usually there are many of this objects. */
-
-#define JIM_REFERENCE_SPACE (35+JIM_REFERENCE_TAGLEN)
-
-static int JimFormatReference(char *buf, Jim_Reference *refPtr, jim_wide id)
-{
- const char *fmt = "<reference.<%s>.%020" JIM_WIDE_MODIFIER ">";
- sprintf(buf, fmt, refPtr->tag, id);
- return JIM_REFERENCE_SPACE;
-}
-
int Jim_DoubleToString(char *buf, double doubleValue)
{
int len;
@@ -1685,7 +1676,7 @@ Jim_Obj *Jim_NewObj(Jim_Interp *interp)
* to scan objects with refCount == 0. */
objPtr->refCount = 0;
/* All the other fields are left not initialized to save time.
- * The caller will probably want set they to the right
+ * The caller will probably want to set them to the right
* value anyway. */
/* -- Put the object into the live list -- */
@@ -3000,7 +2991,7 @@ int Jim_CreateProcedure(Jim_Interp *interp, const char *cmdName,
if (staticsListObjPtr) {
int len, i;
- Jim_ListLength(interp, staticsListObjPtr, &len);
+ len = Jim_ListLength(interp, staticsListObjPtr);
if (len != 0) {
cmdPtr->staticVars = Jim_Alloc(sizeof(Jim_HashTable));
Jim_InitHashTable(cmdPtr->staticVars, &JimVariablesHashTableType,
@@ -3012,7 +3003,7 @@ int Jim_CreateProcedure(Jim_Interp *interp, const char *cmdName,
Jim_ListIndex(interp, staticsListObjPtr, i, &objPtr, JIM_NONE);
/* Check if it's composed of two elements. */
- Jim_ListLength(interp, objPtr, &subLen);
+ subLen = Jim_ListLength(interp, objPtr);
if (subLen == 1 || subLen == 2) {
/* Try to get the variable value from the current
* environment. */
@@ -3816,6 +3807,7 @@ static void JimFreeCallFrame(Jim_Interp *interp, Jim_CallFrame *cf,
/* -----------------------------------------------------------------------------
* References
* ---------------------------------------------------------------------------*/
+#ifdef JIM_REFERENCES
/* References HashTable Type.
*
@@ -3878,6 +3870,22 @@ static const Jim_HashTableType JimReferencesHashTableType = {
* Reference object type and References API
* ---------------------------------------------------------------------------*/
+/* The string representation of references has two features in order
+ * to make the GC faster. The first is that every reference starts
+ * with a non common character '~', in order to make the string matching
+ * fater. The second is that the reference string rep his 32 characters
+ * in length, this allows to avoid to check every object with a string
+ * repr < 32, and usually there are many of this objects. */
+
+#define JIM_REFERENCE_SPACE (35+JIM_REFERENCE_TAGLEN)
+
+static int JimFormatReference(char *buf, Jim_Reference *refPtr, jim_wide id)
+{
+ const char *fmt = "<reference.<%s>.%020" JIM_WIDE_MODIFIER ">";
+ sprintf(buf, fmt, refPtr->tag, id);
+ return JIM_REFERENCE_SPACE;
+}
+
static void UpdateStringOfReference(struct Jim_Obj *objPtr);
static const Jim_ObjType referenceObjType = {
@@ -4206,6 +4214,7 @@ void Jim_CollectIfNeeded(Jim_Interp *interp)
Jim_Collect(interp);
}
}
+#endif
/* -----------------------------------------------------------------------------
* Interpreter related functions
@@ -4239,7 +4248,9 @@ Jim_Interp *Jim_CreateInterp(void)
* interpreter liveList and freeList pointers are
* initialized to NULL. */
Jim_InitHashTable(&i->commands, &JimCommandsHashTableType, i);
+#ifdef JIM_REFERENCES
Jim_InitHashTable(&i->references, &JimReferencesHashTableType, i);
+#endif
Jim_InitHashTable(&i->sharedStrings, &JimSharedStringsHashTableType,
NULL);
Jim_InitHashTable(&i->assocData, &JimAssocDataHashTableType, i);
@@ -4474,8 +4485,7 @@ static void JimAppendStackTrace(Jim_Interp *interp, const char *procname,
/* If we have no procname but the previous element did, merge with that frame */
if (!*procname && *filename) {
/* Just a filename. Check the previous entry */
- int len;
- Jim_ListLength(interp, interp->stackTrace, &len);
+ int len = Jim_ListLength(interp, interp->stackTrace);
if (len >= 3) {
Jim_Obj *procnameObj;
@@ -5083,11 +5093,10 @@ Jim_Obj *Jim_NewListObj(Jim_Interp *interp, Jim_Obj *const *elements,
* is in use, this vector is the one stored inside the internal representation
* of the list object. This function is not exported, extensions should
* always access to the List object elements using Jim_ListIndex(). */
-static void JimListGetElements(Jim_Interp *interp, Jim_Obj *listObj, int *argc,
+static void JimListGetElements(Jim_Interp *interp, Jim_Obj *listObj, int *listLen,
Jim_Obj ***listVec)
{
- Jim_ListLength(interp, listObj, argc);
- assert(listObj->typePtr == &listObjType);
+ *listLen = Jim_ListLength(interp, listObj);
*listVec = listObj->internalRep.listValue.ele;
}
@@ -5124,7 +5133,8 @@ static int ListSortInteger(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
static int ListSortCommand(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
{
- Jim_Obj *compare_script = Jim_DuplicateObj(sort_interp, sort_command);
+ Jim_Obj *compare_script;
+
long ret = 0;
/* We have already had an error, so just compare pointers */
@@ -5133,6 +5143,7 @@ static int ListSortCommand(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
}
/* This must be a valid list */
+ compare_script = Jim_DuplicateObj(sort_interp, sort_command);
Jim_ListAppendElement(sort_interp, compare_script, *lhsObj);
Jim_ListAppendElement(sort_interp, compare_script, *rhsObj);
@@ -5157,7 +5168,7 @@ static int ListSortElements(Jim_Interp *interp, Jim_Obj *listObjPtr, int type, i
if (Jim_IsShared(listObjPtr))
Jim_Panic(interp,"Jim_ListSortElements called with shared object");
- if (listObjPtr->typePtr != &listObjType)
+ if (!Jim_IsList(listObjPtr))
SetListFromAny(interp, listObjPtr);
sort_order = order;
@@ -5267,7 +5278,7 @@ void Jim_ListAppendElement(Jim_Interp *interp, Jim_Obj *listPtr, Jim_Obj *objPtr
{
if (Jim_IsShared(listPtr))
Jim_Panic(interp,"Jim_ListAppendElement called with shared object");
- if (listPtr->typePtr != &listObjType)
+ if (!Jim_IsList(listPtr))
SetListFromAny(interp, listPtr);
Jim_InvalidateStringRep(listPtr);
ListAppendElement(listPtr, objPtr);
@@ -5277,17 +5288,17 @@ void Jim_ListAppendList(Jim_Interp *interp, Jim_Obj *listPtr, Jim_Obj *appendLis
{
if (Jim_IsShared(listPtr))
Jim_Panic(interp,"Jim_ListAppendList called with shared object");
- if (listPtr->typePtr != &listObjType)
+ if (!Jim_IsList(listPtr))
SetListFromAny(interp, listPtr);
Jim_InvalidateStringRep(listPtr);
ListAppendList(listPtr, appendListPtr);
}
-void Jim_ListLength(Jim_Interp *interp, Jim_Obj *listPtr, int *intPtr)
+int Jim_ListLength(Jim_Interp *interp, Jim_Obj *objPtr)
{
- if (listPtr->typePtr != &listObjType)
- SetListFromAny(interp, listPtr);
- *intPtr = listPtr->internalRep.listValue.len;
+ if (!Jim_IsList(objPtr))
+ SetListFromAny(interp, objPtr);
+ return objPtr->internalRep.listValue.len;
}
void Jim_ListInsertElements(Jim_Interp *interp, Jim_Obj *listPtr, int index,
@@ -5295,7 +5306,7 @@ void Jim_ListInsertElements(Jim_Interp *interp, Jim_Obj *listPtr, int index,
{
if (Jim_IsShared(listPtr))
Jim_Panic(interp,"Jim_ListInsertElement called with shared object");
- if (listPtr->typePtr != &listObjType)
+ if (!Jim_IsList(listPtr))
SetListFromAny(interp, listPtr);
if (index >= 0 && index > listPtr->internalRep.listValue.len)
index = listPtr->internalRep.listValue.len;
@@ -5308,7 +5319,7 @@ void Jim_ListInsertElements(Jim_Interp *interp, Jim_Obj *listPtr, int index,
int Jim_ListIndex(Jim_Interp *interp, Jim_Obj *listPtr, int index,
Jim_Obj **objPtrPtr, int flags)
{
- if (listPtr->typePtr != &listObjType)
+ if (!Jim_IsList(listPtr))
SetListFromAny(interp, listPtr);
if ((index >= 0 && index >= listPtr->internalRep.listValue.len) ||
(index < 0 && (-index-1) >= listPtr->internalRep.listValue.len)) {
@@ -5328,7 +5339,7 @@ int Jim_ListIndex(Jim_Interp *interp, Jim_Obj *listPtr, int index,
static int ListSetIndex(Jim_Interp *interp, Jim_Obj *listPtr, int index,
Jim_Obj *newObjPtr, int flags)
{
- if (listPtr->typePtr != &listObjType)
+ if (!Jim_IsList(listPtr))
SetListFromAny(interp, listPtr);
if ((index >= 0 && index >= listPtr->internalRep.listValue.len) ||
(index < 0 && (-index-1) >= listPtr->internalRep.listValue.len)) {
@@ -5399,7 +5410,8 @@ Jim_Obj *Jim_ConcatObj(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
* it's possible to return a list as result, that's the
* concatenation of all the lists. */
for (i = 0; i < objc; i++) {
- if (objv[i]->typePtr != &listObjType || objv[i]->bytes)
+ if (!Jim_IsList(objv[i]))
+ //if (objv[i]->typePtr != &listObjType || objv[i]->bytes)
break;
}
if (i == objc) {
@@ -5456,7 +5468,7 @@ Jim_Obj *Jim_ListRange(Jim_Interp *interp, Jim_Obj *listObjPtr, Jim_Obj *firstOb
if (Jim_GetIndex(interp, firstObjPtr, &first) != JIM_OK ||
Jim_GetIndex(interp, lastObjPtr, &last) != JIM_OK)
return NULL;
- Jim_ListLength(interp, listObjPtr, &len); /* will convert into list */
+ len = Jim_ListLength(interp, listObjPtr); /* will convert into list */
first = JimRelToAbsIndex(len, first);
last = JimRelToAbsIndex(len, last);
JimRelToAbsRange(len, first, last, &first, &last, &rangeLen);
@@ -5639,7 +5651,50 @@ void UpdateStringOfDict(struct Jim_Obj *objPtr)
Jim_Free(objv);
}
-int SetDictFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
+#ifdef JIM_OPTIMIZATION
+static int SetDictFromList(Jim_Interp *interp, struct Jim_Obj *objPtr)
+{
+ Jim_HashTable *ht;
+ int i;
+ int listlen;
+
+ listlen = Jim_ListLength(interp, objPtr);
+ if (listlen % 2) {
+ return JIM_ERR;
+ }
+
+ /* Now we can't fail */
+ ht = Jim_Alloc(sizeof(*ht));
+ Jim_InitHashTable(ht, &JimDictHashTableType, interp);
+
+ for (i = 0; i < listlen; i += 2) {
+ Jim_Obj *keyObjPtr;
+ Jim_Obj *valObjPtr;
+ Jim_ListIndex(interp, objPtr, i, &keyObjPtr, JIM_NONE);
+ Jim_ListIndex(interp, objPtr, i + 1, &valObjPtr, JIM_NONE);
+
+ Jim_IncrRefCount(keyObjPtr);
+ Jim_IncrRefCount(valObjPtr);
+
+ if (Jim_AddHashEntry(ht, keyObjPtr, valObjPtr) != JIM_OK) {
+ Jim_HashEntry *he;
+ he = Jim_FindHashEntry(ht, keyObjPtr);
+ Jim_DecrRefCount(interp, keyObjPtr);
+ /* ATTENTION: const cast */
+ Jim_DecrRefCount(interp, (Jim_Obj*)he->val);
+ he->val = valObjPtr;
+ }
+ }
+
+ Jim_FreeIntRep(interp, objPtr);
+ objPtr->typePtr = &dictObjType;
+ objPtr->internalRep.ptr = ht;
+
+ return JIM_OK;
+}
+#endif
+
+static int SetDictFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
{
struct JimParserCtx parser;
Jim_HashTable *ht;
@@ -5647,6 +5702,18 @@ int SetDictFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
const char *str;
int i, strLen;
+#ifdef JIM_OPTIMIZATION
+ /* If the object is of type "list" we can use
+ * a specialized version
+ */
+ if (Jim_IsList(objPtr)) {
+ if (SetDictFromList(interp, objPtr) != JIM_OK) {
+ goto badlist;
+ }
+ return JIM_OK;
+ }
+#endif
+
/* Get the string representation */
str = Jim_GetString(objPtr, &strLen);
@@ -5689,6 +5756,9 @@ int SetDictFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
Jim_FreeNewObj(interp, objv[0]);
objPtr->typePtr = NULL;
Jim_FreeHashTable(ht);
+#ifdef JIM_OPTIMIZATION
+badlist:
+#endif
Jim_SetResultString(interp, "invalid dictionary value: must be a list with an even number of elements", -1);
return JIM_ERR;
}
@@ -5947,11 +6017,11 @@ int SetIndexFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
/* Get the string representation */
str = Jim_GetString(objPtr, NULL);
/* Try to convert into an index */
- if (!strcmp(str, "end")) {
+ if (strcmp(str, "end") == 0) {
index = 0;
end = 1;
} else {
- if (!strncmp(str, "end-", 4)) {
+ if (strncmp(str, "end-", 4) == 0) {
str += 4;
end = 1;
}
@@ -5959,7 +6029,7 @@ int SetIndexFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
Jim_AppendStrings(interp, Jim_GetResult(interp),
"bad index \"", Jim_GetString(objPtr, NULL), "\": "
- "must be integer or end?-integer?", NULL);
+ "must be integer?[+-]integer? or end?-integer?", NULL);
return JIM_ERR;
}
}
@@ -6010,33 +6080,20 @@ static const Jim_ObjType returnCodeObjType = {
int SetReturnCodeFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
{
- const char *str;
- int strLen, returnCode;
+ int returnCode;
jim_wide wideValue;
+ /* NOTE: These must be kept in the same order as JIM_OK, JIM_ERR, ... */
+ static const char *options[] = {
+ "ok", "error", "return", "break", "continue", "signal", "exit", "eval", NULL
+ };
- /* Get the string representation */
- str = Jim_GetString(objPtr, &strLen);
/* Try to convert into an integer */
if (JimGetWideNoErr(interp, objPtr, &wideValue) != JIM_ERR)
returnCode = (int) wideValue;
- else if (!JimStringCompare(str, strLen, "ok", 2, JIM_NOCASE))
- returnCode = JIM_OK;
- else if (!JimStringCompare(str, strLen, "error", 5, JIM_NOCASE))
- returnCode = JIM_ERR;
- else if (!JimStringCompare(str, strLen, "return", 6, JIM_NOCASE))
- returnCode = JIM_RETURN;
- else if (!JimStringCompare(str, strLen, "break", 5, JIM_NOCASE))
- returnCode = JIM_BREAK;
- else if (!JimStringCompare(str, strLen, "continue", 8, JIM_NOCASE))
- returnCode = JIM_CONTINUE;
- else if (!JimStringCompare(str, strLen, "eval", 4, JIM_NOCASE))
- returnCode = JIM_EVAL;
- else if (!JimStringCompare(str, strLen, "exit", 4, JIM_NOCASE))
- returnCode = JIM_EXIT;
- else {
+ else if (Jim_GetEnum(interp, objPtr, options, &returnCode, NULL, JIM_NONE) != JIM_OK) {
Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
Jim_AppendStrings(interp, Jim_GetResult(interp),
- "expected return code but got '", str, "'",
+ "expected return code but got '", Jim_GetString(objPtr, NULL), "'",
NULL);
return JIM_ERR;
}
@@ -6158,30 +6215,28 @@ enum {
#endif
};
-struct expr_state {
+struct JimExprState {
Jim_Obj **stack;
int stacklen;
int opcode;
int skip;
};
-typedef int jim_expr_function_t(Jim_Interp *interp, struct expr_state *e);
-
/* Operators table */
typedef struct Jim_ExprOperator {
const char *name;
int precedence;
int arity;
- jim_expr_function_t *funcop;
+ int (*funcop)(Jim_Interp *interp, struct JimExprState *e);
} Jim_ExprOperator;
-static void expr_push(struct expr_state *e, Jim_Obj *obj)
+static void ExprPush(struct JimExprState *e, Jim_Obj *obj)
{
Jim_IncrRefCount(obj);
e->stack[e->stacklen++] = obj;
}
-static Jim_Obj *expr_pop(struct expr_state *e)
+static Jim_Obj *ExprPop(struct JimExprState *e)
{
assert(e->stacklen);
return e->stack[--e->stacklen];
@@ -6191,9 +6246,9 @@ static Jim_Obj *expr_pop(struct expr_state *e)
#define OBJ_IS_DOUBLE 1
#define OBJ_NO_NUM -1
-static int expr_getnum(Jim_Interp *interp, struct expr_state *e, Jim_Obj **resultObjPtr, jim_wide *w, double *d)
+static int ExprGetNum(Jim_Interp *interp, struct JimExprState *e, Jim_Obj **resultObjPtr, jim_wide *w, double *d)
{
- Jim_Obj *obj = expr_pop(e);
+ Jim_Obj *obj = ExprPop(e);
*resultObjPtr = obj;
*w = 0;
@@ -6224,14 +6279,14 @@ static int expr_getnum(Jim_Interp *interp, struct expr_state *e, Jim_Obj **resul
}
-static int JimExprOpNumUnary(Jim_Interp *interp, struct expr_state *e)
+static int JimExprOpNumUnary(Jim_Interp *interp, struct JimExprState *e)
{
int intresult = 0;
int rc = JIM_OK;
Jim_Obj *A;
double dA, dC;
jim_wide wA, wC;
- int type = expr_getnum(interp, e, &A, &wA, &dA);
+ int type = ExprGetNum(interp, e, &A, &wA, &dA);
if (type == OBJ_IS_DOUBLE) {
switch (e->opcode) {
@@ -6265,10 +6320,10 @@ static int JimExprOpNumUnary(Jim_Interp *interp, struct expr_state *e)
if (rc == JIM_OK) {
if (intresult) {
- expr_push(e, Jim_NewIntObj(interp, wC));
+ ExprPush(e, Jim_NewIntObj(interp, wC));
}
else {
- expr_push(e, Jim_NewDoubleObj(interp, dC));
+ ExprPush(e, Jim_NewDoubleObj(interp, dC));
}
}
@@ -6277,9 +6332,9 @@ static int JimExprOpNumUnary(Jim_Interp *interp, struct expr_state *e)
return rc;
}
-static int JimExprOpIntUnary(Jim_Interp *interp, struct expr_state *e)
+static int JimExprOpIntUnary(Jim_Interp *interp, struct JimExprState *e)
{
- Jim_Obj *A = expr_pop(e);
+ Jim_Obj *A = ExprPop(e);
jim_wide wA;
int rc = JIM_ERR;
@@ -6291,7 +6346,7 @@ static int JimExprOpIntUnary(Jim_Interp *interp, struct expr_state *e)
case JIM_EXPROP_BITNOT: wC = ~wA; break;
default: abort();
}
- expr_push(e, Jim_NewIntObj(interp, wC));
+ ExprPush(e, Jim_NewIntObj(interp, wC));
rc = JIM_OK;
}
@@ -6301,10 +6356,10 @@ static int JimExprOpIntUnary(Jim_Interp *interp, struct expr_state *e)
}
#ifdef JIM_MATH_FUNCTIONS
-static int JimExprOpDoubleUnary(Jim_Interp *interp, struct expr_state *e)
+static int JimExprOpDoubleUnary(Jim_Interp *interp, struct JimExprState *e)
{
int rc;
- Jim_Obj *A = expr_pop(e);
+ Jim_Obj *A = ExprPop(e);
double dA, dC;
rc = Jim_GetDouble(interp, A, &dA);
@@ -6327,7 +6382,7 @@ static int JimExprOpDoubleUnary(Jim_Interp *interp, struct expr_state *e)
case JIM_EXPROP_FUNC_SQRT: dC=sqrt(dA); break;
default: abort();
}
- expr_push(e, Jim_NewDoubleObj(interp, dC));
+ ExprPush(e, Jim_NewDoubleObj(interp, dC));
}
Jim_DecrRefCount(interp, A);
@@ -6337,10 +6392,10 @@ static int JimExprOpDoubleUnary(Jim_Interp *interp, struct expr_state *e)
#endif
/* A binary operation on two ints */
-static int JimExprOpIntBin(Jim_Interp *interp, struct expr_state *e)
+static int JimExprOpIntBin(Jim_Interp *interp, struct JimExprState *e)
{
- Jim_Obj *B = expr_pop(e);
- Jim_Obj *A = expr_pop(e);
+ Jim_Obj *B = ExprPop(e);
+ Jim_Obj *A = ExprPop(e);
jim_wide wA, wB;
int rc = JIM_ERR;
@@ -6401,7 +6456,7 @@ static int JimExprOpIntBin(Jim_Interp *interp, struct expr_state *e)
}
default: abort();
}
- expr_push(e, Jim_NewIntObj(interp, wC));
+ ExprPush(e, Jim_NewIntObj(interp, wC));
}
@@ -6413,15 +6468,15 @@ static int JimExprOpIntBin(Jim_Interp *interp, struct expr_state *e)
/* A binary operation on two ints or two doubles (or two strings for some ops) */
-static int JimExprOpBin(Jim_Interp *interp, struct expr_state *e)
+static int JimExprOpBin(Jim_Interp *interp, struct JimExprState *e)
{
int intresult = 0;
int rc = JIM_OK;
Jim_Obj *A, *B;
double dA, dB, dC;
jim_wide wA, wB, wC;
- int typeB = expr_getnum(interp, e, &B, &wB, &dB);
- int typeA = expr_getnum(interp, e, &A, &wA, &dA);
+ int typeB = ExprGetNum(interp, e, &B, &wB, &dB);
+ int typeA = ExprGetNum(interp, e, &A, &wA, &dA);
if (typeA == OBJ_IS_INT && typeB == OBJ_IS_INT) {
/* Both are ints */
@@ -6488,7 +6543,11 @@ static int JimExprOpBin(Jim_Interp *interp, struct expr_state *e)
case JIM_EXPROP_MUL: dC = dA*dB; break;
case JIM_EXPROP_DIV:
if (dB == 0) {
+#ifdef INFINITY
dC = dA < 0 ? -INFINITY : INFINITY;
+#else
+ dC = (dA < 0 ? -1.0 : 1.0) * strtod("Inf", NULL);
+#endif
}
else {
dC = dA/dB;
@@ -6532,10 +6591,10 @@ static int JimExprOpBin(Jim_Interp *interp, struct expr_state *e)
if (rc == JIM_OK) {
if (intresult) {
- expr_push(e, Jim_NewIntObj(interp, wC));
+ ExprPush(e, Jim_NewIntObj(interp, wC));
}
else {
- expr_push(e, Jim_NewDoubleObj(interp, dC));
+ ExprPush(e, Jim_NewDoubleObj(interp, dC));
}
}
@@ -6550,7 +6609,7 @@ static int JimSearchList(Jim_Interp *interp, Jim_Obj *listObjPtr, Jim_Obj *valOb
int listlen;
int i;
- Jim_ListLength(interp, listObjPtr, &listlen);
+ listlen = Jim_ListLength(interp, listObjPtr);
for (i = 0; i < listlen; i++) {
Jim_Obj *objPtr;
Jim_ListIndex(interp, listObjPtr, i, &objPtr, JIM_NONE);
@@ -6562,10 +6621,10 @@ static int JimSearchList(Jim_Interp *interp, Jim_Obj *listObjPtr, Jim_Obj *valOb
return 0;
}
-static int JimExprOpStrBin(Jim_Interp *interp, struct expr_state *e)
+static int JimExprOpStrBin(Jim_Interp *interp, struct JimExprState *e)
{
- Jim_Obj *B = expr_pop(e);
- Jim_Obj *A = expr_pop(e);
+ Jim_Obj *B = ExprPop(e);
+ Jim_Obj *A = ExprPop(e);
int Alen, Blen;
jim_wide wC;
@@ -6585,7 +6644,7 @@ static int JimExprOpStrBin(Jim_Interp *interp, struct expr_state *e)
wC = !JimSearchList(interp, B, A); break;
default: abort();
}
- expr_push(e, Jim_NewIntObj(interp, wC));
+ ExprPush(e, Jim_NewIntObj(interp, wC));
Jim_DecrRefCount(interp, A);
Jim_DecrRefCount(interp, B);
@@ -6593,7 +6652,7 @@ static int JimExprOpStrBin(Jim_Interp *interp, struct expr_state *e)
return JIM_OK;
}
-static int expr_bool(Jim_Interp *interp, Jim_Obj *obj)
+static int ExprBool(Jim_Interp *interp, Jim_Obj *obj)
{
long l;
double d;
@@ -6606,17 +6665,17 @@ static int expr_bool(Jim_Interp *interp, Jim_Obj *obj)
return -1;
}
-static int JimExprOpAndLeft(Jim_Interp *interp, struct expr_state *e)
+static int JimExprOpAndLeft(Jim_Interp *interp, struct JimExprState *e)
{
- Jim_Obj *skip = expr_pop(e);
- Jim_Obj *A = expr_pop(e);
+ Jim_Obj *skip = ExprPop(e);
+ Jim_Obj *A = ExprPop(e);
int rc = JIM_OK;
- switch (expr_bool(interp, A)) {
+ switch (ExprBool(interp, A)) {
case 0:
/* false, so skip RHS opcodes with a 0 result */
e->skip = skip->internalRep.wideValue;
- expr_push(e, Jim_NewIntObj(interp, 0));
+ ExprPush(e, Jim_NewIntObj(interp, 0));
break;
case 1:
@@ -6633,13 +6692,13 @@ static int JimExprOpAndLeft(Jim_Interp *interp, struct expr_state *e)
return rc;
}
-static int JimExprOpOrLeft(Jim_Interp *interp, struct expr_state *e)
+static int JimExprOpOrLeft(Jim_Interp *interp, struct JimExprState *e)
{
- Jim_Obj *skip = expr_pop(e);
- Jim_Obj *A = expr_pop(e);
+ Jim_Obj *skip = ExprPop(e);
+ Jim_Obj *A = ExprPop(e);
int rc = JIM_OK;
- switch (expr_bool(interp, A)) {
+ switch (ExprBool(interp, A)) {
case 0:
/* false, so do nothing */
break;
@@ -6647,7 +6706,7 @@ static int JimExprOpOrLeft(Jim_Interp *interp, struct expr_state *e)
case 1:
/* true so skip RHS opcodes with a 1 result */
e->skip = skip->internalRep.wideValue;
- expr_push(e, Jim_NewIntObj(interp, 1));
+ ExprPush(e, Jim_NewIntObj(interp, 1));
break;
case -1:
@@ -6661,18 +6720,18 @@ static int JimExprOpOrLeft(Jim_Interp *interp, struct expr_state *e)
return rc;
}
-static int JimExprOpAndOrRight(Jim_Interp *interp, struct expr_state *e)
+static int JimExprOpAndOrRight(Jim_Interp *interp, struct JimExprState *e)
{
- Jim_Obj *A = expr_pop(e);
+ Jim_Obj *A = ExprPop(e);
int rc = JIM_OK;
- switch (expr_bool(interp, A)) {
+ switch (ExprBool(interp, A)) {
case 0:
- expr_push(e, Jim_NewIntObj(interp, 0));
+ ExprPush(e, Jim_NewIntObj(interp, 0));
break;
case 1:
- expr_push(e, Jim_NewIntObj(interp, 1));
+ ExprPush(e, Jim_NewIntObj(interp, 1));
break;
case -1:
@@ -6685,21 +6744,21 @@ static int JimExprOpAndOrRight(Jim_Interp *interp, struct expr_state *e)
return rc;
}
-static int JimExprOpTernaryLeft(Jim_Interp *interp, struct expr_state *e)
+static int JimExprOpTernaryLeft(Jim_Interp *interp, struct JimExprState *e)
{
- Jim_Obj *skip = expr_pop(e);
- Jim_Obj *A = expr_pop(e);
+ Jim_Obj *skip = ExprPop(e);
+ Jim_Obj *A = ExprPop(e);
int rc = JIM_OK;
/* Repush A */
- expr_push(e, A);
+ ExprPush(e, A);
- switch (expr_bool(interp, A)) {
+ switch (ExprBool(interp, A)) {
case 0:
/* false, skip RHS opcodes */
e->skip = skip->internalRep.wideValue;
/* Push a dummy value */
- expr_push(e, Jim_NewIntObj(interp, 0));
+ ExprPush(e, Jim_NewIntObj(interp, 0));
break;
case 1:
@@ -6717,18 +6776,18 @@ static int JimExprOpTernaryLeft(Jim_Interp *interp, struct expr_state *e)
return rc;
}
-static int JimExprOpColonLeft(Jim_Interp *interp, struct expr_state *e)
+static int JimExprOpColonLeft(Jim_Interp *interp, struct JimExprState *e)
{
- Jim_Obj *skip = expr_pop(e);
- Jim_Obj *B = expr_pop(e);
- Jim_Obj *A = expr_pop(e);
+ Jim_Obj *skip = ExprPop(e);
+ Jim_Obj *B = ExprPop(e);
+ Jim_Obj *A = ExprPop(e);
/* No need to check for A as non-boolean */
- if (expr_bool(interp, A)) {
+ if (ExprBool(interp, A)) {
/* true, so skip RHS opcodes */
e->skip = skip->internalRep.wideValue;
/* Repush B as the answer */
- expr_push(e, B);
+ ExprPush(e, B);
}
Jim_DecrRefCount(interp, skip);
@@ -6737,7 +6796,7 @@ static int JimExprOpColonLeft(Jim_Interp *interp, struct expr_state *e)
return JIM_OK;
}
-static int JimExprOpNull(Jim_Interp *interp, struct expr_state *e)
+static int JimExprOpNull(Jim_Interp *interp, struct JimExprState *e)
{
return JIM_OK;
}
@@ -7435,7 +7494,7 @@ int Jim_EvalExpression(Jim_Interp *interp, Jim_Obj *exprObjPtr,
Jim_Obj *staticStack[JIM_EE_STATICSTACK_LEN];
int i;
int retcode = JIM_OK;
- struct expr_state e;
+ struct JimExprState e;
Jim_IncrRefCount(exprObjPtr);
expr = Jim_GetExpression(interp, exprObjPtr);
@@ -7514,7 +7573,7 @@ int Jim_EvalExpression(Jim_Interp *interp, Jim_Obj *exprObjPtr,
}
if (retcode == JIM_OK && objPtr) {
- expr_push(&e, objPtr);
+ ExprPush(&e, objPtr);
}
}
@@ -7526,7 +7585,7 @@ int Jim_EvalExpression(Jim_Interp *interp, Jim_Obj *exprObjPtr,
Jim_DecrRefCount(interp, exprObjPtr);
if (retcode == JIM_OK) {
assert(e.stacklen == 1);
- *exprResultPtrPtr = expr_pop(&e);
+ *exprResultPtrPtr = ExprPop(&e);
}
else {
for (i = 0; i < e.stacklen; i++) {
@@ -7589,12 +7648,12 @@ typedef struct ScanFmtPartDescr {
char *prefix; /* Prefix to be scanned literally before conversion */
} ScanFmtPartDescr;
-/* The ScanFmtStringObj will held the internal representation of a scanformat
+/* The ScanFmtStringObj will hold the internal representation of a scanformat
* string parsed and separated in part descriptions. Furthermore it contains
* the original string representation of the scanformat string to allow for
* fast update of the Jim_Obj's string representation part.
*
- * As add-on the internal object representation add some scratch pad area
+ * As an add-on the internal object representation adds some scratch pad area
* for usage by Jim_ScanString to avoid endless allocating and freeing of
* memory for purpose of string scanning.
*
@@ -8381,7 +8440,7 @@ void Jim_ExpandArgument(Jim_Interp *interp, Jim_Obj ***argv,
} else {
int len, i;
- Jim_ListLength(interp, objPtr, &len);
+ len = Jim_ListLength(interp, objPtr);
(*argv) = Jim_Realloc(*argv, sizeof(Jim_Obj*)*((*argcPtr)+len));
for (i = 0; i < len; i++) {
(*argv)[*argcPtr] = objPtr->internalRep.listValue.ele[i];
@@ -8398,8 +8457,13 @@ void Jim_ExpandArgument(Jim_Interp *interp, Jim_Obj ***argv,
static int JimAddErrorToStack(Jim_Interp *interp, int retcode, const char *filename, int line)
{
- if (retcode == JIM_ERR || retcode == JIM_ERR_ADDSTACK) {
+ int rc = retcode;
+ /* Pick up 'return -code error' too */
+ if (retcode == JIM_RETURN) {
+ rc = interp->returnCode;
+ }
+ if (rc == JIM_ERR || rc == JIM_ERR_ADDSTACK) {
if (!interp->errorFlag) {
/* This is the first error, so save the file/line information and reset the stack */
interp->errorFlag = 1;
@@ -8409,10 +8473,10 @@ static int JimAddErrorToStack(Jim_Interp *interp, int retcode, const char *filen
JimResetStackTrace(interp);
/* Always add a stack frame at this level */
- retcode = JIM_ERR_ADDSTACK;
+ rc = JIM_ERR_ADDSTACK;
}
- if (retcode == JIM_ERR_ADDSTACK) {
+ if (rc == JIM_ERR_ADDSTACK) {
/* Add the stack info for the current level */
JimAppendStackTrace(interp, Jim_GetString(interp->errorProc, NULL), filename, line);
}
@@ -8420,9 +8484,8 @@ static int JimAddErrorToStack(Jim_Interp *interp, int retcode, const char *filen
Jim_DecrRefCount(interp, interp->errorProc);
interp->errorProc = interp->emptyObj;
Jim_IncrRefCount(interp->errorProc);
- return JIM_ERR;
}
- return retcode;
+ return retcode == JIM_ERR_ADDSTACK ? JIM_ERR : retcode;
}
int Jim_EvalObj(Jim_Interp *interp, Jim_Obj *scriptObjPtr)
@@ -8440,9 +8503,13 @@ int Jim_EvalObj(Jim_Interp *interp, Jim_Obj *scriptObjPtr)
/* If the object is of type "list" and there is no
* string representation for this object, we can call
* a specialized version of Jim_EvalObj() */
- if (scriptObjPtr->typePtr == &listObjType &&
+ if (Jim_IsList(scriptObjPtr) && scriptObjPtr->internalRep.listValue.len)
+#if 0
+ (scriptObjPtr->typePtr == &listObjType &&
scriptObjPtr->internalRep.listValue.len &&
- scriptObjPtr->bytes == NULL) {
+ scriptObjPtr->bytes == NULL)
+#endif
+ {
Jim_IncrRefCount(scriptObjPtr);
retcode = Jim_EvalObjVector(interp,
scriptObjPtr->internalRep.listValue.len,
@@ -8676,7 +8743,7 @@ int JimCallProcedure(Jim_Interp *interp, Jim_Cmd *cmd, int argc,
interp->numLevels ++;
/* Set arguments */
- Jim_ListLength(interp, cmd->argListObjPtr, &num_args);
+ num_args = Jim_ListLength(interp, cmd->argListObjPtr);
/* If last argument is 'args', don't set it here */
if (cmd->arityMax == -1) {
@@ -8789,8 +8856,6 @@ int Jim_Eval(Jim_Interp *interp, const char *script)
return Jim_Eval_Named( interp, script, NULL, 0 );
}
-
-
/* Execute script in the scope of the global level */
int Jim_EvalGlobal(Jim_Interp *interp, const char *script)
{
@@ -8871,6 +8936,12 @@ int Jim_EvalFile(Jim_Interp *interp, const char *filename)
retcode = Jim_EvalObj(interp, scriptObjPtr);
+ /* Handle the JIM_RETURN return code */
+ if (retcode == JIM_RETURN) {
+ retcode = interp->returnCode;
+ interp->returnCode = JIM_OK;
+ }
+
interp->currentScriptObj = prevScriptObj;
Jim_DecrRefCount(interp, scriptObjPtr);
@@ -9960,8 +10031,8 @@ static int JimForeachMapHelper(Jim_Interp *interp, int argc,
for (i=0; i < nbrOfLists*2; i += 2) {
div_t cnt;
int count;
- Jim_ListLength(interp, argv[i+1], &listsEnd[i]);
- Jim_ListLength(interp, argv[i+2], &listsEnd[i+1]);
+ listsEnd[i] = Jim_ListLength(interp, argv[i+1]);
+ listsEnd[i + 1] = Jim_ListLength(interp, argv[i+2]);
if (listsEnd[i] == 0) {
Jim_SetResultString(interp, "foreach varlist is empty", -1);
goto err;
@@ -10278,14 +10349,11 @@ static int Jim_LindexCoreCommand(Jim_Interp *interp, int argc,
static int Jim_LlengthCoreCommand(Jim_Interp *interp, int argc,
Jim_Obj *const *argv)
{
- int len;
-
if (argc != 2) {
Jim_WrongNumArgs(interp, 1, argv, "list");
return JIM_ERR;
}
- Jim_ListLength(interp, argv[1], &len);
- Jim_SetResult(interp, Jim_NewIntObj(interp, len));
+ Jim_SetResultInt(interp, Jim_ListLength(interp, argv[1]));
return JIM_OK;
}
@@ -10318,7 +10386,7 @@ wrongargs:
for (i = 1; i < argc - 2; i++) {
int option;
- if (Jim_GetEnum(interp, argv[i], options, &option, "option", JIM_ERRMSG) != JIM_OK) {
+ if (Jim_GetEnum(interp, argv[i], options, &option, NULL, JIM_ERRMSG) != JIM_OK) {
return JIM_ERR;
}
switch(option) {
@@ -10353,7 +10421,7 @@ wrongargs:
Jim_IncrRefCount(commandObj);
}
- Jim_ListLength(interp, argv[0], &listlen);
+ listlen = Jim_ListLength(interp, argv[0]);
for (i = 0; i < listlen; i++) {
Jim_Obj *objPtr;
Jim_ListIndex(interp, argv[0], i, &objPtr, JIM_NONE);
@@ -10480,7 +10548,7 @@ static int Jim_LinsertCoreCommand(Jim_Interp *interp, int argc,
listPtr = Jim_DuplicateObj(interp, listPtr);
if (Jim_GetIndex(interp, argv[2], &index) != JIM_OK)
goto err;
- Jim_ListLength(interp, listPtr, &len);
+ len = Jim_ListLength(interp, listPtr);
if (index >= len)
index = len;
else if (index < 0)
@@ -10515,7 +10583,7 @@ static int Jim_LreplaceCoreCommand(Jim_Interp *interp, int argc,
}
listObj = argv[1];
- Jim_ListLength(interp, listObj, &len);
+ len = Jim_ListLength(interp, listObj);
first = JimRelToAbsIndex(len, first);
last = JimRelToAbsIndex(len, last);
@@ -10599,13 +10667,14 @@ static int Jim_LsortCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const arg
int retCode;
if (argc < 2) {
+wrongargs:
Jim_WrongNumArgs(interp, 1, argv, "?options? list");
return JIM_ERR;
}
for (i = 1; i < (argc-1); i++) {
int option;
- if (Jim_GetEnum(interp, argv[i], options, &option, "option", JIM_ERRMSG)
+ if (Jim_GetEnum(interp, argv[i], options, &option, NULL, JIM_ERRMSG)
!= JIM_OK)
return JIM_ERR;
switch(option) {
@@ -10614,7 +10683,11 @@ static int Jim_LsortCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const arg
case OPT_INTEGER: lsortType = JIM_LSORT_INTEGER; break;
case OPT_INCREASING: lsort_order = 1; break;
case OPT_DECREASING: lsort_order = -1; break;
- case OPT_COMMAND: lsortType = JIM_LSORT_COMMAND; lsort_command = argv[i + 1]; i++; break;
+ case OPT_COMMAND:
+ if (i >= (argc - 2)) {
+ goto wrongargs;
+ }
+ lsortType = JIM_LSORT_COMMAND; lsort_command = argv[i + 1]; i++; break;
}
}
resObj = Jim_DuplicateObj(interp, argv[argc-1]);
@@ -10622,6 +10695,9 @@ static int Jim_LsortCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const arg
if (retCode == JIM_OK) {
Jim_SetResult(interp, resObj);
}
+ else {
+ Jim_FreeNewObj(interp, resObj);
+ }
return retCode;
}
@@ -10681,10 +10757,10 @@ static int Jim_DebugCoreCommand(Jim_Interp *interp, int argc,
int option;
if (argc < 2) {
- Jim_WrongNumArgs(interp, 1, argv, "option ?...?");
+ Jim_WrongNumArgs(interp, 1, argv, "subcommand ?...?");
return JIM_ERR;
}
- if (Jim_GetEnum(interp, argv[1], options, &option, "option",
+ if (Jim_GetEnum(interp, argv[1], options, &option, "subcommand",
JIM_ERRMSG) != JIM_OK)
return JIM_ERR;
if (option == OPT_REFCOUNT) {
@@ -10960,7 +11036,7 @@ static int Jim_ReturnCoreCommand(Jim_Interp *interp, int argc,
Jim_SetResult(interp, argv[1]);
interp->returnCode = JIM_OK;
return JIM_RETURN;
- } else if (argc == 3 || argc == 4) {
+ } else if ((argc == 3 || argc == 4) && Jim_CompareStringImmediate(interp, argv[1], "-code")) {
int returnCode;
if (Jim_GetReturnCode(interp, argv[2], &returnCode) == JIM_ERR)
return JIM_ERR;
@@ -10998,7 +11074,7 @@ static int Jim_ProcCoreCommand(Jim_Interp *interp, int argc,
Jim_WrongNumArgs(interp, 1, argv, "name arglist ?statics? body");
return JIM_ERR;
}
- Jim_ListLength(interp, argv[2], &argListLen);
+ argListLen = Jim_ListLength(interp, argv[2]);
arityMin = arityMax = argListLen+1;
if (argListLen) {
@@ -11018,7 +11094,7 @@ static int Jim_ProcCoreCommand(Jim_Interp *interp, int argc,
while (arityMin > 1) {
int len;
Jim_ListIndex(interp, argv[2], arityMin - 2, &argPtr, JIM_NONE);
- Jim_ListLength(interp, argPtr, &len);
+ len = Jim_ListLength(interp, argPtr);
if (len != 2) {
/* No default argument */
break;
@@ -11029,7 +11105,7 @@ static int Jim_ProcCoreCommand(Jim_Interp *interp, int argc,
int len;
Jim_ListIndex(interp, argv[2], i, &argPtr, JIM_NONE);
Jim_GetString(argPtr, &len);
- Jim_ListLength(interp, argPtr, &len);
+ len = Jim_ListLength(interp, argPtr);
if (len == 0) {
Jim_SetResultString(interp, "", 0);
Jim_AppendStrings(interp, Jim_GetResult(interp),
@@ -11128,7 +11204,7 @@ static Jim_Obj *JimStringMap(Jim_Interp *interp, Jim_Obj *mapListObjPtr,
int *keyLen, strLen, i;
Jim_Obj *resultObjPtr;
- Jim_ListLength(interp, mapListObjPtr, &numMaps);
+ numMaps = Jim_ListLength(interp, mapListObjPtr);
if (numMaps % 2) {
Jim_SetResultString(interp,
"list must contain an even number of elements", -1);
@@ -11189,199 +11265,234 @@ static Jim_Obj *JimStringMap(Jim_Interp *interp, Jim_Obj *mapListObjPtr,
static int Jim_StringCoreCommand(Jim_Interp *interp, int argc,
Jim_Obj *const *argv)
{
+ int len;
+ int opt_case = 1;
int option;
- const char *options[] = {
- "length", "compare", "match", "equal", "range", "map", "repeat",
- "index", "first", "last", "trim", "trimleft", "trimright", "tolower", "toupper", NULL
+ static const char *options[] = {
+ "length", "compare", "match", "equal", "range", "map",
+ "repeat", "reverse", "index", "first", "last",
+ "trim", "trimleft", "trimright", "tolower", "toupper", NULL
};
enum {
- OPT_LENGTH, OPT_COMPARE, OPT_MATCH, OPT_EQUAL, OPT_RANGE,
- OPT_MAP, OPT_REPEAT, OPT_INDEX, OPT_FIRST, OPT_LAST, OPT_TRIM, OPT_TRIMLEFT, OPT_TRIMRIGHT,
- OPT_TOLOWER, OPT_TOUPPER
+ OPT_LENGTH, OPT_COMPARE, OPT_MATCH, OPT_EQUAL, OPT_RANGE, OPT_MAP,
+ OPT_REPEAT, OPT_REVERSE, OPT_INDEX, OPT_FIRST, OPT_LAST,
+ OPT_TRIM, OPT_TRIMLEFT, OPT_TRIMRIGHT, OPT_TOLOWER, OPT_TOUPPER
+ };
+ static const char *nocase_options[] = {
+ "-nocase", NULL
};
if (argc < 2) {
Jim_WrongNumArgs(interp, 1, argv, "option ?arguments ...?");
return JIM_ERR;
}
- if (Jim_GetEnum(interp, argv[1], options, &option, "option",
- JIM_ERRMSG) != JIM_OK)
+ if (Jim_GetEnum(interp, argv[1], options, &option, NULL,
+ JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK)
return JIM_ERR;
- if (option == OPT_LENGTH) {
- int len;
+ switch (option) {
+ case OPT_LENGTH:
+ if (argc != 3) {
+ Jim_WrongNumArgs(interp, 2, argv, "string");
+ return JIM_ERR;
+ }
+ Jim_GetString(argv[2], &len);
+ Jim_SetResultInt(interp, len);
+ return JIM_OK;
- if (argc != 3) {
- Jim_WrongNumArgs(interp, 2, argv, "string");
- return JIM_ERR;
- }
- Jim_GetString(argv[2], &len);
- Jim_SetResult(interp, Jim_NewIntObj(interp, len));
- return JIM_OK;
- } else if (option == OPT_COMPARE) {
- int nocase = 0;
- if ((argc != 4 && argc != 5) ||
- (argc == 5 && Jim_CompareStringImmediate(interp,
- argv[2], "-nocase") == 0)) {
- Jim_WrongNumArgs(interp, 2, argv, "string1 string2");
- return JIM_ERR;
- }
- if (argc == 5) {
- nocase = 1;
- argv++;
- }
- Jim_SetResult(interp, Jim_NewIntObj(interp,
- Jim_StringCompareObj(argv[2],
- argv[3], nocase)));
- return JIM_OK;
- } else if (option == OPT_MATCH) {
- int nocase = 0;
- if ((argc != 4 && argc != 5) ||
- (argc == 5 && Jim_CompareStringImmediate(interp,
- argv[2], "-nocase") == 0)) {
- Jim_WrongNumArgs(interp, 2, argv, "?-nocase? pattern "
- "string");
- return JIM_ERR;
- }
- if (argc == 5) {
- nocase = 1;
- argv++;
- }
- Jim_SetResult(interp,
- Jim_NewIntObj(interp, Jim_StringMatchObj(argv[2],
- argv[3], nocase)));
- return JIM_OK;
- } else if (option == OPT_EQUAL) {
- if (argc != 4) {
- Jim_WrongNumArgs(interp, 2, argv, "string1 string2");
- return JIM_ERR;
- }
- Jim_SetResult(interp,
- Jim_NewIntObj(interp, Jim_StringEqObj(argv[2],
- argv[3], 0)));
- return JIM_OK;
- } else if (option == OPT_RANGE) {
- Jim_Obj *objPtr;
+ case OPT_COMPARE:
+ case OPT_EQUAL:
+ if (argc != 4 &&
+ (argc != 5 ||
+ Jim_GetEnum(interp, argv[2], nocase_options, &opt_case, NULL, JIM_ENUM_ABBREV) != JIM_OK)) {
+ Jim_WrongNumArgs(interp, 2, argv, "?-nocase? string1 string2");
+ return JIM_ERR;
+ }
+ if (opt_case == 0) {
+ argv++;
+ }
+ if (option == OPT_COMPARE) {
+ Jim_SetResultInt(interp, Jim_StringCompareObj(argv[2], argv[3], !opt_case));
+ }
+ else {
+ Jim_SetResultInt(interp, Jim_StringEqObj(argv[2], argv[3], !opt_case));
+ }
+ return JIM_OK;
- if (argc != 5) {
- Jim_WrongNumArgs(interp, 2, argv, "string first last");
- return JIM_ERR;
- }
- objPtr = Jim_StringRangeObj(interp, argv[2], argv[3], argv[4]);
- if (objPtr == NULL)
- return JIM_ERR;
- Jim_SetResult(interp, objPtr);
- return JIM_OK;
- } else if (option == OPT_MAP) {
- int nocase = 0;
- Jim_Obj *objPtr;
+ case OPT_MATCH:
+ if (argc != 4 &&
+ (argc != 5 ||
+ Jim_GetEnum(interp, argv[2], nocase_options, &opt_case, NULL, JIM_ENUM_ABBREV) != JIM_OK)) {
+ Jim_WrongNumArgs(interp, 2, argv, "?-nocase? pattern string");
+ return JIM_ERR;
+ }
+ if (opt_case == 0) {
+ argv++;
+ }
+ Jim_SetResultInt(interp, Jim_StringMatchObj(argv[2], argv[3], !opt_case));
+ return JIM_OK;
- if ((argc != 4 && argc != 5) ||
- (argc == 5 && Jim_CompareStringImmediate(interp,
- argv[2], "-nocase") == 0)) {
- Jim_WrongNumArgs(interp, 2, argv, "?-nocase? mapList "
- "string");
- return JIM_ERR;
- }
- if (argc == 5) {
- nocase = 1;
- argv++;
- }
- objPtr = JimStringMap(interp, argv[2], argv[3], nocase);
- if (objPtr == NULL)
- return JIM_ERR;
- Jim_SetResult(interp, objPtr);
- return JIM_OK;
- } else if (option == OPT_REPEAT) {
- Jim_Obj *objPtr;
- jim_wide count;
+ case OPT_MAP: {
+ Jim_Obj *objPtr;
- if (argc != 4) {
- Jim_WrongNumArgs(interp, 2, argv, "string count");
- return JIM_ERR;
- }
- if (Jim_GetWide(interp, argv[3], &count) != JIM_OK)
- return JIM_ERR;
- objPtr = Jim_NewStringObj(interp, "", 0);
- while (count--) {
- Jim_AppendObj(interp, objPtr, argv[2]);
- }
- Jim_SetResult(interp, objPtr);
- return JIM_OK;
- } else if (option == OPT_INDEX) {
- int index, len;
- const char *str;
+ if (argc != 4 &&
+ (argc != 5 ||
+ Jim_GetEnum(interp, argv[2], nocase_options, &opt_case, NULL, JIM_ENUM_ABBREV) != JIM_OK)) {
+ Jim_WrongNumArgs(interp, 2, argv, "?-nocase? mapList string");
+ return JIM_ERR;
+ }
- if (argc != 4) {
- Jim_WrongNumArgs(interp, 2, argv, "string index");
- return JIM_ERR;
- }
- if (Jim_GetIndex(interp, argv[3], &index) != JIM_OK)
- return JIM_ERR;
- str = Jim_GetString(argv[2], &len);
- if (index != INT_MIN && index != INT_MAX)
- index = JimRelToAbsIndex(len, index);
- if (index < 0 || index >= len) {
- Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
- return JIM_OK;
- } else {
- Jim_SetResult(interp, Jim_NewStringObj(interp, str+index, 1));
+ if (opt_case == 0) {
+ argv++;
+ }
+ objPtr = JimStringMap(interp, argv[2], argv[3], !opt_case);
+ if (objPtr == NULL) {
+ return JIM_ERR;
+ }
+ Jim_SetResult(interp, objPtr);
return JIM_OK;
}
- } else if (option == OPT_FIRST || option == OPT_LAST) {
- int index = 0, l1, l2;
- const char *s1, *s2;
- if (argc != 4 && argc != 5) {
- Jim_WrongNumArgs(interp, 2, argv, "subString string ?startIndex?");
- return JIM_ERR;
- }
- s1 = Jim_GetString(argv[2], &l1);
- s2 = Jim_GetString(argv[3], &l2);
- if (argc == 5) {
- if (Jim_GetIndex(interp, argv[4], &index) != JIM_OK)
+ case OPT_RANGE: {
+ Jim_Obj *objPtr;
+
+ if (argc != 5) {
+ Jim_WrongNumArgs(interp, 2, argv, "string first last");
return JIM_ERR;
- index = JimRelToAbsIndex(l2, index);
- }
- if (option == OPT_FIRST) {
- Jim_SetResult(interp, Jim_NewIntObj(interp,
- JimStringFirst(s1, l1, s2, l2, index)));
- }
- else {
- Jim_SetResult(interp, Jim_NewIntObj(interp,
- JimStringLast(s1, l1, s2, l2, index)));
+ }
+ objPtr = Jim_StringRangeObj(interp, argv[2], argv[3], argv[4]);
+ if (objPtr == NULL) {
+ return JIM_ERR;
+ }
+ Jim_SetResult(interp, objPtr);
+ return JIM_OK;
}
- return JIM_OK;
- } else if (option == OPT_TRIM) {
- if (argc != 3 && argc != 4) {
- Jim_WrongNumArgs(interp, 2, argv, "string ?trimchars?");
- return JIM_ERR;
+
+ case OPT_REPEAT: {
+ Jim_Obj *objPtr;
+ jim_wide count;
+
+ if (argc != 4) {
+ Jim_WrongNumArgs(interp, 2, argv, "string count");
+ return JIM_ERR;
+ }
+ if (Jim_GetWide(interp, argv[3], &count) != JIM_OK) {
+ return JIM_ERR;
+ }
+ objPtr = Jim_NewStringObj(interp, "", 0);
+ if (count > 0) {
+ while (count--) {
+ Jim_AppendObj(interp, objPtr, argv[2]);
+ }
+ }
+ Jim_SetResult(interp, objPtr);
+ return JIM_OK;
}
- Jim_SetResult(interp, JimStringTrim(interp, argv[2], argc == 4 ? argv[3] : NULL));
- } else if (option == OPT_TRIMLEFT) {
- if (argc != 3 && argc != 4) {
- Jim_WrongNumArgs(interp, 2, argv, "string ?trimchars?");
- return JIM_ERR;
+
+ case OPT_REVERSE: {
+ char *buf;
+ const char *str;
+ int i;
+
+ if (argc != 3) {
+ Jim_WrongNumArgs(interp, 2, argv, "string");
+ return JIM_ERR;
+ }
+ str = Jim_GetString(argv[2], &len);
+ buf = Jim_Alloc(len + 1);
+ for (i = 0; i < len; i++) {
+ buf[i] = str[len - i - 1];
+ }
+ buf[i] = 0;
+ Jim_SetResult(interp, Jim_NewStringObjNoAlloc(interp, buf, len));
+ return JIM_OK;
}
- Jim_SetResult(interp, JimStringTrimLeft(interp, argv[2], argc == 4 ? argv[3] : NULL));
- } else if (option == OPT_TRIMRIGHT) {
- if (argc != 3 && argc != 4) {
- Jim_WrongNumArgs(interp, 2, argv, "string ?trimchars?");
- return JIM_ERR;
+
+ case OPT_INDEX: {
+ int index, len;
+ const char *str;
+
+ if (argc != 4) {
+ Jim_WrongNumArgs(interp, 2, argv, "string index");
+ return JIM_ERR;
+ }
+ if (Jim_GetIndex(interp, argv[3], &index) != JIM_OK) {
+ return JIM_ERR;
+ }
+ str = Jim_GetString(argv[2], &len);
+ if (index != INT_MIN && index != INT_MAX) {
+ index = JimRelToAbsIndex(len, index);
+ }
+ if (index < 0 || index >= len) {
+ Jim_SetResultString(interp, "", 0);
+ } else {
+ Jim_SetResultString(interp, str + index, 1);
+ }
+ return JIM_OK;
}
- Jim_SetResult(interp, JimStringTrimRight(interp, argv[2], argc == 4 ? argv[3] : NULL));
- } else if (option == OPT_TOLOWER) {
- if (argc != 3) {
- Jim_WrongNumArgs(interp, 2, argv, "string");
- return JIM_ERR;
+
+ case OPT_FIRST:
+ case OPT_LAST: {
+ int index = 0, l1, l2;
+ const char *s1, *s2;
+
+ if (argc != 4 && argc != 5) {
+ Jim_WrongNumArgs(interp, 2, argv, "subString string ?index?");
+ return JIM_ERR;
+ }
+ s1 = Jim_GetString(argv[2], &l1);
+ s2 = Jim_GetString(argv[3], &l2);
+ if (argc == 5) {
+ if (Jim_GetIndex(interp, argv[4], &index) != JIM_OK) {
+ return JIM_ERR;
+ }
+ index = JimRelToAbsIndex(l2, index);
+ }
+ else if (option == OPT_LAST) {
+ index = l2;
+ }
+ if (option == OPT_FIRST) {
+ Jim_SetResultInt(interp, JimStringFirst(s1, l1, s2, l2, index));
+ }
+ else {
+ Jim_SetResultInt(interp, JimStringLast(s1, l1, s2, index));
+ }
+ return JIM_OK;
}
- Jim_SetResult(interp, JimStringToLower(interp, argv[2]));
- } else if (option == OPT_TOUPPER) {
- if (argc != 3) {
- Jim_WrongNumArgs(interp, 2, argv, "string");
- return JIM_ERR;
+
+ case OPT_TRIM:
+ case OPT_TRIMLEFT:
+ case OPT_TRIMRIGHT: {
+ Jim_Obj *trimchars;
+
+ if (argc != 3 && argc != 4) {
+ Jim_WrongNumArgs(interp, 2, argv, "string ?trimchars?");
+ return JIM_ERR;
+ }
+ trimchars = (argc == 4 ? argv[3] : NULL);
+ if (option == OPT_TRIM) {
+ Jim_SetResult(interp, JimStringTrim(interp, argv[2], trimchars));
+ } else if (option == OPT_TRIMLEFT) {
+ Jim_SetResult(interp, JimStringTrimLeft(interp, argv[2], trimchars));
+ } else if (option == OPT_TRIMRIGHT) {
+ Jim_SetResult(interp, JimStringTrimRight(interp, argv[2], trimchars));
+ }
+ return JIM_OK;
}
- Jim_SetResult(interp, JimStringToUpper(interp, argv[2]));
+
+ case OPT_TOLOWER:
+ case OPT_TOUPPER:
+ if (argc != 3) {
+ Jim_WrongNumArgs(interp, 2, argv, "string");
+ return JIM_ERR;
+ }
+ if (option == OPT_TOLOWER) {
+ Jim_SetResult(interp, JimStringToLower(interp, argv[2]));
+ }
+ else {
+ Jim_SetResult(interp, JimStringToUpper(interp, argv[2]));
+ }
+ return JIM_OK;
}
return JIM_OK;
}
@@ -11491,6 +11602,7 @@ static int Jim_CatchCoreCommand(Jim_Interp *interp, int argc,
return JIM_OK;
}
+#ifdef JIM_REFERENCES
/* [ref] */
static int Jim_RefCoreCommand(Jim_Interp *interp, int argc,
Jim_Obj *const *argv)
@@ -11577,9 +11689,9 @@ static int Jim_FinalizeCoreCommand(Jim_Interp *interp, int argc,
}
return JIM_OK;
}
-
/* TODO */
/* [info references] (list of all the references/finalizers) */
+#endif
/* [rename] */
static int Jim_RenameCoreCommand(Jim_Interp *interp, int argc,
@@ -11616,11 +11728,11 @@ static int Jim_DictCoreCommand(Jim_Interp *interp, int argc,
};
if (argc < 2) {
- Jim_WrongNumArgs(interp, 1, argv, "option ?arguments ...?");
+ Jim_WrongNumArgs(interp, 1, argv, "subcommand ?arguments ...?");
return JIM_ERR;
}
- if (Jim_GetEnum(interp, argv[1], options, &option, "option",
+ if (Jim_GetEnum(interp, argv[1], options, &option, "subcommand",
JIM_ERRMSG) != JIM_OK)
return JIM_ERR;
@@ -11681,32 +11793,33 @@ static int Jim_DictCoreCommand(Jim_Interp *interp, int argc,
static int Jim_SubstCoreCommand(Jim_Interp *interp, int argc,
Jim_Obj *const *argv)
{
- int i, flags = JIM_SUBST_FLAG;
+ const char *options[] = {
+ "-nobackslashes", "-nocommands", "-novariables", NULL
+ };
+ enum {OPT_NOBACKSLASHES, OPT_NOCOMMANDS, OPT_NOVARIABLES};
+ int i;
+ int flags = JIM_SUBST_FLAG;
Jim_Obj *objPtr;
if (argc < 2) {
- Jim_WrongNumArgs(interp, 1, argv,
- "?-nobackslashes? ?-nocommands? ?-novariables? string");
+ Jim_WrongNumArgs(interp, 1, argv, "?options? string");
return JIM_ERR;
}
- i = argc-2;
- while(i--) {
- const char *option = Jim_GetString(argv[i + 1], NULL);
+ for (i = 1; i < (argc-1); i++) {
+ int option;
- if (strncmp(option, "-nob", 4) == 0) flags |= JIM_SUBST_NOESC;
- else if (strncmp(option, "-nov", 4) == 0) flags |= JIM_SUBST_NOVAR;
- else if (strncmp(option, "-noc", 4) == 0) flags |= JIM_SUBST_NOCMD;
- else {
- Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
- Jim_AppendStrings(interp, Jim_GetResult(interp),
- "bad option \"", Jim_GetString(argv[i+1], NULL),
- "\": must be -nobackslashes, -nocommands, or "
- "-novariables", NULL);
+ if (Jim_GetEnum(interp, argv[i], options, &option, NULL, JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) {
return JIM_ERR;
}
+ switch(option) {
+ case OPT_NOBACKSLASHES: flags |= JIM_SUBST_NOESC; break;
+ case OPT_NOCOMMANDS: flags |= JIM_SUBST_NOCMD; break;
+ case OPT_NOVARIABLES: flags |= JIM_SUBST_NOVAR; break;
+ }
}
- if (Jim_SubstObj(interp, argv[argc-1], &objPtr, flags) != JIM_OK)
+ if (Jim_SubstObj(interp, argv[argc-1], &objPtr, flags) != JIM_OK) {
return JIM_ERR;
+ }
Jim_SetResult(interp, objPtr);
return JIM_OK;
}
@@ -11726,10 +11839,10 @@ static int Jim_InfoCoreCommand(Jim_Interp *interp, int argc,
INFO_HOSTNAME, INFO_SCRIPT, INFO_SOURCE, INFO_STACKTRACE};
if (argc < 2) {
- Jim_WrongNumArgs(interp, 1, argv, "command ?args ...?");
+ Jim_WrongNumArgs(interp, 1, argv, "subcommand ?args ...?");
return JIM_ERR;
}
- if (Jim_GetEnum(interp, argv[1], commands, &cmd, "command", JIM_ERRMSG)
+ if (Jim_GetEnum(interp, argv[1], commands, &cmd, "subcommand", JIM_ERRMSG | JIM_ENUM_ABBREV)
!= JIM_OK) {
return JIM_ERR;
}
@@ -11937,7 +12050,7 @@ static int Jim_JoinCoreCommand(Jim_Interp *interp, int argc,
} else {
joinStr = Jim_GetString(argv[2], &joinStrLen);
}
- Jim_ListLength(interp, argv[1], &listLen);
+ listLen = Jim_ListLength(interp, argv[1]);
resObjPtr = Jim_NewStringObj(interp, NULL, 0);
/* Split */
for (i = 0; i < listLen; i++) {
@@ -12012,8 +12125,7 @@ static int Jim_ScanCoreCommand(Jim_Interp *interp, int argc,
count = 0;
if (listPtr != 0 && listPtr != (Jim_Obj*)EOF) {
- int len = 0;
- Jim_ListLength(interp, listPtr, &len);
+ int len = Jim_ListLength(interp, listPtr);
if (len != 0) {
JimListGetElements(interp, listPtr, &outc, &outVec);
@@ -12321,11 +12433,13 @@ static const struct {
{"time", Jim_TimeCoreCommand},
{"exit", Jim_ExitCoreCommand},
{"catch", Jim_CatchCoreCommand},
+#ifdef JIM_REFERENCES
{"ref", Jim_RefCoreCommand},
{"getref", Jim_GetrefCoreCommand},
{"setref", Jim_SetrefCoreCommand},
{"finalize", Jim_FinalizeCoreCommand},
{"collect", Jim_CollectCoreCommand},
+#endif
{"rename", Jim_RenameCoreCommand},
{"dict", Jim_DictCoreCommand},
{"subst", Jim_SubstCoreCommand},
@@ -12349,7 +12463,8 @@ static const struct {
/* Some Jim core command is actually a procedure written in Jim itself. */
static void Jim_RegisterCoreProcedures(Jim_Interp *interp)
{
- Jim_Eval(interp, (char*)
+#ifdef JIM_REFERENCES
+ Jim_Eval(interp,
"proc lambda {arglist args} {\n"
" set name [ref {} function lambdaFinalizer]\n"
" uplevel 1 [list proc $name $arglist {expand}$args]\n"
@@ -12359,6 +12474,7 @@ static void Jim_RegisterCoreProcedures(Jim_Interp *interp)
" rename $name {}\n"
"}\n"
);
+#endif
}
void Jim_RegisterCoreCommands(Jim_Interp *interp)
@@ -12388,7 +12504,7 @@ void Jim_PrintErrorMessage(Jim_Interp *interp)
}
fprintf(stderr, "%s" JIM_NL,
Jim_GetString(interp->result, NULL));
- Jim_ListLength(interp, interp->stackTrace, &len);
+ len = Jim_ListLength(interp, interp->stackTrace);
for (i = len-3; i >= 0; i-= 3) {
Jim_Obj *objPtr = 0;
const char *proc, *file, *line;
@@ -12418,28 +12534,60 @@ void Jim_PrintErrorMessage(Jim_Interp *interp)
}
}
}
+
int Jim_GetEnum(Jim_Interp *interp, Jim_Obj *objPtr,
const char * const *tablePtr, int *indexPtr, const char *name, int flags)
{
+ const char *bad = "bad ";
const char * const *entryPtr = NULL;
char **tablePtrSorted;
- int i, count = 0;
+ int i;
+ int arglen;
+ const char *arg = Jim_GetString(objPtr, &arglen);
+ int match = -1;
*indexPtr = -1;
for (entryPtr = tablePtr, i = 0; *entryPtr != NULL; entryPtr++, i++) {
if (Jim_CompareStringImmediate(interp, objPtr, *entryPtr)) {
+ /* Found an exact match */
*indexPtr = i;
return JIM_OK;
}
- count++; /* If nothing matches, this will reach the len of tablePtr */
+ if (flags & JIM_ENUM_ABBREV) {
+ /* Accept an unambiguous abbreviation.
+ * Note that '-' doesnt' consitute a valid abbreviation
+ */
+ if (strncmp(arg, *entryPtr, arglen) == 0) {
+ if (*arg == '-' && arglen == 1) {
+ break;
+ }
+ if (match >= 0) {
+ bad = "ambiguous ";
+ goto ambiguous;
+ }
+ match = i;
+ }
+ }
}
+
+ /* If we had an unambiguous partial match */
+ if (match >= 0) {
+ *indexPtr = match;
+ return JIM_OK;
+ }
+
+ambiguous:
if (flags & JIM_ERRMSG) {
+ int count;
+ for (count = 0; tablePtr[count]; count++) {
+ }
+
if (name == NULL)
name = "option";
Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
Jim_AppendStrings(interp, Jim_GetResult(interp),
- "bad ", name, " \"", Jim_GetString(objPtr, NULL), "\": must be one of ",
+ bad, name, " \"", Jim_GetString(objPtr, NULL), "\": must be ",
NULL);
tablePtrSorted = Jim_Alloc(sizeof(char*)*count);
memcpy(tablePtrSorted, tablePtr, sizeof(char*)*count);
@@ -12457,6 +12605,16 @@ int Jim_GetEnum(Jim_Interp *interp, Jim_Obj *objPtr,
return JIM_ERR;
}
+int Jim_IsDict(Jim_Obj *objPtr)
+{
+ return objPtr->typePtr == &dictObjType;
+}
+
+int Jim_IsList(Jim_Obj *objPtr)
+{
+ return objPtr->typePtr == &listObjType;
+}
+
/*
* Local Variables: ***
* c-basic-offset: 4 ***
diff --git a/jim.h b/jim.h
index 8b75349..dc4adfa 100644
--- a/jim.h
+++ b/jim.h
@@ -143,8 +143,9 @@ extern "C" {
#define JIM_BREAK 3
#define JIM_CONTINUE 4
#define JIM_SIGNAL 5
-#define JIM_EVAL 6
-#define JIM_EXIT 7
+#define JIM_EXIT 6
+/* The following are internal codes and should never been seen/used */
+#define JIM_EVAL 7
#define JIM_ERR_ADDSTACK 8
#define JIM_MAX_NESTING_DEPTH 10000 /* default max nesting depth */
@@ -162,6 +163,9 @@ extern "C" {
/* Unused arguments generate annoying warnings... */
#define JIM_NOTUSED(V) ((void) V)
+/* Flags for Jim_GetEnum() */
+#define JIM_ENUM_ABBREV 2 /* Allow unambiguous abbreviation */
+
/* Flags used by API calls getting a 'nocase' argument. */
#define JIM_CASESENS 0 /* case sensitive */
#define JIM_NOCASE 1 /* no case */
@@ -748,8 +752,7 @@ JIM_EXPORT void Jim_ListAppendElement (Jim_Interp *interp,
Jim_Obj *listPtr, Jim_Obj *objPtr);
JIM_EXPORT void Jim_ListAppendList (Jim_Interp *interp,
Jim_Obj *listPtr, Jim_Obj *appendListPtr);
-JIM_EXPORT void Jim_ListLength (Jim_Interp *interp, Jim_Obj *listPtr,
- int *intPtr);
+JIM_EXPORT int Jim_ListLength (Jim_Interp *interp, Jim_Obj *objPtr);
JIM_EXPORT int Jim_ListIndex (Jim_Interp *interp, Jim_Obj *listPrt,
int index, Jim_Obj **objPtrPtr, int seterr);
JIM_EXPORT int Jim_SetListIndex (Jim_Interp *interp,
@@ -847,6 +850,10 @@ JIM_EXPORT int Jim_LoadLibrary(Jim_Interp *interp, const char *pathName);
/* jim-aio.c */
JIM_EXPORT FILE *Jim_AioFilehandle(Jim_Interp *interp, Jim_Obj *command);
+
+int Jim_IsDict(Jim_Obj *objPtr);
+int Jim_IsList(Jim_Obj *objPtr);
+
#ifdef __cplusplus
}
#endif
diff --git a/jimsh.c b/jimsh.c
index 732bec9..46c4110 100644
--- a/jimsh.c
+++ b/jimsh.c
@@ -18,37 +18,16 @@
* limitations under the License.
*/
-#ifdef WIN32
-#define STRICT
-#define WIN32_LEAN_AND_MEAN
-#include <windows.h>
-#endif /* WIN32 */
-
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
-#define JIM_EMBEDDED
#include "jim.h"
/* JimGetExePath try to get the absolute path of the directory
* of the jim binary, in order to add this path to the library path.
* Likely shipped libraries are in the same path too. */
-
-/* That's simple on windows: */
-#ifdef WIN32
-static Jim_Obj *JimGetExePath(Jim_Interp *interp, const char *argv0)
-{
- char path[MAX_PATH+1], *p;
- JIM_NOTUSED(argv0);
-
- GetModuleFileNameA(NULL, path, MAX_PATH);
- if ((p = strrchr(path, '\\')) != NULL)
- *p = 0;
- return Jim_NewStringObj(interp, path, -1);
-}
-#else /* WIN32 */
#ifndef JIM_ANSIC
/* A bit complex on POSIX */
#include <unistd.h>
@@ -96,7 +75,6 @@ static Jim_Obj *JimGetExePath(Jim_Interp *interp, const char *argv0)
return Jim_NewStringObj(interp, "/usr/local/lib/jim/", -1);
}
#endif /* JIM_ANSIC */
-#endif /* WIN32 */
static void JimLoadJimRc(Jim_Interp *interp)
{
@@ -125,7 +103,7 @@ static void JimSetArgv(Jim_Interp *interp, int argc, char *const argv[])
int n;
Jim_Obj *listObj = Jim_NewListObj(interp, NULL, 0);
- /* Populate argv and argv0 global vars */
+ /* Populate argv global var */
for (n = 0; n < argc; n++) {
Jim_Obj *obj = Jim_NewStringObj(interp, argv[n], -1);
Jim_ListAppendElement(interp, listObj, obj);
diff --git a/make-c-ext.sh b/make-c-ext.sh
index cd9173a..c59af9f 100644
--- a/make-c-ext.sh
+++ b/make-c-ext.sh
@@ -20,11 +20,12 @@ cat <<EOF
#include <jim.h>
int Jim_${basename}Init(Jim_Interp *interp)
{
- return Jim_EvalGlobal(interp,
+ return Jim_Eval_Named(interp,
EOF
-sed -e '/^#/d' -e 's@\\@\\\\@g' -e 's@"@\\"@g' -e 's@^\(.*\)$@"\1\\n"@' $source
+# Note: Keep newlines so that line numbers match in error messages
+sed -e 's/^[ ]*#.*//' -e 's@\\@\\\\@g' -e 's@"@\\"@g' -e 's@^\(.*\)$@"\1\\n"@' $source
#sed -e 's@^\(.*\)$@"\1\\n"@' $source
-echo ");"
+echo ",\"$source\", 1);"
echo "}"
diff --git a/test.tcl b/test.tcl
index ff98d3b..614c3ac 100644
--- a/test.tcl
+++ b/test.tcl
@@ -392,7 +392,7 @@ test lset-4.2 {lset, not compiled, 3 args, bad index} {
list [catch {
eval [list $lset a [list 2a2] w]
} msg] $msg
-} {1 {bad index "2a2": must be integer or end?-integer?}}
+} {1 {bad index "2a2": must be integer?[+-]integer? or end?-integer?}}
test lset-4.3 {lset, not compiled, 3 args, index out of range} {
set a {x y z}
@@ -427,7 +427,7 @@ test lset-4.8 {lset, not compiled, 3 args, bad index} {
list [catch {
eval [list $lset a 2a2 w]
} msg] $msg
-} {1 {bad index "2a2": must be integer or end?-integer?}}
+} {1 {bad index "2a2": must be integer?[+-]integer? or end?-integer?}}
test lset-4.9 {lset, not compiled, 3 args, index out of range} {
set a {x y z}
@@ -563,7 +563,7 @@ test lset-7.10 {lset, not compiled, data sharing} {
test lset-8.3 {lset, not compiled, bad second index} {
set a {{b c} {d e}}
list [catch {eval [list $lset a 0 2a2 f]} msg] $msg
-} {1 {bad index "2a2": must be integer or end?-integer?}}
+} {1 {bad index "2a2": must be integer?[+-]integer? or end?-integer?}}
test lset-8.5 {lset, not compiled, second index out of range} {
set a {{b c} {d e} {f g}}
@@ -833,10 +833,10 @@ test append-2.1 {long appends} {
test append-3.1 {append errors} {
list [catch {append} msg] $msg
} {1 {wrong # args: should be "append varName ?value value ...?"}}
-#test append-3.2 {append errors} {
-# set x ""
-# list [catch {append x(0) 44} msg] $msg
-#} {1 {can't set "x(0)": variable isn't array}}
+test append-3.2 {append errors} {
+ set x 1
+ list [catch {append x(0) 44} msg] $msg
+} {1 {can't set "x(0)": variable isn't array}}
test append-3.3 {append errors} {
catch {unset x}
list [catch {append x} msg] $msg
@@ -955,10 +955,10 @@ test append-5.1 {long lappends} {
test append-6.1 {lappend errors} {
list [catch {lappend} msg] $msg
} {1 {wrong # args: should be "lappend varName ?value value ...?"}}
-#test append-6.2 {lappend errors} {
-# set x ""
-# list [catch {lappend x(0) 44} msg] $msg
-#} {1 {can't set "x(0)": variable isn't array}}
+test append-6.2 {lappend errors} {
+ set x 1
+ list [catch {lappend x(0) 44} msg] $msg
+} {1 {can't set "x(0)": variable isn't array}}
################################################################################
# UPLEVEL
@@ -1100,11 +1100,11 @@ proc unknown args {
error "unknown failed"
}
-rename unknown {}
+test unknown-4.1 {errors in "unknown" procedure} {
+ list [catch {non-existent a b} msg] $msg
+} {1 {unknown failed}}
-#test unknown-4.1 {errors in "unknown" procedure} {
-# list [catch {non-existent a b} msg] $msg $errorCode
-#} {1 {unknown failed} NONE}
+rename unknown {}
################################################################################
# INCR
@@ -1578,7 +1578,7 @@ test lindex-2.2 {singleton index list} {
test lindex-2.4 {malformed index list} {
set x \{
list [catch { eval [list $lindex {a b c} $x] } result] $result
-} {1 bad\ index\ \"\{\":\ must\ be\ integer\ or\ end?-integer?}
+} {1 bad\ index\ \"\{\":\ must\ be\ integer?\[+-\]integer?\ or\ end?-integer?}
# Indices that are integers or convertible to integers
@@ -1637,7 +1637,7 @@ test lindex-4.5 {index = end-3} {
test lindex-4.8 {bad integer, not octal} {
set x end-0a2
list [catch { eval [list $lindex {a b c} $x] } result] $result
-} "1 {bad index \"end-0a2\": must be integer or end?-integer?}"
+} {1 {bad index "end-0a2": must be integer?[+-]integer? or end?-integer?}}
#test lindex-4.9 {incomplete end} {
# set x en
@@ -1647,11 +1647,11 @@ test lindex-4.8 {bad integer, not octal} {
test lindex-4.10 {incomplete end-} {
set x end-
list [catch { eval [list $lindex {a b c} $x] } result] $result
-} "1 {bad index \"end-\": must be integer or end?-integer?}"
+} {1 {bad index "end-": must be integer?[+-]integer? or end?-integer?}}
test lindex-5.1 {bad second index} {
list [catch { eval [list $lindex {a b c} 0 0a2] } result] $result
-} "1 {bad index \"0a2\": must be integer or end?-integer?}"
+} {1 {bad index "0a2": must be integer?[+-]integer? or end?-integer?}}
test lindex-5.2 {good second index} {
eval [list $lindex {{a b c} {d e f} {g h i}} 1 2]
@@ -1701,7 +1701,7 @@ test lindex-10.2 {singleton index list} {
test lindex-10.4 {malformed index list} {
set x \{
list [catch { lindex {a b c} $x } result] $result
-} {1 bad\ index\ \"\{\":\ must\ be\ integer\ or\ end?-integer?}
+} {1 bad\ index\ \"\{\":\ must\ be\ integer?\[+-\]integer?\ or\ end?-integer?}
# Indices that are integers or convertible to integers
@@ -1781,16 +1781,16 @@ test lindex-12.5 {index = end-3} {
test lindex-12.8 {bad integer, not octal} {
set x end-0a2
list [catch { lindex {a b c} $x } result] $result
-} "1 {bad index \"end-0a2\": must be integer or end?-integer?}"
+} {1 {bad index "end-0a2": must be integer?[+-]integer? or end?-integer?}}
test lindex-12.10 {incomplete end-} {
set x end-
list [catch { lindex {a b c} $x } result] $result
-} "1 {bad index \"end-\": must be integer or end?-integer?}"
+} {1 {bad index "end-": must be integer?[+-]integer? or end?-integer?}}
test lindex-13.1 {bad second index} {
list [catch { lindex {a b c} 0 0a2 } result] $result
-} "1 {bad index \"0a2\": must be integer or end?-integer?}"
+} {1 {bad index "0a2": must be integer?[+-]integer? or end?-integer?}}
test lindex-13.2 {good second index} {
catch {
@@ -2038,13 +2038,13 @@ catch {unset x}
# string last
test string-7.1 {string last, too few args} {
list [catch {string last a} msg] $msg
-} {1 {wrong # args: should be "string last subString string ?startIndex?"}}
+} {1 {wrong # args: should be "string last subString string ?index?"}}
test string-7.2 {string last, bad args} {
list [catch {string last a b c} msg] $msg
-} {1 {bad index "c": must be integer or end?-integer?}}
+} {1 {bad index "c": must be integer?[+-]integer? or end?-integer?}}
test string-7.3 {string last, too many args} {
list [catch {string last a b c d} msg] $msg
-} {1 {wrong # args: should be "string last subString string ?startIndex?"}}
+} {1 {wrong # args: should be "string last subString string ?index?"}}
test string-7.5 {string last} {
string last xx xxxx123xx345x678
} 7
@@ -2179,10 +2179,10 @@ test string-11.31 {string match case} {
proc foo {} {string match a A}
foo
} 0
-#test string-11.32 {string match nocase} {
-# proc foo {} {string match -n a A}
-# foo
-#} 1
+test string-11.32 {string match nocase} {
+ proc foo {} {string match -n a A}
+ foo
+} 1
#test string-11.33 {string match nocase} {
# proc foo {} {string match -nocase a\334 A\374}
# foo
@@ -3081,9 +3081,9 @@ test info-1.1 {info body option} {
test info-1.2 {info body option} {
list [catch {info body set} msg] $msg
} {1 {command "set" is not a procedure}}
-#~ test info-1.3 {info body option} {
- #~ list [catch {info args set 1} msg] $msg
-#~ } {1 {wrong # args: should be "info args procname"}}
+test info-1.3 {info body option} {
+ list [catch {info args set 1} msg] $msg
+} {1 {wrong # args: should be "info args procname"}}
test info-1.5 {info body option, returning bytecompiled bodies} {
catch {unset args}
proc foo {args} {
@@ -3095,11 +3095,11 @@ test info-1.5 {info body option, returning bytecompiled bodies} {
foo a
list [catch [info body foo] msg] $msg
} {1 {can't read "args": no such variable}}
-#~ test info-1.6 {info body option, returning list bodies} {
- #~ proc foo args [list subst bar]
- #~ list [string bytelength [info body foo]] \
- #~ [foo; string bytelength [info body foo]]
-#~ } {9 9}
+test info-1.6 {info body option, returning list bodies} {
+ proc foo args [list subst bar]
+ list [string length [info body foo]] \
+ [foo; string length [info body foo]]
+} {9 9}
test info-2.1 {info commands option} {
proc t1 {} {}
proc t2 {} {}
@@ -3387,7 +3387,7 @@ test linsert-2.2 {linsert errors} {
} {1 {wrong # args: should be "linsert list index element ?element ...?"}}
test linsert-2.3 {linsert errors} {
list [catch {linsert a 12x 2} msg] $msg
-} {1 {bad index "12x": must be integer or end?-integer?}}
+} {1 {bad index "12x": must be integer?[+-]integer? or end?-integer?}}
test linsert-3.1 {linsert won't modify shared argument objects} {
proc p {} {
@@ -3498,13 +3498,13 @@ test lreplace-2.2 {lreplace errors} {
} {1 {wrong # args: should be "lreplace list first last ?element element ...?"}}
test lreplace-2.3 {lreplace errors} {
list [catch {lreplace x a 10} msg] $msg
-} {1 {bad index "a": must be integer or end?-integer?}}
+} {1 {bad index "a": must be integer?[+-]integer? or end?-integer?}}
test lreplace-2.4 {lreplace errors} {
list [catch {lreplace x 10 x} msg] $msg
-} {1 {bad index "x": must be integer or end?-integer?}}
+} {1 {bad index "x": must be integer?[+-]integer? or end?-integer?}}
test lreplace-2.5 {lreplace errors} {
list [catch {lreplace x 10 1x} msg] $msg
-} {1 {bad index "1x": must be integer or end?-integer?}}
+} {1 {bad index "1x": must be integer?[+-]integer? or end?-integer?}}
test lreplace-2.6 {lreplace errors} {
list [catch {lreplace x 3 2} msg] $msg
} {1 {list doesn't contain element 3}}
@@ -3548,9 +3548,9 @@ test lrange-1.7 {range of list elements} {
test lrange-1.8 {range of list elements} {
lrange {a b c d e} -2 -1
} {}
-#test lrange-1.9 {range of list elements} {
-# lrange {a b c d e} -2 e
-#} {a b c d e}
+test lrange-1.9 {range of list elements} {
+ lrange {a b c d e} -2 end
+} {a b c d e}
test lrange-1.10 {range of list elements} {
lrange "a b\{c d" 1 2
} "b\\{c d"
@@ -3560,9 +3560,9 @@ test lrange-1.11 {range of list elements} {
test lrange-1.12 {range of list elements} {
lrange "a b c d" end 100000
} d
-#test lrange-1.13 {range of list elements} {
-# lrange "a b c d" e 3
-#} d
+test lrange-1.13 {range of list elements} {
+ lrange "a b c d" end 3
+} d
test lrange-1.14 {range of list elements} {
lrange "a b c d" end 2
} {}
@@ -3581,10 +3581,10 @@ test lrange-2.2 {error conditions} {
} {1 {wrong # args: should be "lrange list first last"}}
test lrange-2.3 {error conditions} {
list [catch {lrange a b 6} msg] $msg
-} {1 {bad index "b": must be integer or end?-integer?}}
+} {1 {bad index "b": must be integer?[+-]integer? or end?-integer?}}
test lrange-2.4 {error conditions} {
list [catch {lrange a 0 enigma} msg] $msg
-} {1 {bad index "enigma": must be integer or end?-integer?}}
+} {1 {bad index "enigma": must be integer?[+-]integer? or end?-integer?}}
#test lrange-2.5 {error conditions} {
# list [catch {lrange "a \{b c" 3 4} msg] $msg
#} {1 {unmatched open brace in list}}
diff --git a/tests/Makefile b/tests/Makefile
index 9ce5451..a0f519c 100644
--- a/tests/Makefile
+++ b/tests/Makefile
@@ -5,3 +5,6 @@ test: $(JIMSH)
../jimsh: ../*.c
make -C .. all
+
+clean:
+ rm -f gorp.file2 cat gorp.file sleep exit wc sh echo
diff --git a/tests/array.test b/tests/array.test
index 6007d2f..a5aada5 100644
--- a/tests/array.test
+++ b/tests/array.test
@@ -65,4 +65,11 @@ test array-1.11 "array unset - all" {
list [array size b] [array exists b]
} {0 0}
+test array-1.12 "array set to invalid variable" {
+ unset -nocomplain a b
+ set a 1
+ catch {array set a(1) {b c}}
+} {1}
+
+
testreport
diff --git a/tests/break.tcl b/tests/break.tcl
new file mode 100644
index 0000000..bf3fdcd
--- /dev/null
+++ b/tests/break.tcl
@@ -0,0 +1 @@
+break
diff --git a/tests/error.test b/tests/error.test
index 3a4b44f..66df7c2 100644
--- a/tests/error.test
+++ b/tests/error.test
@@ -50,4 +50,4 @@ test error-1.2 "Modify stacktrace" {
# Package should be able to invoke exit, which should exit if not caught
test error-2.1 "Exit from package" {
list [catch {package require exitpackage} msg] $msg
-} {7 {Can't load package 'exitpackage'}}
+} {6 {Can't load package 'exitpackage'}}
diff --git a/tests/misc.test b/tests/misc.test
index c5d45e5..53c37eb 100644
--- a/tests/misc.test
+++ b/tests/misc.test
@@ -123,6 +123,83 @@ test lrepeat-1.8 "Errors" {
catch {lrepeat -10 a}
} {1}
-section "unset"
+section "string/list index"
+
+test lindex-1.1 "Integer" {
+ lindex {a b c} 0
+} a
+
+test lindex-1.1 "Integer" {
+ lindex {a b c} 2
+} c
+
+test lindex-1.1 "Integer" {
+ lindex {a b c} -1
+} {}
+
+test lindex-1.1 "Integer" {
+ lindex {a b c} 4
+} {}
+
+test lindex-1.1 "end" {
+ lindex {a b c} end
+} c
+
+test lindex-1.1 "end" {
+ lindex {a b c} end-1
+} b
+
+test lindex-1.1 "end" {
+ lindex {a b c} end-4
+} {}
+
+test lindex-1.1 "end - errors" {
+ catch {lindex {a b c} end-}
+} 1
+
+test lindex-1.1 "end - errors" {
+ catch {lindex {a b c} end-blah}
+} 1
+
+test lindex-1.1 "end - errors" {
+ catch {lindex {a b c} end+1}
+} 1
+
+test lindex-1.1 "int+int, int-int" {
+ lindex {a b c} 0+1
+} b
+
+test lindex-1.1 "int+int, int-int" {
+ lindex {a b c} 0+4
+} {}
+
+test lindex-1.1 "int+int, int-int" {
+ lindex {a b c} 3-1
+} c
+
+test lindex-1.1 "int+int, int-int" {
+ lindex {a b c} 1--1
+} c
+
+test lindex-1.1 "int+int, int-int" {
+ set l {a b c}
+ lindex $l [lsearch $l b]-1
+} a
+
+test lindex-1.1 "int+int - errors" {
+ catch {lindex {a b c} 5+blah}
+} 1
+
+test lindex-1.1 "int+int - errors" {
+ catch {lindex {a b c} 5-blah}
+} 1
+
+test lindex-1.1 "int+int - errors" {
+ catch {lindex {a b c} blah-2}
+} 1
+
+test lindex-1.1 "unary plus" {
+ lindex {a b c} +2
+} c
testreport
diff --git a/tests/return-break.tcl b/tests/return-break.tcl
new file mode 100644
index 0000000..bbc7715
--- /dev/null
+++ b/tests/return-break.tcl
@@ -0,0 +1 @@
+return -code break result
diff --git a/tests/return.test b/tests/return.test
new file mode 100644
index 0000000..3ed659a
--- /dev/null
+++ b/tests/return.test
@@ -0,0 +1,16 @@
+source testing.tcl
+
+# return -code
+
+test return-1.1 {return -code} {
+ set script "return -code 4 result"
+ list [catch {eval $script} msg] $msg
+} {2 result}
+
+test return-1.2 {source file with break} {
+ list [catch {source break.tcl} msg] $msg
+} {3 {}}
+
+test return-1.2 {source file with break} {
+ list [catch {source return-break.tcl} msg] $msg
+} {3 result}
diff --git a/tests/string.test b/tests/string.test
new file mode 100644
index 0000000..2d02ba3
--- /dev/null
+++ b/tests/string.test
@@ -0,0 +1,651 @@
+# Commands covered: string
+#
+# 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: string.test,v 1.23.2.1 2001/04/03 22:54:38 hobbs Exp $
+
+source testing.tcl
+
+# Some tests require the testobj command
+
+test string-1.1 {error conditions} {
+ list [catch {string gorp a b} msg]
+} {1}
+test string-1.2 {error conditions} {
+ list [catch {string} msg]
+} {1}
+
+test string-2.1 {string compare, too few args} {
+ list [catch {string compare a} msg]
+} {1}
+test string-2.2 {string compare, bad args} {
+ list [catch {string compare a b c} msg]
+} {1}
+if {0} {
+test string-2.3 {string compare, bad args} {
+ list [catch {string compare -length -nocase str1 str2} msg]
+} {1}
+test string-2.4 {string compare, too many args} {
+ list [catch {string compare -length 10 -nocase str1 str2 str3} msg]
+} {1}
+test string-2.5 {string compare with length unspecified} {
+ list [catch {string compare -length 10 10} msg]
+} {1}
+}
+test string-2.6 {string compare} {
+ string compare abcde abdef
+} -1
+test string-2.7 {string compare, shortest method name} {
+ string c abcde ABCDE
+} 1
+test string-2.8 {string compare} {
+ string compare abcde abcde
+} 0
+if {0} {
+test string-2.9 {string compare with length} {
+ string compare -length 2 abcde abxyz
+} 0
+test string-2.10 {string compare with special index} {
+ list [catch {string compare -length end-3 abcde abxyz} msg]
+} {1}
+}
+test string-2.12 {string compare, high bit} {
+ # This test will fail if the underlying comparaison
+ # is using signed chars instead of unsigned chars.
+ # (like SunOS's default memcmp thus the compat/memcmp.c)
+ string compare "\x80" "@"
+ # Nb this tests works also in utf8 space because \x80 is
+ # translated into a 2 or more bytelength but whose first byte has
+ # the high bit set.
+} 1
+test string-2.13 {string compare -nocase} {
+ string compare -nocase abcde abdef
+} -1
+test string-2.14 {string compare -nocase} {
+ string c -nocase abcde ABCDE
+} 0
+test string-2.15 {string compare -nocase} {
+ string compare -nocase abcde abcde
+} 0
+if {0} {
+test string-2.16 {string compare -nocase with length} {
+ string compare -length 2 -nocase abcde Abxyz
+} 0
+test string-2.17 {string compare -nocase with length} {
+ string compare -nocase -length 3 abcde Abxyz
+} -1
+test string-2.18 {string compare -nocase with length <= 0} {
+ string compare -nocase -length -1 abcde AbCdEf
+} -1
+test string-2.19 {string compare -nocase with excessive length} {
+ string compare -nocase -length 50 AbCdEf abcde
+} 1
+test string-2.20 {string compare -len unicode} {
+ # These are strings that are 6 BYTELENGTH long, but the length
+ # shouldn't make a different because there are actually 3 CHARS long
+ string compare -len 5 \334\334\334 \334\334\374
+} -1
+test string-2.21 {string compare -nocase with special index} {
+ list [catch {string compare -nocase -length end-3 Abcde abxyz} msg]
+} {1}
+}
+test string-2.22 {string compare, null strings} {
+ string compare "" ""
+} 0
+test string-2.23 {string compare, null strings} {
+ string compare "" foo
+} -1
+test string-2.24 {string compare, null strings} {
+ string compare foo ""
+} 1
+test string-2.25 {string compare -nocase, null strings} {
+ string compare -nocase "" ""
+} 0
+test string-2.26 {string compare -nocase, null strings} {
+ string compare -nocase "" foo
+} -1
+test string-2.27 {string compare -nocase, null strings} {
+ string compare -nocase foo ""
+} 1
+if {0} {
+test string-2.28 {string equal with length, unequal strings} {
+ string compare -length 2 abc abde
+} 0
+test string-2.29 {string equal with length, unequal strings} {
+ string compare -length 2 ab abde
+} 0
+}
+# only need a few tests on equal, since it uses the same code as
+# string compare, but just modifies the return output
+test string-3.1 {string equal} {
+ string equal abcde abdef
+} 0
+test string-3.2 {string equal} {
+ string eq abcde ABCDE
+} 0
+test string-3.3 {string equal} {
+ string equal abcde abcde
+} 1
+if {0} {
+test string-3.4 {string equal -nocase} {
+ string equal -nocase \334\334\334\334\374\374\374\374 \334\334\334\334\334\334\334\334
+} 1
+test string-3.5 {string equal -nocase} {
+ string equal -nocase abcde abdef
+} 0
+test string-3.6 {string equal -nocase} {
+ string eq -nocase abcde ABCDE
+} 1
+test string-3.7 {string equal -nocase} {
+ string equal -nocase abcde abcde
+} 1
+test string-3.8 {string equal with length, unequal strings} {
+ string equal -length 2 abc abde
+} 1
+}
+test string-4.1 {string first, too few args} {
+ list [catch {string first a} msg]
+} {1}
+test string-4.2 {string first, bad args} {
+ list [catch {string first a b c} msg]
+} {1}
+test string-4.3 {string first, too many args} {
+ list [catch {string first a b 5 d} msg]
+} {1}
+test string-4.4 {string first} {
+ string first bq abcdefgbcefgbqrs
+} 12
+test string-4.5 {string first} {
+ string fir bcd abcdefgbcefgbqrs
+} 1
+test string-4.6 {string first} {
+ string f b abcdefgbcefgbqrs
+} 1
+test string-4.7 {string first} {
+ string first xxx x123xx345xxx789xxx012
+} 9
+test string-4.8 {string first} {
+ string first "" x123xx345xxx789xxx012
+} -1
+test string-4.14 {string first, start index} {
+ string first a abcabc end-4
+} 3
+
+test string-5.1 {string index} {
+ list [catch {string index} msg]
+} {1}
+test string-5.2 {string index} {
+ list [catch {string index a b c} msg]
+} {1}
+test string-5.3 {string index} {
+ string index abcde 0
+} a
+test string-5.4 {string index} {
+ string in abcde 4
+} e
+test string-5.5 {string index} {
+ string index abcde 5
+} {}
+test string-5.6 {string index} {
+ list [catch {string index abcde -10} msg]
+} {0}
+test string-5.7 {string index} {
+ list [catch {string index a xyz} msg]
+} {1}
+test string-5.8 {string index} {
+ string index abc end
+} c
+test string-5.9 {string index} {
+ string index abc end-1
+} b
+#test string-5.17 {string index, bad integer} {
+# list [catch {string index "abc" 08} msg]
+#} {1}
+#test string-5.18 {string index, bad integer} {
+# list [catch {string index "abc" end-00289} msg]
+#} {1}
+
+test string-7.1 {string last, too few args} {
+ list [catch {string last a} msg]
+} {1}
+test string-7.2 {string last, bad args} {
+ list [catch {string last a b c} msg]
+} {1}
+test string-7.3 {string last, too many args} {
+ list [catch {string last a b c d} msg]
+} {1}
+test string-7.4 {string last} {
+ string la xxx xxxx123xx345x678
+} 1
+test string-7.5 {string last} {
+ string last xx xxxx123xx345x678
+} 7
+test string-7.6 {string last} {
+ string las x xxxx123xx345x678
+} 12
+test string-7.13 {string last, start index} {
+ ## Constrain to last 'a' should work
+ string last ba badbad end-1
+} 3
+test string-7.14 {string last, start index} {
+ ## Constrain to last 'b' should skip last 'ba'
+ string last ba badbad end-2
+} 0
+test string-7.15 {string last, start index} {
+ string last \334a \334ad\334ad 0
+} -1
+test string-7.16 {string last, start index} {
+ string last \334a \334ad\334ad end-1
+} 3
+
+test string-9.1 {string length} {
+ list [catch {string length} msg]
+} {1}
+test string-9.2 {string length} {
+ list [catch {string length a b} msg]
+} {1}
+test string-9.3 {string length} {
+ string length "a little string"
+} 15
+test string-9.4 {string length} {
+ string le ""
+} 0
+
+test string-10.1 {string map, too few args} {
+ list [catch {string map} msg]
+} {1}
+test string-10.2 {string map, bad args} {
+ list [catch {string map {a b} abba oops} msg]
+} {1}
+test string-10.3 {string map, too many args} {
+ list [catch {string map -nocase {a b} str1 str2} msg]
+} {1}
+test string-10.4 {string map} {
+ string map {a b} abba
+} {bbbb}
+test string-10.5 {string map} {
+ string map {a b} a
+} {b}
+test string-10.6 {string map -nocase} {
+ string map -nocase {a b} Abba
+} {bbbb}
+test string-10.7 {string map} {
+ string map {abc 321 ab * a A} aabcabaababcab
+} {A321*A*321*}
+test string-10.8 {string map -nocase} {
+ string map -nocase {aBc 321 Ab * a A} aabcabaababcab
+} {A321*A*321*}
+#test string-10.9 {string map -nocase} {
+# string map -no {abc 321 Ab * a A} aAbCaBaAbAbcAb
+#} {A321*A*321*}
+test string-10.10 {string map} {
+ list [catch {string map {a b c} abba} msg]
+} {1}
+test string-10.11 {string map, nulls} {
+ string map {\x00 NULL blah \x00nix} {qwerty}
+} {qwerty}
+test string-10.12 {string map, unicode} {
+ string map [list \374 ue UE \334] "a\374ueUE\000EU"
+} aueue\334\0EU
+test string-10.13 {string map, -nocase unicode} {
+ string map -nocase [list \374 ue UE \334] "a\374ueUE\000EU"
+} aue\334\334\0EU
+test string-10.14 {string map, -nocase null arguments} {
+ string map -nocase {{} abc} foo
+} foo
+test string-10.15 {string map, one pair case} {
+ string map -nocase {abc 32} aAbCaBaAbAbcAb
+} {a32aBaAb32Ab}
+test string-10.16 {string map, one pair case} {
+ string map -nocase {ab 4321} aAbCaBaAbAbcAb
+} {a4321C4321a43214321c4321}
+test string-10.17 {string map, one pair case} {
+ string map {Ab 4321} aAbCaBaAbAbcAb
+} {a4321CaBa43214321c4321}
+
+test string-11.1 {string match, too few args} {
+ list [catch {string match a} msg]
+} {1}
+test string-11.2 {string match, too many args} {
+ list [catch {string match a b c d} msg]
+} {1}
+test string-11.3 {string match} {
+ string match abc abc
+} 1
+test string-11.4 {string match} {
+ string mat abc abd
+} 0
+test string-11.5 {string match} {
+ string match ab*c abc
+} 1
+test string-11.6 {string match} {
+ string match ab**c abc
+} 1
+test string-11.7 {string match} {
+ string match ab* abcdef
+} 1
+test string-11.8 {string match} {
+ string match *c abc
+} 1
+test string-11.9 {string match} {
+ string match *3*6*9 0123456789
+} 1
+test string-11.10 {string match} {
+ string match *3*6*9 01234567890
+} 0
+test string-11.11 {string match} {
+ string match a?c abc
+} 1
+test string-11.12 {string match} {
+ string match a??c abc
+} 0
+test string-11.13 {string match} {
+ string match ?1??4???8? 0123456789
+} 1
+test string-11.14 {string match} {
+ string match {[abc]bc} abc
+} 1
+test string-11.15 {string match} {
+ string match {a[abc]c} abc
+} 1
+test string-11.16 {string match} {
+ string match {a[xyz]c} abc
+} 0
+test string-11.17 {string match} {
+ string match {12[2-7]45} 12345
+} 1
+test string-11.18 {string match} {
+ string match {12[ab2-4cd]45} 12345
+} 1
+test string-11.19 {string match} {
+ string match {12[ab2-4cd]45} 12b45
+} 1
+test string-11.20 {string match} {
+ string match {12[ab2-4cd]45} 12d45
+} 1
+test string-11.21 {string match} {
+ string match {12[ab2-4cd]45} 12145
+} 0
+test string-11.22 {string match} {
+ string match {12[ab2-4cd]45} 12545
+} 0
+test string-11.23 {string match} {
+ string match {a\*b} a*b
+} 1
+test string-11.24 {string match} {
+ string match {a\*b} ab
+} 0
+test string-11.25 {string match} {
+ string match {a\*\?\[\]\\\x} "a*?\[\]\\x"
+} 1
+test string-11.26 {string match} {
+ string match ** ""
+} 1
+test string-11.27 {string match} {
+ string match *. ""
+} 0
+test string-11.28 {string match} {
+ string match "" ""
+} 1
+test string-11.29 {string match} {
+ string match \[a a
+} 1
+test string-11.30 {string match, bad args} {
+ list [catch {string match - b c} msg]
+} {1}
+test string-11.31 {string match case} {
+ string match a A
+} 0
+test string-11.32 {string match nocase} {
+ string match -nocase a A
+} 1
+test string-11.34 {string match nocase} {
+ string match -nocase a*f ABCDEf
+} 1
+test string-11.35 {string match case, false hope} {
+ # This is true because '_' lies between the A-Z and a-z ranges
+ string match {[A-z]} _
+} 1
+test string-11.36 {string match nocase range} {
+ # This is false because although '_' lies between the A-Z and a-z ranges,
+ # we lower case the end points before checking the ranges.
+ string match -nocase {[A-z]} _
+} 0
+test string-11.37 {string match nocase} {
+ string match -nocase {[A-fh-Z]} g
+} 0
+test string-11.38 {string match case, reverse range} {
+ string match {[A-fh-Z]} g
+} 1
+test string-11.39 {string match, *\ case} {
+ string match {*\abc} abc
+} 1
+test string-11.40 {string match, *special case} {
+ string match {*[ab]} abc
+} 0
+test string-11.41 {string match, *special case} {
+ string match {*[ab]*} abc
+} 1
+# XXX: I don't see why this shouldn't match. Changed result
+test string-11.42 {string match, *special case} {
+ string match "*\\" "\\"
+} 1
+test string-11.43 {string match, *special case} {
+ string match "*\\\\" "\\"
+} 1
+test string-11.44 {string match, *special case} {
+ string match "*???" "12345"
+} 1
+test string-11.45 {string match, *special case} {
+ string match "*???" "12"
+} 0
+test string-11.46 {string match, *special case} {
+ string match "*\\*" "abc*"
+} 1
+test string-11.47 {string match, *special case} {
+ string match "*\\*" "*"
+} 1
+test string-11.48 {string match, *special case} {
+ string match "*\\*" "*abc"
+} 0
+test string-11.49 {string match, *special case} {
+ string match "?\\*" "a*"
+} 1
+# XXX: I don't see why this shouldn't match. Changed result
+test string-11.50 {string match, *special case} {
+ string match "\\" "\\"
+} 1
+
+
+test string-12.1 {string range} {
+ list [catch {string range} msg]
+} {1}
+test string-12.2 {string range} {
+ list [catch {string range a 1} msg]
+} {1}
+test string-12.3 {string range} {
+ list [catch {string range a 1 2 3} msg]
+} {1}
+test string-12.4 {string range} {
+ string range abcdefghijklmnop 2 14
+} {cdefghijklmno}
+test string-12.5 {string range, last > length} {
+ string range abcdefghijklmnop 7 1000
+} {hijklmnop}
+test string-12.6 {string range} {
+ string range abcdefghijklmnop 10 end
+} {klmnop}
+test string-12.7 {string range, last < first} {
+ string range abcdefghijklmnop 10 9
+} {}
+test string-12.8 {string range, first < 0} {
+ string range abcdefghijklmnop -3 2
+} {abc}
+test string-12.9 {string range} {
+ string range abcdefghijklmnop -3 -2
+} {}
+test string-12.10 {string range} {
+ string range abcdefghijklmnop 1000 1010
+} {}
+test string-12.11 {string range} {
+ string range abcdefghijklmnop -100 end
+} {abcdefghijklmnop}
+test string-12.12 {string range} {
+ list [catch {string range abc abc 1} msg]
+} {1}
+test string-12.13 {string range} {
+ list [catch {string range abc 1 eof} msg]
+} {1}
+test string-12.14 {string range} {
+ string range abcdefghijklmnop end-1 end
+} {op}
+test string-12.15 {string range} {
+ string range abcdefghijklmnop end 1000
+} {p}
+test string-12.16 {string range} {
+ string range abcdefghijklmnop end end-1
+} {}
+
+test string-13.1 {string repeat} {
+ list [catch {string repeat} msg]
+} {1}
+test string-13.2 {string repeat} {
+ list [catch {string repeat abc 10 oops} msg]
+} {1}
+test string-13.3 {string repeat} {
+ string repeat {} 100
+} {}
+test string-13.4 {string repeat} {
+ string repeat { } 5
+} { }
+test string-13.5 {string repeat} {
+ string repeat abc 3
+} {abcabcabc}
+test string-13.6 {string repeat} {
+ string repeat abc -1
+} {}
+test string-13.7 {string repeat} {
+ list [catch {string repeat abc end} msg]
+} {1}
+test string-13.8 {string repeat} {
+ string repeat {} -1000
+} {}
+test string-13.9 {string repeat} {
+ string repeat {} 0
+} {}
+test string-13.10 {string repeat} {
+ string repeat def 0
+} {}
+test string-13.11 {string repeat} {
+ string repeat def 1
+} def
+test string-13.12 {string repeat} {
+ string repeat ab\u7266cd 3
+} ab\u7266cdab\u7266cdab\u7266cd
+test string-13.13 {string repeat} {
+ string repeat \x00 3
+} \x00\x00\x00
+
+
+test string-15.1 {string tolower too few args} {
+ list [catch {string tolower} msg]
+} {1}
+test string-15.2 {string tolower bad args} {
+ list [catch {string tolower a b} msg]
+} {1}
+test string-15.3 {string tolower too many args} {
+ list [catch {string tolower ABC 1 end oops} msg]
+} {1}
+test string-15.4 {string tolower} {
+ string tolower ABCDeF
+} {abcdef}
+test string-15.5 {string tolower} {
+ string tolower "ABC XyZ"
+} {abc xyz}
+test string-15.6 {string tolower} {
+ string tolower {123#$&*()}
+} {123#$&*()}
+
+test string-16.1 {string toupper} {
+ list [catch {string toupper} msg]
+} {1}
+test string-16.2 {string toupper} {
+ list [catch {string toupper a b} msg]
+} {1}
+test string-16.4 {string toupper} {
+ string toupper abCDEf
+} {ABCDEF}
+test string-16.5 {string toupper} {
+ string toupper "abc xYz"
+} {ABC XYZ}
+test string-16.6 {string toupper} {
+ string toupper {123#$&*()}
+} {123#$&*()}
+
+test string-18.1 {string trim} {
+ list [catch {string trim} msg]
+} {1}
+test string-18.2 {string trim} {
+ list [catch {string trim a b c} msg]
+} {1}
+test string-18.3 {string trim} {
+ string trim " XYZ "
+} {XYZ}
+test string-18.4 {string trim} {
+ string trim "\t\nXYZ\t\n\r\n"
+} {XYZ}
+test string-18.5 {string trim} {
+ string trim " A XYZ A "
+} {A XYZ A}
+test string-18.6 {string trim} {
+ string trim "XXYYZZABC XXYYZZ" ZYX
+} {ABC }
+test string-18.7 {string trim} {
+ string trim " \t\r "
+} {}
+test string-18.8 {string trim} {
+ string trim {abcdefg} {}
+} {abcdefg}
+test string-18.9 {string trim} {
+ string trim {}
+} {}
+test string-18.10 {string trim} {
+ string trim ABC DEF
+} {ABC}
+test string-18.11 {string trim, unicode} {
+ string trim "\xe7\xe8 AB\xe7C \xe8\xe7" \xe7\xe8
+} " AB\xe7C "
+
+test string-19.1 {string trimleft} {
+ list [catch {string trimleft} msg]
+} {1}
+test string-19.2 {string trimleft} {
+ string trimleft " XYZ "
+} {XYZ }
+
+test string-20.1 {string trimright errors} {
+ list [catch {string trimright} msg]
+} {1}
+test string-20.2 {string trimright errors} {
+ list [catch {string trimg a} msg]
+} {1}
+test string-20.3 {string trimright} {
+ string trimright " XYZ "
+} { XYZ}
+test string-20.4 {string trimright} {
+ string trimright " "
+} {}
+test string-20.5 {string trimright} {
+ string trimright ""
+} {}
+
+testreport
diff --git a/tests/testing.tcl b/tests/testing.tcl
index f3cf672..221d6be 100644
--- a/tests/testing.tcl
+++ b/tests/testing.tcl
@@ -15,11 +15,27 @@ proc filecopy {read write} {
collect
}
+proc makeFile {contents name} {
+ set f [open $name w]
+ puts $f $contents
+ close $f
+}
+
+catch {
+ # Tcl-only things
+ info tclversion
+ proc errorInfo {msg} {
+ return $::errorInfo
+ }
+}
+
proc section {name} {
puts "-- $name ----------------"
}
-array set testresults {numfail 0 numpass 0 failed {}}
+set testresults(numfail) 0
+set testresults(numpass) 0
+set testresults(failed) {}
proc test {id descr script expected} {
puts -nonewline "$id "
generated by cgit v1.1 at 2024-07-20 00:23:12 +0000