aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-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"} {
generated by cgit v1.1 at 2025-03-22 00:26:19 +0000