diff options
| -rw-r--r-- | array.tcl | 104 | ||||
| -rw-r--r-- | jim-array.c | 277 | ||||
| -rw-r--r-- | jim.c | 48 | ||||
| -rw-r--r-- | jim.h | 6 | ||||
| -rw-r--r-- | tests/array.test | 68 | ||||
| -rw-r--r-- | tests/perf.test | 120 |
6 files changed, 512 insertions, 111 deletions
diff --git a/array.tcl b/array.tcl deleted file mode 100644 index 38cda0f..0000000 --- a/array.tcl +++ /dev/null @@ -1,104 +0,0 @@ -# (c) 2008 Steve Bennett <steveb@workware.net.au>
-#
-# Implements a Tcl-compatible array command based on dict
-#
-# 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 array 1.0
-
-proc array {subcmd arrayname args} {
- # $name is the name of the array in the caller's context
- upvar $arrayname name
-
- if {$subcmd eq "exists"} {
- return [info exists name]
- }
-
- if {![info exists name]} {
- set name [dict create]
- }
-
- switch $subcmd {
- set {
- # The argument should be a list, but we also
- # support name value pairs
- if {[llength $args] == 1} {
- set args [lindex $args 0]
- }
- foreach {key value} $args {
- dict set name $key $value
- }
- return $name
- }
- size {
- return [/ [llength $name] 2]
- }
- }
-
- # The remaining options take a pattern
- if {[llength $args] > 0} {
- set pattern [lindex $args 0]
- } else {
- set pattern *
- }
-
- switch $subcmd {
- names {
- set keys {}
- foreach {key value} $name {
- if {[string match $pattern $key]} {
- lappend keys $key
- }
- }
- return $keys
- }
- get {
- set list {}
- foreach {key value} $name {
- if {[string match $pattern $key]} {
- lappend list $key $value
- }
- }
- return $list
- }
- unset {
- foreach {key value} $name {
- if {[string match $pattern $key]} {
- dict unset name $key
- }
- }
- return
- }
- }
-
- # Tcl-compatible error message
- error "bad option \"$subcmd\": must be exists, get, names, set, size, or unset"
-}
diff --git a/jim-array.c b/jim-array.c new file mode 100644 index 0000000..903b157 --- /dev/null +++ b/jim-array.c @@ -0,0 +1,277 @@ +/* + * (c) 2008 Steve Bennett <steveb@workware.net.au> + * + * Implements the file command for jim + * + * 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. + * + * Based on code originally from Tcl 6.7: + * + * Copyright 1987-1991 Regents of the University of California + * Permission to use, copy, modify, and distribute this + * software and its documentation for any purpose and without + * fee is hereby granted, provided that the above copyright + * notice appear in all copies. The University of California + * makes no representations about the suitability of this + * software for any purpose. It is provided "as is" without + * express or implied warranty. + */ + +#include <limits.h> +#include <stdlib.h> +#include <string.h> +#include <stdio.h> +#include <unistd.h> +#include <errno.h> + +#include "jim.h" +#include "jim-subcmd.h" + +static int array_cmd_exists(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + /* Just a regular [info exists] */ + Jim_SetResultInt(interp, Jim_GetVariable(interp, argv[0], 0) != 0); + return JIM_OK; +} + +static int array_cmd_get(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + int i; + int len; + Jim_Obj *resultObj; + Jim_Obj *objPtr = Jim_GetVariable(interp, argv[0], JIM_NONE); + Jim_Obj *dictObj; + Jim_Obj **dictValuesObj; + + if (!objPtr) { + return JIM_OK; + } + + if (Jim_DictKeysVector(interp, objPtr, NULL, 0, &dictObj, JIM_ERRMSG) != JIM_OK) { + return JIM_ERR; + } + + if (Jim_DictPairs(interp, dictObj, &dictValuesObj, &len) != JIM_OK) { + return JIM_ERR; + } + + if (argc == 1 || Jim_CompareStringImmediate(interp, argv[1], "*")) { + /* Return the whole array */ + Jim_SetResult(interp, dictObj); + } + else { + /* REVISIT: We could create a dictionary rather than a list ...*/ + /* Only return the matching values */ + resultObj = Jim_NewListObj(interp, NULL, 0); + + for (i = 0; i < len; i += 2) { + if (Jim_StringMatchObj(argv[1], dictValuesObj[i], 0)) { + Jim_ListAppendElement(interp, resultObj, dictValuesObj[i]); + Jim_ListAppendElement(interp, resultObj, dictValuesObj[i + 1]); + } + } + + Jim_SetResult(interp, resultObj); + } + Jim_Free(dictValuesObj); + return JIM_OK; + +} + +static int array_cmd_names(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + int i; + int len; + Jim_Obj *resultObj; + Jim_Obj *objPtr = Jim_GetVariable(interp, argv[0], JIM_NONE); + Jim_Obj *dictObj; + Jim_Obj **dictValuesObj; + + if (!objPtr) { + return JIM_OK; + } + + if (Jim_DictKeysVector(interp, objPtr, NULL, 0, &dictObj, JIM_ERRMSG) != JIM_OK) { + return JIM_ERR; + } + + if (Jim_DictPairs(interp, dictObj, &dictValuesObj, &len) != JIM_OK) { + return JIM_ERR; + } + + /* Only return the matching values */ + resultObj = Jim_NewListObj(interp, NULL, 0); + + for (i = 0; i < len; i += 2) { + if (argc == 1 || Jim_StringMatchObj(argv[1], dictValuesObj[i], 0)) { + Jim_ListAppendElement(interp, resultObj, dictValuesObj[i]); + } + } + Jim_Free(dictValuesObj); + + Jim_SetResult(interp, resultObj); + return JIM_OK; +} + +static int array_cmd_unset(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + int i; + int len; + Jim_Obj *resultObj; + Jim_Obj *objPtr; + Jim_Obj *dictObj; + Jim_Obj **dictValuesObj; + + if (argc == 1 || Jim_CompareStringImmediate(interp, argv[1], "*")) { + /* Unset the whole array */ + Jim_UnsetVariable(interp, argv[0], JIM_NONE); + return JIM_OK; + } + + objPtr = Jim_GetVariable(interp, argv[0], JIM_NONE); + + if (Jim_DictKeysVector(interp, objPtr, NULL, 0, &dictObj, JIM_ERRMSG) != JIM_OK) { + return JIM_ERR; + } + + if (Jim_DictPairs(interp, dictObj, &dictValuesObj, &len) != JIM_OK) { + return JIM_ERR; + } + + /* Create a new object with the values which don't match */ + resultObj = Jim_NewDictObj(interp, NULL, 0); + + for (i = 0; i < len; i += 2) { + if (!Jim_StringMatchObj(argv[1], dictValuesObj[i], 0)) { + Jim_DictAddElement(interp, resultObj, dictValuesObj[i], dictValuesObj[i + 1]); + } + } + Jim_Free(dictValuesObj); + + Jim_SetVariable(interp, argv[0], resultObj); + return JIM_OK; +} + +static int array_cmd_size(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + Jim_Obj *objPtr; + int len = 0; + + /* Not found means zero length */ + objPtr = Jim_GetVariable(interp, argv[0], JIM_NONE); + if (objPtr) { + Jim_ListLength(interp, objPtr, &len); + len /= 2; + } + + Jim_SetResultInt(interp, len); + + return JIM_OK; +} + +static int array_cmd_set(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + int i; + int len; + Jim_Obj *listObj = argv[1]; + + Jim_ListLength(interp, listObj, &len); + 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) { + 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); + } + + return JIM_OK; +} + +static const jim_subcmd_type command_table[] = { + { .cmd = "exists", + .args = "arrayName", + .function = array_cmd_exists, + .minargs = 1, + .maxargs = 1, + .description = "Does array exist?" + }, + { .cmd = "get", + .args = "arrayName ?pattern?", + .function = array_cmd_get, + .minargs = 1, + .maxargs = 2, + .description = "Array contents as name value list" + }, + { .cmd = "names", + .args = "arrayName ?pattern?", + .function = array_cmd_names, + .minargs = 1, + .maxargs = 2, + .description = "Array keys as a list" + }, + { .cmd = "set", + .args = "arrayName list", + .function = array_cmd_set, + .minargs = 2, + .maxargs = 2, + .description = "Set array from list" + }, + { .cmd = "size", + .args = "arrayName", + .function = array_cmd_size, + .minargs = 1, + .maxargs = 1, + .description = "Number of elements in array" + }, + { .cmd = "unset", + .args = "arrayName ?pattern?", + .function = array_cmd_unset, + .minargs = 1, + .maxargs = 2, + .description = "Unset elements of an array" + }, + { .cmd = 0, + } +}; + +int Jim_arrayInit(Jim_Interp *interp) +{ + if (Jim_PackageProvide(interp, "array", "1.0", JIM_ERRMSG) != JIM_OK) { + return JIM_ERR; + } + Jim_CreateCommand(interp, "array", Jim_SubCmdProc, (void *)command_table, NULL); + return JIM_OK; +} @@ -3749,7 +3749,8 @@ int Jim_UnsetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags) if ((err = SetVariableFromAny(interp, nameObjPtr)) != JIM_OK) { /* Check for [dict] syntax sugar. */ if (err == JIM_DICT_SUGAR) - return JimDictSugarSet(interp, nameObjPtr, NULL); + if (JimDictSugarSet(interp, nameObjPtr, NULL) == JIM_OK) + return JIM_OK; Jim_SetResult(interp, Jim_NewEmptyStringObj(interp)); Jim_AppendStrings(interp, Jim_GetResult(interp), "can't unset \"", nameObjPtr->bytes, @@ -3842,6 +3843,10 @@ static int JimDictSugarSet(Jim_Interp *interp, Jim_Obj *objPtr, valObjPtr); Jim_DecrRefCount(interp, varObjPtr); Jim_DecrRefCount(interp, keyObjPtr); + /* Don't keep an extra ref to the result */ + if (err == JIM_OK) { + Jim_SetEmptyResult(interp); + } return err; } @@ -5895,14 +5900,13 @@ int SetDictFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr) * associated is replaced with the new one. * * if valueObjPtr == NULL, the key is instead removed if it exists. */ -static void DictAddElement(Jim_Interp *interp, Jim_Obj *objPtr, +static int DictAddElement(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *keyObjPtr, Jim_Obj *valueObjPtr) { Jim_HashTable *ht = objPtr->internalRep.ptr; if (valueObjPtr == NULL) { /* unset */ - Jim_DeleteHashEntry(ht, keyObjPtr); - return; + return Jim_DeleteHashEntry(ht, keyObjPtr); } Jim_IncrRefCount(keyObjPtr); Jim_IncrRefCount(valueObjPtr); @@ -5913,6 +5917,7 @@ static void DictAddElement(Jim_Interp *interp, Jim_Obj *objPtr, Jim_DecrRefCount(interp, (Jim_Obj*)he->val); he->val = valueObjPtr; } + return JIM_OK; } /* Add an element, higher-level interface for DictAddElement(). @@ -5920,15 +5925,16 @@ static void DictAddElement(Jim_Interp *interp, Jim_Obj *objPtr, int Jim_DictAddElement(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *keyObjPtr, Jim_Obj *valueObjPtr) { + int retcode; if (Jim_IsShared(objPtr)) Jim_Panic(interp,"Jim_DictAddElement called with shared object"); if (objPtr->typePtr != &dictObjType) { if (SetDictFromAny(interp, objPtr) != JIM_OK) return JIM_ERR; } - DictAddElement(interp, objPtr, keyObjPtr, valueObjPtr); + retcode = DictAddElement(interp, objPtr, keyObjPtr, valueObjPtr); Jim_InvalidateStringRep(objPtr); - return JIM_OK; + return retcode; } Jim_Obj *Jim_NewDictObj(Jim_Interp *interp, Jim_Obj *const *elements, int len) @@ -5974,6 +5980,36 @@ int Jim_DictKey(Jim_Interp *interp, Jim_Obj *dictPtr, Jim_Obj *keyPtr, return JIM_OK; } +/* Return an allocated array of key/value pairs for the dictionary. Stores the length in *len */ +int Jim_DictPairs(Jim_Interp *interp, Jim_Obj *dictPtr, Jim_Obj ***objPtrPtr, int *len) +{ + Jim_HashTable *ht; + Jim_HashTableIterator *htiter; + Jim_HashEntry *he; + Jim_Obj **objv; + int i; + + if (dictPtr->typePtr != &dictObjType) { + if (SetDictFromAny(interp, dictPtr) != JIM_OK) + return JIM_ERR; + } + ht = dictPtr->internalRep.ptr; + + /* Turn the hash table into a flat vector of Jim_Objects. */ + objv = Jim_Alloc((ht->used * 2) * sizeof(Jim_Obj*)); + htiter = Jim_GetHashTableIterator(ht); + i = 0; + while ((he = Jim_NextHashEntry(htiter)) != NULL) { + objv[i++] = (Jim_Obj*)he->key; /* ATTENTION: const cast */ + objv[i++] = he->val; + } + *len = i; + Jim_FreeHashTableIterator(htiter); + *objPtrPtr = objv; + return JIM_OK; +} + + /* Return the value associated to the specified dict keys */ int Jim_DictKeysVector(Jim_Interp *interp, Jim_Obj *dictPtr, Jim_Obj *const *keyv, int keyc, Jim_Obj **objPtrPtr, int flags) @@ -134,7 +134,7 @@ extern "C" { /* Jim version numbering: every version of jim is marked with a * successive integer number. This is version 0. The first * stable version will be 1, then 2, 3, and so on. */ -#define JIM_VERSION 60 +#define JIM_VERSION 61 #define JIM_OK 0 #define JIM_ERR 1 @@ -768,6 +768,10 @@ JIM_EXPORT int Jim_DictKeysVector (Jim_Interp *interp, JIM_EXPORT int Jim_SetDictKeysVector (Jim_Interp *interp, Jim_Obj *varNamePtr, Jim_Obj *const *keyv, int keyc, Jim_Obj *newObjPtr); +JIM_EXPORT int Jim_DictPairs(Jim_Interp *interp, + Jim_Obj *dictPtr, Jim_Obj ***objPtrPtr, int *len); +JIM_EXPORT int Jim_DictAddElement(Jim_Interp *interp, Jim_Obj *objPtr, + Jim_Obj *keyObjPtr, Jim_Obj *valueObjPtr); /* return code object */ JIM_EXPORT int Jim_GetReturnCode (Jim_Interp *interp, Jim_Obj *objPtr, diff --git a/tests/array.test b/tests/array.test new file mode 100644 index 0000000..6007d2f --- /dev/null +++ b/tests/array.test @@ -0,0 +1,68 @@ +source testing.tcl + +array set a { + 1 one + 2 two + 22 "twenty two" + 3 three +} + +test array-1.1 "array exists - true" { + array exists a +} {1} + +test array-1.2 "array exists - false" { + array exists b +} {0} + +test array-1.3 "array size" { + array size a +} {4} + +test array-1.4 "array size - nonexistant" { + array size b +} {0} + +test array-1.5 "array get" { + set result {} + foreach {name value} [array get a] { + lappend result $name $value + } + lsort $result +} {1 2 22 3 one three {twenty two} two} + +test array-1.6 "array get - pattern" { + set result {} + foreach {name value} [array get a 2*] { + lappend result $name $value + } + lsort $result +} {2 22 {twenty two} two} + +test array-1.7 "array names" { + lsort [array names a] +} {1 2 22 3} + +test array-1.8 "array get - pattern" { + lsort [array names a 2*] +} {2 22} + +#set b $a +array set b [array get a] + +test array-1.9 "array set - replace" { + array set b {22 twenty-two} + set b(22) +} {twenty-two} + +test array-1.10 "array unset - pattern" { + array unset b 2* + array names b +} {1 3} + +test array-1.11 "array unset - all" { + array unset b + list [array size b] [array exists b] +} {0 0} + +testreport diff --git a/tests/perf.test b/tests/perf.test new file mode 100644 index 0000000..f7fab7e --- /dev/null +++ b/tests/perf.test @@ -0,0 +1,120 @@ +set version [info patchlevel] + +proc bench {name cmd} { + if {[catch { + set t [time $cmd] + set ms [expr {[lindex $t 0] / 1000}] + }]} { + set ms ? + } + puts "$::version: $name ${ms}ms" +} + +proc set_dict_sugar {} { + for {set i 0} {$i < 100000} {incr i} { + set a(b) $i + } +} + + +proc read_file {file} { + set f [open $file] + while {[gets $f buf] >= 0} { + } + close $f +} + +proc read_file_split {file} { + set f [open $file] + while {[gets $f buf] >= 0} { + split $buf \t + } + close $f +} + +proc read_file_split_assign_foreach {file} { + set f [open $file] + while {[gets $f buf] >= 0} { + set split [split $buf \t] + foreach {info(chan) info(datetime) info(duration) info(title) subtitle_genre info(desc) info(rating) dummy} [split $buf \t] {break} + #array unset info + } + close $f +} + +proc read_file_split_assign_foreach_dict {file} { + set f [open $file] + while {[gets $f buf] >= 0} { + set split [split $buf \t] + foreach {chan datetime duration title subtitle_genre desc rating dummy} [split $buf \t] {break} + dict set info chan $chan + dict set info duration $duration + dict set info title $title + dict set info subtitle_genre $subtitle_genre + dict set info desc $desc + dict set info rating $rating + #array unset info + } + close $f +} + +proc read_file_split_assign_foreach_dictsugar {file} { + set f [open $file] + while {[gets $f buf] >= 0} { + set split [split $buf \t] + foreach {chan datetime duration title subtitle_genre desc rating dummy} [split $buf \t] {break} + set info(chan) $chan + set info(duration) $duration + set info(title) $title + set info(subtitle_genre) $subtitle_genre + set info(desc) $desc + set info(rating) $rating + #array unset info + } + close $f +} + +proc read_file_split_assign_foreach_simple {file} { + set f [open $file] + while {[gets $f buf] >= 0} { + set split [split $buf \t] + foreach {chan datetime duration title subtitle_genre desc rating dummy} [split $buf \t] {break} + #array unset info + } + close $f +} + +proc read_file_split_assign_lindex {file} { + set f [open $file] + while {[gets $f buf] >= 0} { + set split [split $buf \t] + set info(chan) [lindex $split 0] + set info(datetime) [lindex $split 1] + set info(duration) [lindex $split 2] + set info(title) [lindex $split 3] + set info(subtitle_genre) [lindex $split 4] + set info(desc) [lindex $split 5] + set info(rating) [lindex $split 6] + #array unset info + } + close $f +} + +# Create a really big file +set f [open test.in w] +for {set i 0} {$i < 50000} {incr i} { + puts $f "a\tb\tc\te\tf\tg\th\ti\tj\tk" +} +close $f + +bench "set dictsugar" {set_dict_sugar} +bench "read file #1" {read_file test.in} +bench "read file #2" {read_file test.in} +bench "read file split" {read_file_split test.in} +bench "read file split assign foreach" {read_file_split_assign_foreach test.in} +bench "read file split assign foreach dict" {read_file_split_assign_foreach_dict test.in} +bench "read file split assign foreach dictsugar" {read_file_split_assign_foreach_dictsugar test.in} +bench "read file split assign foreach simple" {read_file_split_assign_foreach_simple test.in} +bench "read file split assign lindex" {read_file_split_assign_lindex test.in} + +file delete test.in |