aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorSteve Bennett <steveb@workware.net.au>2010-01-24 10:26:24 +1000
committerSteve Bennett <steveb@workware.net.au>2010-10-15 11:02:38 +1000
commit1df9b19429212012b245a88b08ab37caef564d1c (patch)
treee48d6153d5cde43723f2729d92e0b75d7e848ea1
parentc4ec906079ac99fe52e8c4b27036ca0f2495848f (diff)
downloadjimtcl-1df9b19429212012b245a88b08ab37caef564d1c.zip
jimtcl-1df9b19429212012b245a88b08ab37caef564d1c.tar.gz
jimtcl-1df9b19429212012b245a88b08ab37caef564d1c.tar.bz2
Implement some new features
Implement 'lreplace' Implement 'string last' Implement 'pid' Implement 'info procs' Implement 'info script' Implement 'info patchlevel' as an alias for 'info version' Implement syslog extensions for jim Fix return code display in jim-interactive.c Make jim more compatible if JIM_TCL_COMPAT is set *: Use tcl_interactive rather than jim_interactive *: Use auto_path rather than jim_libpath Add "." to the lib search path, not "./" Fix a couple of files with CRLF line endings
-rwxr-xr-xconfigure2
-rw-r--r--configure.ac2
-rw-r--r--glob.tcl266
-rw-r--r--jim-interactive.c4
-rw-r--r--jim-load.c2
-rw-r--r--jim-package.c4
-rw-r--r--jim-posix.c12
-rw-r--r--jim-syslog.c199
-rw-r--r--jim.c200
-rw-r--r--jim.h10
-rw-r--r--jimsh.c8
-rw-r--r--test.tcl140
-rw-r--r--tools/benchtable.tcl5
13 files changed, 671 insertions, 183 deletions
diff --git a/configure b/configure
index 8812719..2a6b066 100755
--- a/configure
+++ b/configure
@@ -2738,7 +2738,7 @@ if test "${with_jim_ext+set}" = set; then
withval=$with_jim_ext;
if test "x$withval" != "xno" ; then
if test "x$withval" = "xall" ; then
- jim_extensions="package readdir glob array clock exec file posix regexp signal tcl6 eventloop aio"
+ jim_extensions="package readdir glob array clock exec file posix regexp signal tcl6 eventloop aio syslog"
else
jim_extensions="$withval"
fi
diff --git a/configure.ac b/configure.ac
index 9f7be8b..d5e3048 100644
--- a/configure.ac
+++ b/configure.ac
@@ -27,7 +27,7 @@ AC_ARG_WITH(jim-ext,
[
if test "x$withval" != "xno" ; then
if test "x$withval" = "xall" ; then
- jim_extensions="package readdir glob array clock exec file posix regexp signal tcl6 eventloop aio"
+ jim_extensions="package readdir glob array clock exec file posix regexp signal tcl6 eventloop aio syslog"
else
jim_extensions="$withval"
fi
diff --git a/glob.tcl b/glob.tcl
index ed96949..02da2c3 100644
--- a/glob.tcl
+++ b/glob.tcl
@@ -1,133 +1,133 @@
-# (c) 2008 Steve Bennett <steveb@workware.net.au>
-#
-# 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
-package require readdir
-
-# If $dir is a directory, return a list of all entries
-# it contains which match $pattern
-#
-proc _glob_readdir_pattern {dir pattern} {
- set result {}
-
- # readdir doesn't return . or .., so simulate it here
- if {$pattern eq "." || $pattern eq ".."} {
- return $pattern
- }
- # Use -nocomplain here to return nothing if $dir is not a directory
- foreach name [readdir -nocomplain $dir] {
- if {[string match $pattern $name]} {
- lappend result $name
- }
- }
-
- return $result
-}
-
-# glob entries in directory $dir and pattern $rem
-#
-proc _glob_do {dir rem} {
- # Take one level from rem
- # Avoid regexp here
- set i [string first / $rem]
- if {$i < 0} {
- 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]
- }
-
- # Determine the appropriate separator and globbing dir
- set sep /
- set globdir $dir
- if {[string match "*/" $dir]} {
- set sep ""
- } elseif {$dir eq ""} {
- set globdir .
- set sep ""
- }
-
- set result {}
-
- # Use readdir and select all files which match the pattern
- foreach f [_glob_readdir_pattern $globdir $pattern] {
- if {$rempattern eq ""} {
- # This is a terminal entry, so add it
- lappend result $dir$sep$f
- } else {
- # Expany any entries at this level and add them
- lappend result {expand}[_glob_do $dir$sep$f $rempattern]
- }
- }
- return $result
-}
-
-# Implements the Tcl glob command
-#
-# Usage: glob ?-nocomplain? pattern ...
-#
-# Patterns use string match pattern matching for each
-# directory level.
-#
-# e.g. glob te[a-e]*/*.tcl
-#
-proc glob {args} {
- set nocomplain 0
-
- if {[lindex $args 0] eq "-nocomplain"} {
- set nocomplain 1
- set args [lrange $args 1 end]
- }
-
- set result {}
- foreach pattern $args {
- if {$pattern eq "/"} {
- lappend result /
- } elseif {[string match "/*" $pattern]} {
- lappend result {expand}[_glob_do / [string range $pattern 1 end]]
- } else {
- lappend result {expand}[_glob_do "" $pattern]
- }
- }
-
- if {$nocomplain == 0 && [llength $result] == 0} {
- error "no files matched glob patterns"
- }
-
- return $result
-}
+# (c) 2008 Steve Bennett <steveb@workware.net.au>
+#
+# 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
+package require readdir
+
+# If $dir is a directory, return a list of all entries
+# it contains which match $pattern
+#
+proc _glob_readdir_pattern {dir pattern} {
+ set result {}
+
+ # readdir doesn't return . or .., so simulate it here
+ if {$pattern eq "." || $pattern eq ".."} {
+ return $pattern
+ }
+ # Use -nocomplain here to return nothing if $dir is not a directory
+ foreach name [readdir -nocomplain $dir] {
+ if {[string match $pattern $name]} {
+ lappend result $name
+ }
+ }
+
+ return $result
+}
+
+# glob entries in directory $dir and pattern $rem
+#
+proc _glob_do {dir rem} {
+ # Take one level from rem
+ # Avoid regexp here
+ set i [string first / $rem]
+ if {$i < 0} {
+ 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]
+ }
+
+ # Determine the appropriate separator and globbing dir
+ set sep /
+ set globdir $dir
+ if {[string match "*/" $dir]} {
+ set sep ""
+ } elseif {$dir eq ""} {
+ set globdir .
+ set sep ""
+ }
+
+ set result {}
+
+ # Use readdir and select all files which match the pattern
+ foreach f [_glob_readdir_pattern $globdir $pattern] {
+ if {$rempattern eq ""} {
+ # This is a terminal entry, so add it
+ lappend result $dir$sep$f
+ } else {
+ # Expany any entries at this level and add them
+ lappend result {expand}[_glob_do $dir$sep$f $rempattern]
+ }
+ }
+ return $result
+}
+
+# Implements the Tcl glob command
+#
+# Usage: glob ?-nocomplain? pattern ...
+#
+# Patterns use string match pattern matching for each
+# directory level.
+#
+# e.g. glob te[a-e]*/*.tcl
+#
+proc glob {args} {
+ set nocomplain 0
+
+ if {[lindex $args 0] eq "-nocomplain"} {
+ set nocomplain 1
+ set args [lrange $args 1 end]
+ }
+
+ set result {}
+ foreach pattern $args {
+ if {$pattern eq "/"} {
+ lappend result /
+ } elseif {[string match "/*" $pattern]} {
+ lappend result {expand}[_glob_do / [string range $pattern 1 end]]
+ } else {
+ lappend result {expand}[_glob_do "" $pattern]
+ }
+ }
+
+ if {$nocomplain == 0 && [llength $result] == 0} {
+ error "no files matched glob patterns"
+ }
+
+ return $result
+}
diff --git a/jim-interactive.c b/jim-interactive.c
index 89b133a..d1108ae 100644
--- a/jim-interactive.c
+++ b/jim-interactive.c
@@ -8,12 +8,12 @@ int Jim_InteractivePrompt(Jim_Interp *interp)
printf("Welcome to Jim version %d.%d, "
"Copyright (c) 2005-8 Salvatore Sanfilippo" JIM_NL,
JIM_VERSION / 100, JIM_VERSION % 100);
- Jim_SetVariableStrWithStr(interp, "jim_interactive", "1");
+ Jim_SetVariableStrWithStr(interp, JIM_INTERACTIVE, "1");
while (1) {
char buf[1024];
const char *result;
const char *retcodestr[] = {
- "ok", "error", "return", "break", "continue", "eval", "exit"
+ "ok", "error", "return", "break", "continue", "signal", "eval", "exit"
};
int reslen;
diff --git a/jim-load.c b/jim-load.c
index ebd6b63..9c46c1e 100644
--- a/jim-load.c
+++ b/jim-load.c
@@ -38,7 +38,7 @@ int Jim_LoadLibrary(Jim_Interp *interp, const char *pathName)
void *handle;
int (*onload)(Jim_Interp *interp);
- libPathObjPtr = Jim_GetGlobalVariableStr(interp, "jim_libpath", JIM_NONE);
+ libPathObjPtr = Jim_GetGlobalVariableStr(interp, JIM_LIBPATH, JIM_NONE);
if (libPathObjPtr == NULL) {
prefixc = 0;
libPathObjPtr = NULL;
diff --git a/jim-package.c b/jim-package.c
index d963b4d..3dad306 100644
--- a/jim-package.c
+++ b/jim-package.c
@@ -48,7 +48,7 @@ static char *JimFindPackage(Jim_Interp *interp, char **prefixes,
return NULL;
}
-/* Search for a suitable package under every dir specified by jim_libpath
+/* Search for a suitable package under every dir specified by JIM_LIBPATH,
* and load it if possible. If a suitable package was loaded with success
* JIM_OK is returned, otherwise JIM_ERR is returned. */
static int JimLoadPackage(Jim_Interp *interp, const char *name, int flags)
@@ -57,7 +57,7 @@ static int JimLoadPackage(Jim_Interp *interp, const char *name, int flags)
char **prefixes, *path;
int prefixc, i, retCode = JIM_ERR;
- libPathObjPtr = Jim_GetGlobalVariableStr(interp, "jim_libpath", JIM_NONE);
+ libPathObjPtr = Jim_GetGlobalVariableStr(interp, JIM_LIBPATH, JIM_NONE);
if (libPathObjPtr == NULL) {
prefixc = 0;
libPathObjPtr = NULL;
diff --git a/jim-posix.c b/jim-posix.c
index 9a81a55..a7dba75 100644
--- a/jim-posix.c
+++ b/jim-posix.c
@@ -88,6 +88,17 @@ static int Jim_PosixGethostnameCommand(Jim_Interp *interp, int argc,
return JIM_OK;
}
+static int Jim_PosixPidCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
+{
+ if (argc != 1) {
+ Jim_WrongNumArgs(interp, 1, argv, "");
+ return JIM_ERR;
+ }
+
+ Jim_SetResultInt(interp, getpid());
+ return JIM_OK;
+}
+
// end added
int Jim_posixInit(Jim_Interp *interp)
{
@@ -96,5 +107,6 @@ int Jim_posixInit(Jim_Interp *interp)
Jim_CreateCommand(interp, "os.fork", Jim_PosixForkCommand, NULL, NULL);
Jim_CreateCommand(interp, "os.getids", Jim_PosixGetidsCommand, NULL, NULL);
Jim_CreateCommand(interp, "os.gethostname", Jim_PosixGethostnameCommand, NULL, NULL);
+ Jim_CreateCommand(interp, "pid", Jim_PosixPidCommand, NULL, NULL);
return JIM_OK;
}
diff --git a/jim-syslog.c b/jim-syslog.c
new file mode 100644
index 0000000..4a039ef
--- /dev/null
+++ b/jim-syslog.c
@@ -0,0 +1,199 @@
+/* Syslog interface for tcl
+ * Copyright Victor Wagner <vitus@ice.ru> at
+ * http://www.ice.ru/~vitus/works/tcl.html#syslog
+ *
+ * Slightly modified by Steve Bennett <steveb@snapgear.com>
+ * Ported to Jim by Steve Bennett <steveb@workware.net.au>
+ */
+#include <jim.h>
+#include <syslog.h>
+#include <string.h>
+
+typedef struct {
+ int logOpened;
+ int facility;
+ int options;
+ char ident[32];
+} SyslogInfo;
+
+#ifndef LOG_AUTHPRIV
+# define LOG_AUTHPRIV LOG_AUTH
+#endif
+
+static const char *facilities[] = {
+ [LOG_AUTHPRIV] = "authpriv",
+ [LOG_CRON] = "cron",
+ [LOG_DAEMON] = "daemon",
+ [LOG_KERN] = "kernel",
+ [LOG_LPR] = "lpr",
+ [LOG_MAIL] = "mail",
+ [LOG_NEWS] = "news",
+ [LOG_SYSLOG] = "syslog",
+ [LOG_USER] = "user",
+ [LOG_UUCP] = "uucp",
+ [LOG_LOCAL0] = "local0",
+ [LOG_LOCAL1] = "local1",
+ [LOG_LOCAL2] = "local2",
+ [LOG_LOCAL3] = "local3",
+ [LOG_LOCAL4] = "local4",
+ [LOG_LOCAL5] = "local5",
+ [LOG_LOCAL6] = "local6",
+ [LOG_LOCAL7] = "local7",
+};
+
+static const char *priorities[] = {
+ [LOG_EMERG] = "emerg",
+ [LOG_ALERT] = "alert",
+ [LOG_CRIT] = "crit",
+ [LOG_ERR] = "err",
+ [LOG_ERR] = "error",
+ [LOG_WARNING] = "warning",
+ [LOG_NOTICE] = "notice",
+ [LOG_INFO] = "info",
+ [LOG_DEBUG] = "debug",
+};
+
+/**
+ * Find a matching name in the array of the given length.
+ *
+ * NULL entries are ignored.
+ *
+ * Returns the matching index if found, or -1 if not.
+ */
+static int find_by_name(const char *name, const char *array[], size_t len)
+{
+ int i;
+ for (i = 0; i < len; i++) {
+ if (array[i] && strcmp(array[i], name) == 0) {
+ return i;
+ }
+ }
+ return -1;
+}
+
+/**
+ * Deletes the syslog command.
+ */
+static void Jim_SyslogCmdDelete(Jim_Interp *interp, void *privData)
+{
+ SyslogInfo *info=(SyslogInfo *)privData;
+ if (info->logOpened) {
+ closelog();
+ }
+ Jim_Free(info);
+}
+
+/* Syslog_Log -
+ * implements syslog tcl command. General format: syslog ?options? level text
+ * options -facility -ident -options
+ *
+ * syslog ?-facility cron|daemon|...? ?-ident string? ?-options int? ?debug|info|...? text
+ */
+int
+Jim_SyslogCmd (Jim_Interp *interp, int argc, Jim_Obj *const *argv)
+{
+ int priority = LOG_INFO;
+ int i=1;
+ SyslogInfo *info = Jim_CmdPrivData(interp);
+
+ if (argc <= 1) {
+wrongargs:
+ Jim_WrongNumArgs(interp, 1, argv, "?-facility cron|daemon|...? ?-ident string? ?-options int? ?debug|info|...? message");
+ return JIM_ERR;
+ }
+ while (i < argc-1) {
+ if (Jim_CompareStringImmediate(interp, argv[i], "-facility")) {
+ int entry = find_by_name(Jim_GetString(argv[i + 1], NULL), facilities, sizeof(facilities) / sizeof(*facilities));
+ if (entry < 0) {
+ Jim_SetResultString(interp, "Unknown facility", -1);
+ return JIM_ERR;
+ }
+ if (info->facility != entry) {
+ info->facility = entry;
+ if (info->logOpened) {
+ closelog();
+ info->logOpened=0;
+ }
+ }
+ }
+ else if (Jim_CompareStringImmediate(interp, argv[i], "-options")) {
+ long tmp;
+ if (Jim_GetLong(interp, argv[i+1], &tmp) == JIM_ERR) {
+ return JIM_ERR;
+ }
+ info->options = tmp;
+ if (info->logOpened) {
+ closelog();
+ info->logOpened=0;
+ }
+ continue;
+ }
+ else if (Jim_CompareStringImmediate(interp, argv[i], "-ident")) {
+ strncpy(info->ident, Jim_GetString(argv[i+1], NULL), sizeof(info->ident));
+ info->ident[sizeof(info->ident) - 1] = 0;
+ if (info->logOpened) {
+ closelog();
+ info->logOpened=0;
+ }
+ }
+ else {
+ break;
+ }
+ i += 2;
+ }
+
+ /* There should be either 0, 1 or 2 args left */
+ if (i == argc) {
+ /* No args, but they have set some options, so OK */
+ return JIM_OK;
+ }
+
+ if (i<argc-1) {
+ priority = find_by_name(Jim_GetString(argv[i], NULL), priorities, sizeof(priorities) / sizeof(*priorities));
+ if (priority < 0) {
+ Jim_SetResultString(interp, "Unknown priority", -1);
+ return JIM_ERR;
+ }
+ i++;
+ }
+
+ if (i != argc - 1) {
+ goto wrongargs;
+ }
+ if (!info->logOpened) {
+ if (!info->ident[0]) {
+ Jim_Obj *argv0 = Jim_GetGlobalVariableStr(interp, "argv0", JIM_NONE);
+ if (argv0) {
+ strncpy(info->ident, Jim_GetString(argv0, NULL), sizeof(info->ident));
+ } else {
+ strcpy(info->ident,"Tcl script");
+ }
+ info->ident[sizeof(info->ident) - 1] = 0;
+ }
+ openlog(info->ident, info->options, info->facility);
+ info->logOpened=1;
+ }
+ syslog(priority, "%s", Jim_GetString(argv[i], NULL));
+
+ return JIM_OK;
+}
+
+int Jim_syslogInit(Jim_Interp *interp)
+{
+ SyslogInfo *info;
+
+ if (Jim_PackageProvide(interp, "syslog", "1.0", JIM_ERRMSG) != JIM_OK) {
+ return JIM_ERR;
+ }
+
+ info = Jim_Alloc(sizeof(*info));
+
+ info->logOpened=0;
+ info->options=0;
+ info->facility=LOG_USER;
+ info->ident[0] = 0;
+
+ Jim_CreateCommand(interp, "syslog", Jim_SyslogCmd, info, Jim_SyslogCmdDelete);
+
+ return JIM_OK;
+}
diff --git a/jim.c b/jim.c
index cfb54c6..60b353f 100644
--- a/jim.c
+++ b/jim.c
@@ -389,6 +389,26 @@ 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)
+{
+ 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) {
+ return p - s2;
+ }
+ }
+ return -1;
+}
+
int Jim_WideToString(char *buf, jim_wide wideValue)
{
const char *fmt = "%" JIM_WIDE_MODIFIER;
@@ -3210,7 +3230,7 @@ int Jim_CreateProcedure(Jim_Interp *interp, const char *cmdName,
Jim_InitHashTable(cmdPtr->staticVars, &JimVariablesHashTableType,
interp);
for (i = 0; i < len; i++) {
- Jim_Obj *objPtr, *initObjPtr, *nameObjPtr;
+ Jim_Obj *objPtr = 0, *initObjPtr = 0, *nameObjPtr = 0;
Jim_Var *varPtr;
int subLen;
@@ -4393,7 +4413,6 @@ Jim_Interp *Jim_CreateInterp(void)
i->procEpoch = 0;
i->callFrameEpoch = 0;
i->liveList = i->freeList = NULL;
- i->scriptFileName = Jim_StrDup("");
i->referenceNextId = 0;
i->lastCollectId = 0;
i->lastCollectTime = time(NULL);
@@ -4420,15 +4439,17 @@ Jim_Interp *Jim_CreateInterp(void)
i->stackTrace = Jim_NewListObj(i, NULL, 0);
i->unknown = Jim_NewStringObj(i, "unknown", -1);
i->unknown_called = 0;
+ i->currentScriptObj = Jim_NewEmptyStringObj(i);
Jim_IncrRefCount(i->emptyObj);
Jim_IncrRefCount(i->result);
Jim_IncrRefCount(i->stackTrace);
Jim_IncrRefCount(i->unknown);
+ Jim_IncrRefCount(i->currentScriptObj);
/* Initialize key variables every interpreter should contain */
- pathPtr = Jim_NewStringObj(i, "./", -1);
- Jim_SetVariableStr(i, "jim_libpath", pathPtr);
- Jim_SetVariableStrWithStr(i, "jim_interactive", "0");
+ pathPtr = Jim_NewStringObj(i, ".", -1);
+ Jim_SetVariableStr(i, JIM_LIBPATH, pathPtr);
+ Jim_SetVariableStrWithStr(i, JIM_INTERACTIVE, "0");
return i;
}
@@ -4452,7 +4473,7 @@ void Jim_FreeInterp(Jim_Interp *i)
Jim_DecrRefCount(i, i->stackTrace);
Jim_DecrRefCount(i, i->unknown);
Jim_Free((void*)i->errorFileName);
- Jim_Free((void*)i->scriptFileName);
+ Jim_DecrRefCount(i, i->currentScriptObj);
Jim_FreeHashTable(&i->commands);
Jim_FreeHashTable(&i->references);
Jim_FreeHashTable(&i->assocData);
@@ -7737,7 +7758,7 @@ Jim_Obj *Jim_ScanString(Jim_Interp *interp, Jim_Obj *strObjPtr,
int scanned = 1;
const char *str = Jim_GetString(strObjPtr, 0);
Jim_Obj *resultList = 0;
- Jim_Obj **resultVec;
+ Jim_Obj **resultVec = 0;
int resultc;
Jim_Obj *emptyStr = 0;
ScanFmtStringObj *fmtObj;
@@ -8362,9 +8383,9 @@ int JimCallProcedure(Jim_Interp *interp, Jim_Cmd *cmd, int argc,
}
for (i = 0; i < num_args; i++) {
- Jim_Obj *argObjPtr;
- Jim_Obj *nameObjPtr;
- Jim_Obj *valueObjPtr;
+ Jim_Obj *argObjPtr = 0;
+ Jim_Obj *nameObjPtr = 0;
+ Jim_Obj *valueObjPtr = 0;
Jim_ListIndex(interp, cmd->argListObjPtr, i, &argObjPtr, JIM_NONE);
if (i + 1 >= cmd->arityMin) {
@@ -8388,7 +8409,7 @@ int JimCallProcedure(Jim_Interp *interp, Jim_Cmd *cmd, int argc,
}
/* Set optional arguments */
if (cmd->arityMax == -1) {
- Jim_Obj *listObjPtr, *objPtr;
+ Jim_Obj *listObjPtr, *objPtr = 0;
i++;
listObjPtr = Jim_NewListObj(interp, argv+i, argc-i);
@@ -8437,10 +8458,20 @@ int Jim_Eval_Named(Jim_Interp *interp, const char *script, const char *filename,
if( filename ){
+ Jim_Obj *prevScriptObj;
+
JimSetSourceInfo( interp, scriptObjPtr, filename, lineno );
- }
- retval = Jim_EvalObj(interp, scriptObjPtr);
+ prevScriptObj = interp->currentScriptObj;
+ interp->currentScriptObj = scriptObjPtr;
+
+ retval = Jim_EvalObj(interp, scriptObjPtr);
+
+ interp->currentScriptObj = prevScriptObj;
+ }
+ else {
+ retval = Jim_EvalObj(interp, scriptObjPtr);
+ }
Jim_DecrRefCount(interp, scriptObjPtr);
return retval;
}
@@ -8500,6 +8531,7 @@ int Jim_EvalFile(Jim_Interp *interp, const char *filename)
FILE *fp;
char *buf;
Jim_Obj *scriptObjPtr;
+ Jim_Obj *prevScriptObj;
struct stat sb;
int retval;
@@ -8521,8 +8553,16 @@ int Jim_EvalFile(Jim_Interp *interp, const char *filename)
scriptObjPtr = Jim_NewStringObjNoAlloc(interp, buf, sb.st_size);
JimSetSourceInfo(interp, scriptObjPtr, filename, 1);
Jim_IncrRefCount(scriptObjPtr);
+
+ prevScriptObj = interp->currentScriptObj;
+ interp->currentScriptObj = scriptObjPtr;
+
retval = Jim_EvalObj(interp, scriptObjPtr);
+
+ interp->currentScriptObj = prevScriptObj;
+
Jim_DecrRefCount(interp, scriptObjPtr);
+
return retval;
}
@@ -8772,17 +8812,21 @@ void Jim_WrongNumArgs(Jim_Interp *interp, int argc, Jim_Obj *const *argv,
Jim_SetResult(interp, objPtr);
}
-static Jim_Obj *JimCommandsList(Jim_Interp *interp, Jim_Obj *patternObjPtr)
+static Jim_Obj *JimCommandsList(Jim_Interp *interp, Jim_Obj *patternObjPtr, int procs_only)
{
Jim_HashTableIterator *htiter;
Jim_HashEntry *he;
Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
const char *pattern;
- int patternLen;
+ int patternLen = 0;
pattern = patternObjPtr ? Jim_GetString(patternObjPtr, &patternLen) : NULL;
htiter = Jim_GetHashTableIterator(&interp->commands);
while ((he = Jim_NextHashEntry(htiter)) != NULL) {
+ Jim_Cmd *cmdPtr = he->val;
+ if (procs_only && cmdPtr->cmdProc != NULL) {
+ continue;
+ }
if (pattern && !JimStringMatch(pattern, patternLen, he->key,
strlen((const char*)he->key), 0))
continue;
@@ -8804,7 +8848,7 @@ static Jim_Obj *JimVariablesList(Jim_Interp *interp, Jim_Obj *patternObjPtr,
Jim_HashEntry *he;
Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
const char *pattern;
- int patternLen;
+ int patternLen = 0;
pattern = patternObjPtr ? Jim_GetString(patternObjPtr, &patternLen) : NULL;
if (mode == JIM_VARLIST_GLOBALS) {
@@ -9935,6 +9979,78 @@ err:
return JIM_ERR;
}
+/* [lreplace] */
+static int Jim_LreplaceCoreCommand(Jim_Interp *interp, int argc,
+ Jim_Obj *const *argv)
+{
+ int first, last, len, rangeLen;
+ Jim_Obj *listObj;
+ Jim_Obj *newListObj;
+ int i;
+ int shared;
+
+ if (argc < 4) {
+ Jim_WrongNumArgs(interp, 1, argv, "list first last ?element element ...?");
+ return JIM_ERR;
+ }
+ if (Jim_GetIndex(interp, argv[2], &first) != JIM_OK ||
+ Jim_GetIndex(interp, argv[3], &last) != JIM_OK) {
+ return JIM_ERR;
+ }
+
+ listObj = argv[1];
+ Jim_ListLength(interp, listObj, &len);
+
+ first = JimRelToAbsIndex(len, first);
+ last = JimRelToAbsIndex(len, last);
+ JimRelToAbsRange(len, first, last, &first, &last, &rangeLen);
+
+ /* Now construct a new list which consists of:
+ * <elements before first> <supplied elements> <elements after last>
+ */
+
+ /* Check to see if trying to replace past the end of the list */
+ if (first < len ) {
+ /* OK. Not past the end */
+ }
+ else if (len == 0) {
+ /* Special for empty list, adjust first to 0 */
+ first = 0;
+ }
+ else {
+ Jim_SetResultString(interp, "list doesn't contain element ", -1);
+ Jim_AppendObj(interp, Jim_GetResult(interp), argv[2]);
+ return JIM_ERR;
+ }
+
+ newListObj = Jim_NewListObj(interp, NULL, 0);
+
+ shared = Jim_IsShared(listObj);
+ if (shared) {
+ listObj = Jim_DuplicateObj(interp, listObj);
+ }
+
+ /* Add the first set of elements */
+ for (i = 0; i < first; i++) {
+ Jim_ListAppendElement(interp, newListObj, listObj->internalRep.listValue.ele[i]);
+ }
+
+ /* Add supplied elements */
+ for (i = 4; i < argc; i++) {
+ Jim_ListAppendElement(interp, newListObj, argv[i]);
+ }
+
+ /* Add the remaining elements */
+ for (i = first + rangeLen; i < len; i++) {
+ Jim_ListAppendElement(interp, newListObj, listObj->internalRep.listValue.ele[i]);
+ }
+ Jim_SetResult(interp, newListObj);
+ if (shared) {
+ Jim_FreeNewObj(interp, listObj);
+ }
+ return JIM_OK;
+}
+
/* [lset] */
static int Jim_LsetCoreCommand(Jim_Interp *interp, int argc,
Jim_Obj *const *argv)
@@ -10369,7 +10485,7 @@ static int Jim_ProcCoreCommand(Jim_Interp *interp, int argc,
if (argListLen) {
const char *str;
int len;
- Jim_Obj *argPtr;
+ Jim_Obj *argPtr = 0;
/* Check for 'args' and adjust arityMin and arityMax if necessary */
Jim_ListIndex(interp, argv[2], argListLen-1, &argPtr, JIM_NONE);
@@ -10488,7 +10604,7 @@ static Jim_Obj *JimStringMap(Jim_Interp *interp, Jim_Obj *mapListObjPtr,
value = Jim_Alloc(sizeof(Jim_Obj*)*numMaps);
resultObjPtr = Jim_NewStringObj(interp, "", 0);
for (i = 0; i < numMaps; i++) {
- Jim_Obj *eleObjPtr;
+ Jim_Obj *eleObjPtr = 0;
Jim_ListIndex(interp, mapListObjPtr, i*2, &eleObjPtr, JIM_NONE);
key[i] = Jim_GetString(eleObjPtr, &keyLen[i]);
@@ -10539,11 +10655,11 @@ static int Jim_StringCoreCommand(Jim_Interp *interp, int argc,
int option;
const char *options[] = {
"length", "compare", "match", "equal", "range", "map", "repeat",
- "index", "first", "trim", "trimleft", "trimright", "tolower", "toupper", NULL
+ "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_TRIM, OPT_TRIMLEFT, OPT_TRIMRIGHT,
+ OPT_MAP, OPT_REPEAT, OPT_INDEX, OPT_FIRST, OPT_LAST, OPT_TRIM, OPT_TRIMLEFT, OPT_TRIMRIGHT,
OPT_TOLOWER, OPT_TOUPPER
};
@@ -10675,7 +10791,7 @@ static int Jim_StringCoreCommand(Jim_Interp *interp, int argc,
Jim_SetResult(interp, Jim_NewStringObj(interp, str+index, 1));
return JIM_OK;
}
- } else if (option == OPT_FIRST) {
+ } else if (option == OPT_FIRST || option == OPT_LAST) {
int index = 0, l1, l2;
const char *s1, *s2;
@@ -10690,8 +10806,14 @@ static int Jim_StringCoreCommand(Jim_Interp *interp, int argc,
return JIM_ERR;
index = JimRelToAbsIndex(l2, index);
}
- Jim_SetResult(interp, Jim_NewIntObj(interp,
- JimStringFirst(s1, l1, s2, 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)));
+ }
return JIM_OK;
} else if (option == OPT_TRIM) {
if (argc != 3 && argc != 4) {
@@ -11062,11 +11184,13 @@ static int Jim_InfoCoreCommand(Jim_Interp *interp, int argc,
{
int cmd, result = JIM_OK;
static const char *commands[] = {
- "body", "commands", "exists", "globals", "level", "locals",
- "vars", "version", "complete", "args", "hostname", NULL
+ "body", "commands", "procs", "exists", "globals", "level", "locals",
+ "vars", "version", "patchlevel", "complete", "args", "hostname",
+ "script", NULL
};
- enum {INFO_BODY, INFO_COMMANDS, INFO_EXISTS, INFO_GLOBALS, INFO_LEVEL,
- INFO_LOCALS, INFO_VARS, INFO_VERSION, INFO_COMPLETE, INFO_ARGS, INFO_HOSTNAME};
+ enum {INFO_BODY, INFO_COMMANDS, INFO_PROCS, INFO_EXISTS, INFO_GLOBALS, INFO_LEVEL,
+ INFO_LOCALS, INFO_VARS, INFO_VERSION, INFO_PATCHLEVEL, INFO_COMPLETE, INFO_ARGS,
+ INFO_HOSTNAME, INFO_SCRIPT};
if (argc < 2) {
Jim_WrongNumArgs(interp, 1, argv, "command ?args ...?");
@@ -11077,15 +11201,12 @@ static int Jim_InfoCoreCommand(Jim_Interp *interp, int argc,
return JIM_ERR;
}
- if (cmd == INFO_COMMANDS) {
+ if (cmd == INFO_COMMANDS || cmd == INFO_PROCS) {
if (argc != 2 && argc != 3) {
Jim_WrongNumArgs(interp, 2, argv, "?pattern?");
return JIM_ERR;
}
- if (argc == 3)
- Jim_SetResult(interp,JimCommandsList(interp, argv[2]));
- else
- Jim_SetResult(interp, JimCommandsList(interp, NULL));
+ Jim_SetResult(interp, JimCommandsList(interp, (argc == 3) ? argv[2] : NULL, (cmd == INFO_PROCS)));
} else if (cmd == INFO_EXISTS) {
Jim_Obj *exists;
if (argc != 3) {
@@ -11094,6 +11215,14 @@ static int Jim_InfoCoreCommand(Jim_Interp *interp, int argc,
}
exists = Jim_GetVariable(interp, argv[2], 0);
Jim_SetResult(interp, Jim_NewIntObj(interp, exists != 0));
+ } else if (cmd == INFO_SCRIPT) {
+ ScriptObj *script;
+ if (argc != 2) {
+ Jim_WrongNumArgs(interp, 2, argv, "");
+ return JIM_ERR;
+ }
+ script = Jim_GetScript(interp, interp->currentScriptObj);
+ Jim_SetResultString(interp, script->fileName, -1);
} else if (cmd == INFO_GLOBALS || cmd == INFO_LOCALS || cmd == INFO_VARS) {
int mode;
switch (cmd) {
@@ -11146,7 +11275,7 @@ static int Jim_InfoCoreCommand(Jim_Interp *interp, int argc,
Jim_SetResult(interp, cmdPtr->bodyObjPtr);
else
Jim_SetResult(interp, cmdPtr->argListObjPtr);
- } else if (cmd == INFO_VERSION) {
+ } else if (cmd == INFO_VERSION || cmd == INFO_PATCHLEVEL) {
char buf[(JIM_INTEGER_SPACE * 2) + 1];
sprintf(buf, "%d.%d",
JIM_VERSION / 100, JIM_VERSION % 100);
@@ -11253,7 +11382,7 @@ static int Jim_JoinCoreCommand(Jim_Interp *interp, int argc,
resObjPtr = Jim_NewStringObj(interp, NULL, 0);
/* Split */
for (i = 0; i < listLen; i++) {
- Jim_Obj *objPtr;
+ Jim_Obj *objPtr = 0;
Jim_ListIndex(interp, argv[1], i, &objPtr, JIM_NONE);
Jim_AppendObj(interp, resObjPtr, objPtr);
@@ -11571,6 +11700,7 @@ static struct {
{"llength", Jim_LlengthCoreCommand},
{"lappend", Jim_LappendCoreCommand},
{"linsert", Jim_LinsertCoreCommand},
+ {"lreplace", Jim_LreplaceCoreCommand},
{"lsort", Jim_LsortCoreCommand},
{"append", Jim_AppendCoreCommand},
{"debug", Jim_DebugCoreCommand},
@@ -11656,7 +11786,7 @@ void Jim_PrintErrorMessage(Jim_Interp *interp)
Jim_GetString(interp->result, NULL));
Jim_ListLength(interp, interp->stackTrace, &len);
for (i = len-3; i >= 0; i-= 3) {
- Jim_Obj *objPtr;
+ Jim_Obj *objPtr = 0;
const char *proc, *file, *line;
Jim_ListIndex(interp, interp->stackTrace, i, &objPtr, JIM_NONE);
diff --git a/jim.h b/jim.h
index c888182..ecfb9ac 100644
--- a/jim.h
+++ b/jim.h
@@ -175,6 +175,14 @@ extern "C" {
#define JIM_NL "\n"
#endif
+#ifdef JIM_TCL_COMPAT
+#define JIM_LIBPATH "auto_path"
+#define JIM_INTERACTIVE "tcl_interactive"
+#else
+#define JIM_LIBPATH "jim_libpath"
+#define JIM_INTERACTIVE "jim_interactive"
+#endif
+
/* -----------------------------------------------------------------------------
* Stack
* ---------------------------------------------------------------------------*/
@@ -495,7 +503,7 @@ typedef struct Jim_Interp {
structure. */
Jim_Obj *liveList; /* Linked list of all the live objects. */
Jim_Obj *freeList; /* Linked list of all the unused objects. */
- const char *scriptFileName; /* File name of the script currently in execution. */
+ Jim_Obj *currentScriptObj; /* Script currently in execution. */
Jim_Obj *emptyObj; /* Shared empty string object. */
unsigned jim_wide referenceNextId; /* Next id for reference. */
struct Jim_HashTable references; /* References hash table. */
diff --git a/jimsh.c b/jimsh.c
index 67a4119..464f943 100644
--- a/jimsh.c
+++ b/jimsh.c
@@ -137,11 +137,11 @@ int main(int argc, char *const argv[])
/* Append the path where the executed Jim binary is contained
* in the jim_libpath list. */
- listObj = Jim_GetVariableStr(interp, "jim_libpath", JIM_NONE);
+ listObj = Jim_GetVariableStr(interp, JIM_LIBPATH, JIM_NONE);
if (Jim_IsShared(listObj))
listObj = Jim_DuplicateObj(interp, listObj);
Jim_ListAppendElement(interp, listObj, JimGetExePath(interp, argv[0]));
- Jim_SetVariableStr(interp, "jim_libpath", listObj);
+ Jim_SetVariableStr(interp, JIM_LIBPATH, listObj);
/* Populate argv and argv0 global vars */
listObj = Jim_NewListObj(interp, NULL, 0);
@@ -153,12 +153,12 @@ int main(int argc, char *const argv[])
Jim_SetVariableStr(interp, "argv", listObj);
if (argc == 1) {
- Jim_SetVariableStrWithStr(interp, "jim_interactive", "1");
+ Jim_SetVariableStrWithStr(interp, JIM_INTERACTIVE, "1");
JimLoadJimRc(interp);
retcode = Jim_InteractivePrompt(interp);
} else {
Jim_SetVariableStr(interp, "argv0", Jim_NewStringObj(interp, argv[1], -1));
- Jim_SetVariableStrWithStr(interp, "jim_interactive", "0");
+ Jim_SetVariableStrWithStr(interp, JIM_INTERACTIVE, "0");
if ((retcode = Jim_EvalFile(interp, argv[1])) == JIM_ERR) {
Jim_PrintErrorMessage(interp);
}
diff --git a/test.tcl b/test.tcl
index 2e34e88..d63057c 100644
--- a/test.tcl
+++ b/test.tcl
@@ -2035,6 +2035,28 @@ catch {unset x}
# STRING
################################################################################
+# 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?"}}
+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?}}
+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?"}}
+test string-7.5 {string last} {
+ string last xx xxxx123xx345x678
+} 7
+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
+
## string match
##
test string-11.1 {string match, too few args} {
@@ -3381,6 +3403,124 @@ test linsert-3.2 {linsert won't modify shared argument objects} {
} "7 a b c"
################################################################################
+# LREPLACE
+################################################################################
+
+test lreplace-1.1 {lreplace command} {
+ lreplace {1 2 3 4 5} 0 0 a
+} {a 2 3 4 5}
+test lreplace-1.2 {lreplace command} {
+ lreplace {1 2 3 4 5} 1 1 a
+} {1 a 3 4 5}
+test lreplace-1.3 {lreplace command} {
+ lreplace {1 2 3 4 5} 2 2 a
+} {1 2 a 4 5}
+test lreplace-1.4 {lreplace command} {
+ lreplace {1 2 3 4 5} 3 3 a
+} {1 2 3 a 5}
+test lreplace-1.5 {lreplace command} {
+ lreplace {1 2 3 4 5} 4 4 a
+} {1 2 3 4 a}
+test lreplace-1.6 {lreplace command} {
+ lreplace {1 2 3 4 5} 4 5 a
+} {1 2 3 4 a}
+test lreplace-1.7 {lreplace command} {
+ lreplace {1 2 3 4 5} -1 -1 a
+} {a 1 2 3 4 5}
+test lreplace-1.8 {lreplace command} {
+ lreplace {1 2 3 4 5} 2 end a b c d
+} {1 2 a b c d}
+test lreplace-1.9 {lreplace command} {
+ lreplace {1 2 3 4 5} 0 3
+} {5}
+test lreplace-1.10 {lreplace command} {
+ lreplace {1 2 3 4 5} 0 4
+} {}
+test lreplace-1.11 {lreplace command} {
+ lreplace {1 2 3 4 5} 0 1
+} {3 4 5}
+test lreplace-1.12 {lreplace command} {
+ lreplace {1 2 3 4 5} 2 3
+} {1 2 5}
+test lreplace-1.13 {lreplace command} {
+ lreplace {1 2 3 4 5} 3 end
+} {1 2 3}
+test lreplace-1.14 {lreplace command} {
+ lreplace {1 2 3 4 5} -1 4 a b c
+} {a b c}
+test lreplace-1.15 {lreplace command} {
+ lreplace {a b "c c" d e f} 3 3
+} {a b {c c} e f}
+test lreplace-1.16 {lreplace command} {
+ lreplace { 1 2 3 4 5} 0 0 a
+} {a 2 3 4 5}
+test lreplace-1.17 {lreplace command} {
+ lreplace {1 2 3 4 "5 6"} 4 4 a
+} {1 2 3 4 a}
+test lreplace-1.18 {lreplace command} {
+ lreplace {1 2 3 4 {5 6}} 4 4 a
+} {1 2 3 4 a}
+test lreplace-1.19 {lreplace command} {
+ lreplace {1 2 3 4} 2 end x y z
+} {1 2 x y z}
+test lreplace-1.20 {lreplace command} {
+ lreplace {1 2 3 4} end end a
+} {1 2 3 a}
+test lreplace-1.21 {lreplace command} {
+ lreplace {1 2 3 4} end 3 a
+} {1 2 3 a}
+test lreplace-1.22 {lreplace command} {
+ lreplace {1 2 3 4} end end
+} {1 2 3}
+test lreplace-1.23 {lreplace command} {
+ lreplace {1 2 3 4} 2 -1 xy
+} {1 2 xy 3 4}
+test lreplace-1.24 {lreplace command} {
+ lreplace {1 2 3 4} end -1 z
+} {1 2 3 z 4}
+test lreplace-1.25 {lreplace command} {
+ concat \"[lreplace {\}\ hello} end end]\"
+} {"\}\ "}
+test lreplace-1.26 {lreplace command} {
+ catch {unset foo}
+ set foo {a b}
+ list [set foo [lreplace $foo end end]] \
+ [set foo [lreplace $foo end end]] \
+ [set foo [lreplace $foo end end]]
+} {a {} {}}
+
+
+test lreplace-2.1 {lreplace errors} {
+ list [catch lreplace msg] $msg
+} {1 {wrong # args: should be "lreplace list first last ?element element ...?"}}
+test lreplace-2.2 {lreplace errors} {
+ list [catch {lreplace a b} msg] $msg
+} {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?}}
+test lreplace-2.4 {lreplace errors} {
+ list [catch {lreplace x 10 x} msg] $msg
+} {1 {bad index "x": must be 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?}}
+test lreplace-2.6 {lreplace errors} {
+ list [catch {lreplace x 3 2} msg] $msg
+} {1 {list doesn't contain element 3}}
+test lreplace-2.7 {lreplace errors} {
+ list [catch {lreplace x 1 1} msg] $msg
+} {1 {list doesn't contain element 1}}
+
+test lreplace-3.1 {lreplace won't modify shared argument objects} {
+ proc p {} {
+ lreplace "a b c" 1 1 "x y"
+ return "a b c"
+ }
+ p
+} "a b c"
+
+################################################################################
# LRANGE
################################################################################
diff --git a/tools/benchtable.tcl b/tools/benchtable.tcl
index df14884..1ac9583 100644
--- a/tools/benchtable.tcl
+++ b/tools/benchtable.tcl
@@ -9,8 +9,7 @@ proc main {filename} {
set versions {}
array set bench {}
set f [open $filename r]
- while {![eof $f]} {
- gets $f data
+ while {[gets $f data] >= 0} {
lappend versions [lindex $data 0]
set results [lindex $data 1]
foreach {title time} $results {
@@ -26,7 +25,7 @@ proc main {filename} {
}
puts ""
- foreach test [array names bench] {
+ foreach test [lsort [array names bench]] {
puts -nonewline "[format {% 20s} $test] "
foreach v $bench($test) {
if {$v eq "F"} {